Данный пример отправляет файлы и сообщения на сервер, а также принимает и раскодирует их.
Работал с FTP протоколом, но столкнулся с рядом ограничений, которые как я понял можно преодолеть при помощи HTTP протокола и которые не позволяют мне решить поставленную задачу. В частности, мне нужна была многопоточная загрузка на сервер, это возможно было только при пассивном режиме FTP сервера с открытием нескольких портов.
Я работаю с Azure и для разворачивания там FTP сервера с 1000 открытыми портами, скажем – задача нетривиальная. Да и для безопасности это нехорошо. Все порты изначально защищены щитом из endpoints. По умолчанию endpoints открываются по одной на портале. Да и ряд других ограничений – невозможность копировать файлы на сервере, скажем, и др.
Если представить такое разворачивание одного только FTP сервера на машинах нескольких клиентов, то это адский труд))
Итак, переходим на HTTP протокол. Сегодня сделаем простую вещь – отправку файла с клиента на сервер по HTTP протоколу.
Нам понадобится idHTTPServer сервер из библиотеки Indy, а также idHTTP клиент. Для начала добьемся самого простого – отправим один файл с клиента и примем его на сервере.
Данный код я нашёл на просторах сети, довел его до работоспособного состояния, и, наверное буду использовать как отправную точку для дальнейшей разработки. Публикую здесь, может кому-то понадобится.
Код довольно хорошо работает, для файлов до нескольких десятков мегабайт, но если, скажем загрузить 150 мб, то ругается на Out of Memory. Думаю, чуть позже можно организовать отправку файла частями ( так называемыми chunks). Это даже и хорошо – можно будет сделать прогресс сколько кусочков ушло, и в каком порядке – своеобразный прогресс так сказать.
Вот что у нас получится
Отправка файла
Прием файла
Начали!
Создадим обычное VCL приложение и добавим компоненты как на рисунке выше
Uses
|
1 2 3 4 5 6 7 |
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdCustomHTTPServer, IdHTTPServer, IdContext, //Added later HTTPApp, IdMultipartFormData, Vcl.StdCtrls, IdTCPConnection, IdTCPClient, IdHTTP |
Объявляем свой тип
|
1 2 3 4 5 |
type TQuery = record params: TStringList; values: TStringList; end; |
Далее, в секции private формы
|
1 2 3 4 |
private Params:TStringList; Query: TQuery; |
FormCreate и FormDestroy
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 |
procedure TfHTTP_Send_and_Recieve_File.FormCreate(Sender: TObject); begin ReportMemoryLeaksOnShutdown:=true; idHTTPServer.DefaultPort := 40000; idHTTPServer.Active := True; Query.params := TStringList.Create; Query.values := TStringList.Create; Params:=TStringList.Create; end; procedure TfHTTP_Send_and_Recieve_File.FormDestroy(Sender: TObject); begin FreeAndNil(Query.params); FreeAndNil(Query.values); FreeAndNil(Params); end; |
Далее 2 вспомогательных метода – для чтения данных – понадобятся чуть позже
|
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 |
procedure TfHTTP_Send_and_Recieve_File.QueryPreParsing(s: string; var res: TStringList); var ss: string; p: integer; begin if(Pos('=',s) <= 0) then begin Exit; end; end; procedure TfHTTP_Send_and_Recieve_File.QueryParsing(list: TStrings; var params: TStringList; var values: TStringList); var i: Integer; p: integer; begin params.Clear; values.Clear; for i := 0 to list.Count-1 do begin p := Pos('=', list.Strings[i]); params.Add(Copy(list.Strings[i], 1, p-1)); values.Add(Copy(list.Strings[i], p+1, Length(list.Strings[i]))); end; end; |
Чтение запроса
|
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 |
function TfHTTP_Send_and_Recieve_File.ReadMultipartRequest(const Boundary: Ansistring; ARequest: Ansistring; var AHeader: TStringList; var Data: Ansistring): Ansistring; var Req, RHead: string; i: Integer; begin Result := ''; AHeader.Clear; Data := ''; if (Pos(Boundary, ARequest) < Pos (Boundary + '--', ARequest)) and (Pos(Boundary, ARequest) = 1) then begin Delete(ARequest, 1, Length(Boundary) + 2); Req := Copy(ARequest, 1, Pos(Boundary, ARequest) - 3); Delete(ARequest, 1, Length(Req) + 2); RHead := Copy(Req, 1, Pos(#13#10#13#10, Req)-1); Delete(Req, 1, Length(RHead) + 4); AHeader.Text := RHead; for i := 0 to AHeader.Count - 1 do if Pos(':', AHeader.Strings[i]) > 0 then AHeader.Strings[i] := Trim(Copy(AHeader.Strings[i], 1, Pos(':', AHeader.Strings[i])-1)) + '=' + Trim(Copy(AHeader.Strings[i], Pos(':', AHeader.Strings[i])+1, Length(AHeader.Strings[i]) - Pos(':', AHeader.Strings[i]))); Data := Req; Result := ARequest; end end; |
Как отправить файл?
Итак, для простоты разместим idHTTPServer и idHTTP на одной форме. В дальнейшем сделаем 2 отдельных программы. Кнопку Send_MultiPart обработаем следующим образом
|
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 |
procedure TfHTTP_Send_and_Recieve_File.Send_MultipartClick(Sender: TObject); var PostData: TIdMultiPartFormDataStream; FileName:string; begin if OpenDialog.Execute then FileName:=OpenDialog.FileName; if FileName='' then Exit; PostData := TIdMultiPartFormDataStream.Create; try idHTTP.Request.Referer := 'http://localhost:40000/sendfile'; // http://www.link.net/download'; idHTTP.Request.ContentType := 'multipart/form-data'; // PostData.AddFormField('field1', 'msg1'); PostData.AddFile('attach', FileName, 'application/x-rar-compressed'); // PostData.AddFormField('field2', 'msg2'); // PostData.AddFormField('action', 'post'); idHTTP.Post('http://localhost:40000/sendfile', PostData); Application.ProcessMessages; finally if(Assigned(PostData)) then PostData.Free; ShowMessage('idHTTP Sent OK'); end; end; |
Как принять файл?
Обработаем событие IdHTTPServerCommandGet idHTTP сервера
|
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 |
procedure TfHTTP_Send_and_Recieve_File.IdHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo); const MaxReadBlockSize = 8192; UploadPath = ''; var MemoryStream: TMemoryStream; Boundary, BufferStr, AllContent: Ansistring; Header: TStringList; ByteToRead, ReadedBytes, RSize: Integer; Buffer: PAnsiChar; Data: Ansistring; HList: TStrings; OutStream: TFileStream; begin AResponseInfo.Server := 'ver1'; AResponseInfo.CacheControl := 'no-cache'; if ARequestInfo.URI<>('/sendfile') then Exit; if(ARequestInfo.Host = 'localhost:40000') then begin // if(ARequestInfo.Document = '/index.php') then begin if (Pos('multipart/form-data', LowerCase(ARequestInfo.ContentType))>0) and // далее идёт обработка multipart (Pos('boundary', LowerCase(ARequestInfo.ContentType))>0) then begin Header := TStringList.Create; try ExtractHeaderFields([';'], [' '], PChar(ARequestInfo.ContentType), Header, False, False); Boundary := Header.Values['boundary']; finally Header.Free; end; MemoryStream := TMemoryStream.Create; try MemoryStream.LoadFromStream(ARequestInfo.PostStream); AllContent := ''; ByteToRead := ARequestInfo.ContentLength; try while ByteToRead > 0 do begin RSize := MaxReadBlockSize; if RSize > ByteToRead then RSize := ByteToRead; GetMem(Buffer, RSize); try ReadedBytes := MemoryStream.Read(Buffer^, RSize); SetString(BufferStr, Buffer, ReadedBytes); AllContent := AllContent + BufferStr; finally FreeMem(Buffer, RSize); end; ByteToRead := ARequestInfo.ContentLength - Length(AllContent); end; AResponseInfo.ContentText := 'ok'; AResponseInfo.WriteContent; except on E: Exception do begin AResponseInfo.ContentText := E.Message; AResponseInfo.WriteContent; end; end; finally MemoryStream.Free; end; if ARequestInfo.ContentLength = Length(AllContent) then while Length(AllContent) > Length('--' + Boundary + '--' + #13#10) do begin Header := TStringList.Create; HList := TStringList.Create; try AllContent := ReadMultipartRequest('--' + Boundary, AllContent, Header, Data); ExtractHeaderFields([';'], [' '], PChar(Header.Values['Content-Disposition']), HList, False, True); if (Header.Values['Content-Type'] <> '') and (Data <> '') and(HList.Values['filename']<>'') // << corrected here then begin OutStream:=TFileStream.Create(UploadPath + ExtractFileName(HList.Values['filename']), fmCreate); try try OutStream.WriteBuffer(Pointer(Data)^, Length(Data)); mmo3.Lines.Add('File Successfully Uploaded'); except on E:Exception do ShowMessage(E.ClassName+' Exception Raised : ' +#13#10+#13#10+E.Message); end; finally OutStream.Free; end end else begin mmo3.Lines.Add(Format('<p>Field <b>%s</b> = %s',[HList.Values['name'], Data])); end; finally mmo1.Lines := Header; mmo2.Lines := HList; Header.Free; HList.Free; end; end; end; if(Pos('application/x-www-form-urlencoded', LowerCase(ARequestInfo.ContentType))>0) then begin MemoryStream := TMemoryStream.Create; try MemoryStream.LoadFromStream(ARequestInfo.PostStream); AllContent := ''; ByteToRead := ARequestInfo.ContentLength; try while ByteToRead > 0 do begin RSize := MaxReadBlockSize; if RSize > ByteToRead then RSize := ByteToRead; GetMem(Buffer, RSize); try ReadedBytes := MemoryStream.Read(Buffer^, RSize); SetString(BufferStr, Buffer, ReadedBytes); AllContent := AllContent + BufferStr; finally FreeMem(Buffer, RSize); end; ByteToRead := ARequestInfo.ContentLength - Length(AllContent); end; AResponseInfo.ContentText := 'ok'; AResponseInfo.WriteContent; except on E: Exception do begin AResponseInfo.ContentText := E.Message; AResponseInfo.WriteContent; end; end; finally MemoryStream.Free; end; QueryPreParsing(AllContent, Params); QueryParsing(Params, Query.params, Query.values); mmo1.Lines := Query.params; mmo2.Lines := Query.values; end; end; end; end; |