Вот что у нас получится…
Скажу сразу – этот код корректно переносит файлы, но не до конца корректно отображает индикацию мультизагрузки – я так и не выяснил, с чем это связано. Потоки работают с независимыми участками кода, нигде не пересекаются.
В данном посте посмотрим как передать на FTP сервер несколько файлов в параллельных потоках (Threads). Для работы нам понадобится idFTP, FileOpenDialog с включенной в опциях функцией MultiSelect и кнопка, которая будет инициировать загрузку.
Нам понадобятся следующие модули
Как настроить сервер?
И чтобы не ругался Каспер, я заменил Default порт с 21 на 22
uFTPClient
В uses
|
1 2 3 4 5 6 |
uses ShellApi,Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, Vcl.StdCtrls, IdAntiFreezeBase, Vcl.IdAntiFreeze, IdHTTP, Vcl.ComCtrls, uMultiUploadForm,Contnrs, uFTPUploadFrame,syncobjs; |
В секции private напишем
|
1 2 3 4 5 6 |
Private FUploadProgressList:TObjectList; FLastUploadProgress:integer; FPutThreadsList:TObjectList; FLastPutThreadNumber:integer; |
В public
|
1 2 3 4 5 6 7 8 9 10 11 |
public property UploadProgressList:TObjectList read FUploadProgressList write FUploadProgressList; property PutThreadsList:TObjectList read FPutThreadsList write FPutThreadsList; property LastPutThreadNumber:integer read FLastPutThreadNumber write FLastPutThreadNumber; |
Обработка кнопки будет следующей
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 |
procedure TFTPClient.bPutFileClick(Sender: TObject); var DestName:string; UploadThread: TFTPUploadThread; i: Integer; begin if FileOpenDialog.Execute then begin if not MultiUploadForm.Visible then MultiUploadForm.Show; for i := 0 to FileOpenDialog.Files.Count-1 do begin // Визуализация загрузки файла на сервер FLastUploadProgress:=UploadProgressList.Add( TfUploadProgress.Create(Self) ); with TfUploadProgress(UploadProgressList.Items[FLastUploadProgress]) do begin Name:='fUploadProgress'+FLastUploadProgress.ToString; Parent:=MultiUploadForm.ScrollBox; Align:=alTop; lUploadFileName.Caption:=ExtractFileName(FileOpenDialog.Files[i]); end; //Собственно загрузка - Создание потока через ObjectList LastPutThreadNumber:=PutThreadsList.Add(TFTPUploadThread.Create(true)); with TFTPUploadThread(PutThreadsList.Items[LastPutThreadNumber]) do begin FTPClientForm:=Self; FreeOnTerminate:=True; IndexInUploadProgressList:=FLastUploadProgress; FileName:=FileOpenDialog.Files[i]; Start; // Запуск потока end; end; end; end; |
Модуль потока загрузки одного файла
Здесь, внутри каждого отдельного потока, для каждого отдельного файла мы будем создавать idFTP, подключаться к FTP серверу и отправлять файл.
Код без синхронизации – это лишь иллюстрация идеи
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 |
unit uFTPUploadThread; interface uses uMultiUploadForm, uFTPClient,ShellApi, Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs,syncobjs, //idFTP IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdFTP, Vcl.StdCtrls, IdAntiFreezeBase, Vcl.IdAntiFreeze, uFTPUploadFrame ; type TFTPUploadThread = class(TThread) private { Private declarations } fidFTP:TIdFTP; FFileName:string; FFileSize:Int64; FIndexInUploadProgressList:integer; FFTPClientForm:TFTPClient; FCriticalSection:TCriticalSection; procedure IdFTPAfterPut(Sender: TObject); procedure IdFTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); procedure IdFTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); procedure IdFTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); procedure IdFTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); function FindIndex: integer; public procedure MyCreate; property FTPClientForm:TFTPClient read FFTPClientForm write FFTPClientForm; property idFTP:TIdFTP read fidFTP write fidFTP; property FileName:string read FFileName write FFileName; property FileSize:Int64 read FFileSize write FFileSize; property IndexInUploadProgressList:Integer read FIndexInUploadProgressList write FIndexInUploadProgressList; property CriticalSection:TCriticalSection read FCriticalSection write FCriticalSection; protected procedure Execute; override; end; implementation { Important: Methods and properties of objects in visual components can only be used in a method called using Synchronize, for example, Synchronize(UpdateCaption); and UpdateCaption could look like, procedure TFTPUploadThread.UpdateCaption; begin Form1.Caption := 'Updated in a thread'; end; or Synchronize( procedure begin Form1.Caption := 'Updated in thread via an anonymous method' end ) ); where an anonymous method is passed. Similarly, the developer can call the Queue method with similar parameters as above, instead passing another TThread class as the first parameter, putting the calling thread in a queue with the other thread. } { TFTPUploadThread } procedure TFTPUploadThread.MyCreate; begin { fidFTP:=TIdFTP.Create(nil); //Присваиваем события компоненту fidFTP fidFTP.OnAfterPut:=IdFTPAfterPut; fidFTP.OnWorkBegin:=IdFTPWorkBegin; fidFTP.OnWork:=IdFTPWork; fidFTP.OnStatus:=IdFTPStatus; fidFTP.OnWorkEnd:=IdFTPWorkEnd; } end; procedure TFTPUploadThread.Execute; var DestName:string; i: integer; begin fidFTP:=TIdFTP.Create(nil); //Присваиваем события компоненту fidFTP fidFTP.OnAfterPut:=IdFTPAfterPut; fidFTP.OnWorkBegin:=IdFTPWorkBegin; fidFTP.OnWork:=IdFTPWork; fidFTP.OnStatus:=IdFTPStatus; fidFTP.OnWorkEnd:=IdFTPWorkEnd; fidFTP.Host:='localhost'; fidFTP.Port:=22; fidFTP.Username:='Login'; fidFTP.Password:='Password'; fidFTP.Connect; CriticalSection:=TCriticalSection.Create; CriticalSection.Enter; if FTPClientForm=nil then Exit; if FileName='' then exit; try with FTPClientForm do begin Enabled:=false; PutThreadsInProcess:=PutThreadsInProcess+1; //Отправляем файл в директорию begin fidFTP.MakeDir('/myfiles'); fidFTP.ChangeDir('/myfiles'); // DestName:= //Translit( ExtractFileName(FTPClientForm.OpenDialog.FileName) ); //fidFTP.Put(FTPClientForm.OpenDialog.FileName,DestName); DestName:=Translit( ExtractFileName(FileName)); fidFTP.Put(FileName,DestName); end; PutThreadsInProcess:=PutThreadsInProcess-1; Enabled:=true; if PutThreadsInProcess=0 then MultiUploadForm.Hide; end; finally //fidFTP.Disconnect; // Не включать... FreeAndNil(fidFTP); CriticalSection.Leave; FreeAndNil(FCriticalSection); end; { Place thread code here } end; function TFTPUploadThread.FindIndex:integer; var i: Integer; begin for i := 0 to FTPClientForm.UploadProgressList.Count-1 do begin if TfUploadProgress(FTPClientForm.UploadProgressList.Items[i]). lUploadFileName.Caption=ExtractFileName(FileName) then Result:=i; end; end; procedure TFTPUploadThread.IdFTPAfterPut(Sender: TObject); begin //ShowMessage('File Successfully Uploaded'); end; procedure TFTPUploadThread.IdFTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64); begin // FTPClientForm.MultiUploadForm.Caption:=IndexInUploadProgressList.ToString; FileSize:=AWorkCountMax; with TfUploadProgress(FTPClientForm.UploadProgressList. Items[FindIndex]) do ProgressBar.Max:=100; end; procedure TFTPUploadThread.IdFTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64); begin with TfUploadProgress(FTPClientForm.UploadProgressList. Items[FindIndex]) do ProgressBar.Position:=Trunc((AWorkCount/Filesize)*100); end; procedure TFTPUploadThread.IdFTPStatus(ASender: TObject; const AStatus: TIdStatus; const AStatusText: string); begin with TfUploadProgress(FTPClientForm.UploadProgressList. Items[FindIndex]) do begin lUploadStatus.Caption:=AStatusText; //if AStatusText='Transfer Complete' then ProgressBar.Position:=100; end; end; procedure TFTPUploadThread.IdFTPWorkEnd(ASender: TObject; AWorkMode: TWorkMode); begin with TfUploadProgress(FTPClientForm.UploadProgressList. Items[FindIndex]) do ProgressBar.position:=ProgressBar.Max; end; end. |
Несмотря на то, что я для каждого отдельного потока и соответственно idFTP прописываю процедуры onWorkBegin, OnWork, OnWorkEnd – корректно всё работает только для 1 файла. То есть, процедура put – отрабатывает на ура, а вот с визуализацией пока проблемы – это либо я что то не понимаю, либо это где то в глубинах Инди.
MultiUploadForm
Здесь ScrollBox, на который мы будем цеплять элементы, отображающие прогресс. Также таймер, который проверяет – всё ли загружено. Здесь мы ориентируемся на статусное сообщение от FTPServer.
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 |
unit uMultiUploadForm; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ExtCtrls; type TfMultiUpload = class(TForm) ScrollBox: TScrollBox; TimerEndUpload: TTimer; procedure TimerEndUploadTimer(Sender: TObject); procedure FormShow(Sender: TObject); procedure FormHide(Sender: TObject); private function AreAllFilesUploaded: Boolean; public constructor Create(AOwner: TComponent); override; end; var fMultiUpload: TfMultiUpload; implementation uses uFTPClient,uFTPUploadFrame; var FTPClient_UnitVar:TFTPClient; {$R *.dfm} constructor TfMultiUpload.Create(AOwner: TComponent); begin inherited; if (AOwner is TFTPClient) then FTPClient_UnitVar:=(AOwner as TFTPClient); end; procedure TfMultiUpload.FormHide(Sender: TObject); begin TimerEndUpload.Enabled:=false; end; procedure TfMultiUpload.FormShow(Sender: TObject); begin TimerEndUpload.Enabled:=true; end; procedure TfMultiUpload.TimerEndUploadTimer(Sender: TObject); begin if AreAllFilesUploaded then begin TimerEndUpload.Enabled:=false; Application.MessageBox('Все файлы успешно загружены на сервер.', 'Информация системы', MB_OK + MB_ICONINFORMATION); Self.Hide; end; end; function TfMultiUpload.AreAllFilesUploaded:Boolean; var i: Integer; begin Result:=true; for i := 0 to FTPClient_UnitVar.UploadProgressList.Count-1 do begin with TfUploadProgress(FTPClient_UnitVar.UploadProgressList.Items[i]) do begin if lUploadStatus.Caption<>'Transfer complete' then Result:=False; end; end; end; end. |
UploadFrame
Это собственно графическая индикация для каждого отдельного файла…
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 |
unit uFTPUploadFrame; interface uses Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls; type TfUploadProgress = class(TFrame) ProgressBar: TProgressBar; lUploadFileName: TLabel; lUploadStatus: TLabel; Timer: TTimer; procedure TimerTimer(Sender: TObject); private { Private declarations } public constructor Create(AOwner: TComponent); override; end; implementation {$R *.dfm} { TfUploadProgress } constructor TfUploadProgress.Create(AOwner: TComponent); begin inherited; ProgressBar.Width:=Width; end; procedure TfUploadProgress.TimerTimer(Sender: TObject); begin if lUploadStatus.Caption<>'Transfer complete' then begin if ProgressBar.Position=ProgressBar.Max then ProgressBar.Position:=ProgressBar.Min; ProgressBar.Position:=ProgressBar.Position+1; end else begin ProgressBar.Position:=ProgressBar.Max; Timer.Enabled:=false; end; end; end. |
Исходники
Выводы
Код не идеальный, но рабочий. Скорее он демонстрирует идею и подход. Я тестировал на файле 2,29 ГБ – всё работало как нужно. Файл целиком переместился на серверную часть.
Я так и не понял почему не работала визуализация для мультизагрузки в процедурах OnWorkBegin OnWorkEnd, но недолго думая, заменил её своей визуализацией через таймеры.
Можно ещё добавить проверку того – есть на сервере файл или его там нет, добавить в лабели размер файла, обработку ошибок да и много чего ещё. В дальнейших постах доработаю передачу файлов по FTP и перейду к HTTP протоколу.