- Recompilación de todos los paquetes de RO para poner RemObjects_Core_D10 como paquete de runtime/designtime. git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.RemObjects@5 b6239004-a887-0f4b-9937-50029ccdca16
240 lines
6.6 KiB
ObjectPascal
240 lines
6.6 KiB
ObjectPascal
{ Extented FileTransfer-Example by Joe Blocher (www.myticket.at)
|
|
based on
|
|
Remobjects: Filetransfer-Example, Threads-Example
|
|
Eric Hill (TeamRO): Block-Transfer
|
|
|
|
* Simultanous uploading files using threads (Multiselect in OpenDialog)
|
|
* All other clients will start download automatically
|
|
}
|
|
|
|
unit ExtendedFileTransferClientMain;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls,
|
|
uROClient, uROClientIntf, uRORemoteService, uROBinMessage, uROWinInetHTTPChannel,
|
|
Buttons, SyncObjs, ExtendedFileTransferLibrary_Intf,
|
|
uROEventRepository;
|
|
|
|
type
|
|
TExtendedFileTransferClientMainForm = class(TForm, IFileEvents)
|
|
ROMessage: TROBinMessage;
|
|
ROChannel: TROWinInetHTTPChannel;
|
|
RORemoteService: TRORemoteService;
|
|
UploadButton: TButton;
|
|
EventReceiver: TROEventReceiver;
|
|
Label4: TLabel;
|
|
eFolder: TEdit;
|
|
bSelectFolder: TButton;
|
|
Memo: TMemo;
|
|
procedure FormCreate(Sender: TObject);
|
|
procedure FormDestroy(Sender: TObject);
|
|
procedure UploadButtonClick(Sender: TObject);
|
|
procedure bSelectFolderClick(Sender: TObject);
|
|
private
|
|
{ Private declarations }
|
|
fCritical: TCriticalSection;
|
|
fFileService: IExtendedFileTransferService;
|
|
procedure Log(Mes: string);
|
|
procedure OnDownloadAborted(Sender: TObject);
|
|
procedure OnDownloadError(Sender: TObject);
|
|
procedure OnDownloadFinished(Sender: TObject);
|
|
procedure OnDownloadProgress(Sender: TObject);
|
|
procedure OnDownloadStarted(Sender: TObject);
|
|
procedure OnUploadAborted(Sender: TObject);
|
|
procedure OnUploadError(Sender: TObject);
|
|
procedure OnUploadFinished(Sender: TObject);
|
|
procedure OnUploadProgress(Sender: TObject);
|
|
procedure OnUploadStarted(Sender: TObject);
|
|
{IFileEvents}
|
|
procedure OnNewFileAvailable(const filename: string; const filesize: Int64);
|
|
public
|
|
{ Public declarations }
|
|
end;
|
|
|
|
var
|
|
ExtendedFileTransferClientMainForm: TExtendedFileTransferClientMainForm;
|
|
|
|
implementation
|
|
uses
|
|
FileCtrl,
|
|
ExtendedFileTransferClientUploadThread,
|
|
ExtendedFileTransferClientDownloadThread;
|
|
|
|
{$R *.dfm}
|
|
|
|
procedure TExtendedFileTransferClientMainForm.FormCreate(Sender: TObject);
|
|
begin
|
|
fCritical := TCriticalSection.create;
|
|
eFolder.Text := ExtractFilePath(Paramstr(0)) + 'DownloadFiles\';
|
|
ForceDirectories(eFolder.Text);
|
|
fFileService := RORemoteService as IExtendedFileTransferService;
|
|
EventReceiver.RegisterEventHandlers([EID_FileEvents], [Self]);
|
|
EventReceiver.Active := True;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.FormDestroy(Sender: TObject);
|
|
begin
|
|
try
|
|
EventReceiver.Active := False;
|
|
EventReceiver.UnregisterEventHandlers([EID_FileEvents]);
|
|
finally
|
|
fFileService := nil;
|
|
fCritical.Free;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnDownloadAborted(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TDownloadThread do try
|
|
// Do something
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnDownloadError(Sender: TObject);
|
|
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TDownloadThread do try
|
|
Log('Download ' + Filename + ': ' + Errortext);
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnDownloadStarted(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TDownloadThread do try
|
|
Log(InfoStr + ': Download started');
|
|
//Do something other: create new Progressbar (Max = FileSize .... )
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnDownloadProgress(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
try
|
|
//Update Progressbar .... Use CurrentBytePos
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnDownloadFinished(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TDownloadThread do try
|
|
if DownloadOK then begin
|
|
Log(InfoStr + ': Download finished');
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnUploadAborted(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TUploadThread do try
|
|
// Do something -> Add Serviceoperation: Delete File ....
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnUploadError(Sender: TObject);
|
|
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TUploadThread do try
|
|
Log('Upload ' + Filename + ': ' + Errortext);
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnUploadStarted(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TUploadThread do try
|
|
Log(InfoStr + ': Upload started');
|
|
//Do something other: create Progressbar (Max = FileSize .... )
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnUploadProgress(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
try
|
|
//Update Progressbar .... Use CurrentBytePos
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnUploadFinished(Sender: TObject);
|
|
begin
|
|
fCritical.Enter;
|
|
with Sender as TUploadThread do try
|
|
if UploadOK then begin
|
|
Log(InfoStr + ': Upload finished');
|
|
fFileService.uploadfinished(Filename, FileSize);
|
|
end;
|
|
finally
|
|
fCritical.Leave;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.UploadButtonClick(Sender: TObject);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
with TOpendialog.Create(nil) do try
|
|
InitialDir := 'c:\';
|
|
Filename := '*.*';
|
|
Filter := 'All Files (*.*)|*.*';
|
|
Filterindex := 1;
|
|
options := options + [ofAllowMultiSelect];
|
|
if Execute then
|
|
for i := 0 to Files.count - 1 do
|
|
TUploadThread.Create(Files[i], OnUploadStarted, OnUploadProgress, OnUploadFinished, OnUploadAborted, OnUploadError);
|
|
finally
|
|
free;
|
|
end;
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.OnNewFileAvailable(const filename: string; const filesize:
|
|
Int64);
|
|
begin
|
|
TDownloadThread.Create(eFolder.Text, filename, filesize,
|
|
OnDownloadStarted, OnDownloadProgress, OnDownloadFinished,
|
|
OnDownloadAborted, OnDownloadError);
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.bSelectFolderClick(
|
|
Sender: TObject);
|
|
var
|
|
ffolder: string;
|
|
begin
|
|
ffolder := eFolder.Text;
|
|
SelectDirectory(ffolder, [sdAllowCreate, sdPerformCreate, sdPrompt], 0);
|
|
eFolder.Text := IncludeTrailingPathDelimiter(ffolder);
|
|
end;
|
|
|
|
procedure TExtendedFileTransferClientMainForm.Log(Mes: string);
|
|
begin
|
|
Memo.Lines.Add(Mes);
|
|
end;
|
|
|
|
end.
|
|
|