unit uMain;

interface

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


  ;



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

type
  TfHTTP_Send_and_Recieve_File = class(TForm)
    IdHTTPServer: TIdHTTPServer;
    mmo1: TMemo;
    mmo2: TMemo;
    mmo3: TMemo;
    Send_Multipart: TButton;
    IdHTTP: TIdHTTP;
    OpenDialog: TOpenDialog;


    procedure IdHTTPServerCommandGet(AContext: TIdContext; ARequestInfo: TIdHTTPRequestInfo;
      AResponseInfo: TIdHTTPResponseInfo);
    procedure FormCreate(Sender: TObject);
    procedure Send_MultipartClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);

  private

  Params:TStringList;
  Query: TQuery;

    function ReadMultipartRequest(const Boundary: Ansistring; ARequest: Ansistring; var AHeader: TStringList;
      var Data: Ansistring): Ansistring;


      procedure QueryPreParsing(s: string; var res: TStringList);
    procedure QueryParsing(list: TStrings; var params, values: TStringList);


    { Private declarations }
  public
    { Public declarations }
  end;

var
  fHTTP_Send_and_Recieve_File: TfHTTP_Send_and_Recieve_File;

implementation

{$R *.dfm}



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






//-------------------------------


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;


end.
