Delphi. Как отправить файл с помощью idHTTP и принять его на idHTTPServer ?

Данный пример отправляет файлы и сообщения на сервер, а также принимает и раскодирует их.

Работал с FTP протоколом, но столкнулся с рядом ограничений, которые как я понял можно преодолеть при помощи HTTP протокола и которые не позволяют мне решить поставленную задачу. В частности, мне нужна была многопоточная загрузка на сервер, это возможно было только при пассивном режиме FTP сервера с открытием нескольких портов.

Я работаю с Azure и для разворачивания там FTP сервера с 1000 открытыми портами, скажем – задача нетривиальная. Да и для безопасности это нехорошо. Все порты изначально защищены щитом из endpoints. По умолчанию endpoints открываются по одной на портале. Да и ряд других ограничений – невозможность копировать файлы на сервере, скажем, и др.

Если представить такое разворачивание одного только FTP сервера на машинах нескольких клиентов, то это адский труд))

Итак, переходим на HTTP протокол. Сегодня сделаем простую вещь – отправку файла с клиента на сервер по HTTP протоколу.

Нам понадобится idHTTPServer сервер из библиотеки Indy, а также idHTTP клиент. Для начала добьемся самого простого – отправим один файл с клиента и примем его на сервере.

Данный код я нашёл на просторах сети, довел его до работоспособного состояния, и, наверное буду использовать как отправную точку для дальнейшей разработки. Публикую здесь, может кому-то понадобится.

Код довольно хорошо работает, для файлов до нескольких десятков мегабайт, но если, скажем загрузить 150 мб, то ругается на Out of Memory. Думаю, чуть позже можно организовать отправку файла частями ( так называемыми chunks). Это даже и хорошо – можно будет сделать прогресс сколько кусочков ушло, и в каком порядке – своеобразный прогресс так сказать.

Вот что у нас получится

Отправка файла

Прием файла

Начали!

Создадим обычное VCL приложение и добавим компоненты как на рисунке выше

Uses

  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

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

Объявляем свой тип

type
  TQuery = record
    params: TStringList;
    values: TStringList;
  end;

type

TQuery = record

params: TStringList;

values: TStringList;

end;

Далее, в секции private формы

  private

  Params:TStringList;
  Query: TQuery;

private

Params:TStringList;

Query: TQuery;

FormCreate и FormDestroy

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;

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 вспомогательных метода – для чтения данных – понадобятся чуть позже

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;

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;

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;

Чтение запроса

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;

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 обработаем следующим образом

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;

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;

Как принять файл?

Обработаем событие IdHTTPServerCommandGet idHTTP сервера

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;

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;

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

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

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;

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;

finally

MemoryStream.Free;

end;

QueryPreParsing(AllContent, Params);

QueryParsing(Params, Query.params, Query.values);

mmo1.Lines := Query.params;

mmo2.Lines := Query.values;

end;

Delphi. Как отправить файл с помощью idHTTP и принять его на idHTTPServer ?

Начали!

FormCreate и FormDestroy

Как отправить файл?

Как принять файл?

Исходники

368_httpserver

MY PROJECTS

Recent Posts

Categories