{ 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.