postfile.pas

autoupdate 1.02 source code

            WriteLine('--'+Boundry);
            WriteLine('Content-Disposition: form-data; name="userfile"; filename="' + FileName + '"');
            WriteLine('Content-Type: application/octet-stream');
            WriteLine('');
         end;

         Boundry := #13#10+'--'+Boundry+'--';

         BufferIn.dwStructSize := sizeof( INTERNET_BUFFERS );
         BufferIn.Next := nil;
         BufferIn.lpcszHeader := PChar(Header);
         BufferIn.dwHeadersLength := Length(Header);
         BufferIn.dwHeadersTotal := 1;
         BufferIn.lpvBuffer := nil;
         BufferIn.dwBufferLength := 0;
         BufferIn.dwBufferTotal := Length(Buffer) + Length(Boundry);// + SendFile.FileSize;
         if Assigned(SendFile) then
         begin
            BufferIn.dwBufferTotal := BufferIn.dwBufferTotal + SendFile.FileSize;
         end;
         BufferIn.dwOffsetLow := 0;
         BufferIn.dwOffsetHigh := 0;

         Prog.SetMessage('Sending Request...');
         //Debug('Postfile HttpSendRequestEx+');
{         if not HttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
         begin
            Debug('Postfile HttpSendRequestEx*');
            raise InetException.Create('HttpSendRequest failed');
         end;}
         if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
         begin
            Debug('Postfile HttpSendRequestEx*');
            if Options.GetAllowUnknownCA and (GetLastError = ERROR_INTERNET_INVALID_CA) then
            begin
               QueryLen := sizeof(Flags);

               JInternetQueryOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
                @Flags, QueryLen);

               Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
               JInternetSetOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
                                @Flags, Sizeof(Flags) );

               if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
               begin
                  // big trouble this time...
                  raise InetException.Create('HttpSendRequest failed');
               end;

            end
            else
            begin
               raise InetException.Create('HttpSendRequest failed');
            end;
         end;
         //Debug('Postfile HttpSendRequestEx-');

         WriteString(Buffer);
         if Assigned(SendFile) then
         begin
            SendFileContents;
         end;
         WriteString(Boundry);
         //Debug('Postfile HttpEndRequest+');
         if not JHttpEndRequest(Request, nil, 0, 0) then
         begin
            Debug('Postfile HttpEndRequest*');
            raise InetException.Create('HttpEndRequest failed');
         end;
         //Debug('Postfile HttpEndRequest-');

         Prog.SetMessage('Downloading...');
         SetLength(QueryBuffer, 1024);
         QueryLen := Length(QueryBuffer);
         QueryIdx := 0;
         //Debug('Postfile HttpQueryInfo+');
         if JHttpQueryInfo(Request, HTTP_QUERY_CONTENT_LENGTH, PChar(QueryBuffer), QueryLen, QueryIdx) then
         begin
            //Debug('Postfile HttpQueryInfo-');
            SetLength(QueryBuffer, QueryLen);
            //Debug(QueryBuffer);
            Prog.setNoActions(StrToInt(QueryBuffer));
         end
         else
         begin
            Debug('Postfile HttpQueryInfo*');
            Debug('Error ' + IntToStr(GetLastError));
         end;


         ReadResult;
         Prog.SetMessage('Done');
      finally
         //Debug('Postfile InternetCloseHandle+');
         JInternetCloseHandle(Request);
         //Debug('Postfile InternetCloseHandle-');
      end;
   finally
      if Assigned(SendFile) then
      begin
         SendFile.Free;
      end;
      RecvFile.Free;
   end;
   Prog.phaseDone;
end;


var
   Character : array[0..61] of Char = ('a','b','c','d','e','f','g','h','i','j',
                                       'k','l','m','n','o','p','q','r','s','t',
                                       'u','v','w','x','y','z','A','B','C','D',
                                       'E','F','G','H','I','J','K','L','M','N',
                                       'O','P','Q','R','S','T','U','V','W','X',
                                       'Y','Z','1','2','3','4','5','6','7','8',
                                       '9','0');

function TPostFile.GenerateBoundryString : String;
var
   i : Integer;
   function GetChar : Char;
   begin
      Result := Character[Random(62)];
   end;
begin
   for i := 1 to 32 do
   begin
      Result := Result + GetChar;
   end;
   Result := 'POSTFILE' + Result + 'POSTFILE';
end;

procedure TPostFile.Post(Keys : TStringList; Values : TStringList; FileName : String; Results : TStringList);
var
   Request  : HINTERNET;
   Buffer   : String;
   SendFile : TBinaryFile;
   SentLength : DWORD;

   procedure WriteString(S : String);
   var
      Actual : DWORD;
   begin
      //Debug('Postfile InternetWriteFile+');
      if not JInternetWriteFile(Request, PChar(S), Length(S), Actual) then
      begin
         Debug('Postfile InternetWriteFile*');
         raise InetException.Create('InternetWriteFile failed');
      end;
      //Debug('Postfile InternetWriteFile-');
      if Int64(Actual) < Length(S) then
      begin
         Debug('Short write.  Len = ' + IntToStr(Length(S)) + ' Actual = ' + IntToStr(Actual));
      end;
      SentLength := SentLength + Actual;
      //Debug('Amount sent = ' + IntToStr(SentLength));
      Prog.SetPos(SentLength);
   end;

   procedure WriteLine(S : String);
   begin
      Buffer := Buffer + S + #13#10;
   end;

   procedure SendFileContents;
   var
      BytesRemaining : Int64;
      Buffer         : String;
   begin
     BytesRemaining := SendFile.FileSize;
      while BytesRemaining > 0 do
      begin
         if BytesRemaining < 1024 then
         begin
            SetLength(Buffer, BytesRemaining);
         end
         else
         begin
            SetLength(Buffer, 1024);
         end;

         SendFile.BlockRead2(PChar(Buffer), Length(Buffer));
         WriteString(Buffer);

         BytesRemaining := BytesRemaining - Length(Buffer);
      end;
   end;

   procedure ReadResult;
   var
      Actual : DWORD;
      Buffer : String;
      TempBuffer : String;
   begin
      while true do
      begin
         SetLength(Buffer, 1024);
         //Debug('Postfile InternetReadFile+');
         if not JInternetReadFile(Request, PChar(Buffer), Length(Buffer), Actual) then
         begin
            Debug('Postfile InternetReadFile*');
            raise InetException.Create('InternetReadFile failed');
         end;
         //Debug('Postfile InternetReadFile-');
         if Actual = 0 then
         begin
            break;
         end;
         SetLength(Buffer, Actual);
         TempBuffer := TempBuffer + Buffer;
      end;

      Results.Text := TempBuffer;
   end;

var
   Header   : String;
   Boundry  : String;
   Flags    : DWORD;
   BufferIn : INTERNET_BUFFERS;
   i : Integer;
   QueryLen : DWORD;
   Strength : DWORD;
begin
   Prog.setNoActions(0);

   if Connection = nil then
   begin
      Connect;
   end;
   Prog.SetMessage('Opening...');

   SendFile := nil;
   try
      if Length(FileName) > 0 then
      begin
         SendFile := TBinaryFile.Create;

         SendFile.Assign(FileName);
         SendFile.Open(OPEN_READ_ONLY);
      end;


      Flags := INTERNET_FLAG_NO_CACHE_WRITE;

      if UseHTTPS then
      begin
         Flags := Flags or INTERNET_FLAG_SECURE;
      end;

      if AllowWrongProperName then
      begin
         Flags := Flags or INTERNET_FLAG_IGNORE_CERT_CN_INVALID;
      end;

      if AllowExpiredCertificate then
      begin
         Flags := Flags or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;
      end;

      //Debug('Postfile HttpOpenRequest+');
      Request := JHttpOpenRequest(Connection, 'POST', PChar(ScriptName), nil, nil, nil, Flags, 0);
      if Request = nil then
      begin
         Debug('Postfile HttpOpenRequest*');
         raise InetException.Create('HttpOpenRequest failed');
      end;
      //Debug('Postfile HttpOpenRequest-');

      try
         Boundry := GenerateBoundryString;

         Header := 'Content-Type: multipart/form-data; boundary=' + Boundry;

         for i := 0 to Keys.Count - 1 do
         begin
            WriteLine('--'+Boundry);
            WriteLine('Content-Disposition: form-data; name="' + Keys[i] + '"');
            WriteLine('');
            WriteLine(Values[i]);
         end;

         WriteLine('--'+Boundry);
         WriteLine('Content-Disposition: form-data; name="pramcount"');
         WriteLine('');
         WriteLine(IntToStr(Keys.Count));

         if Assigned(SendFile) then
         begin
            WriteLine('--'+Boundry);
            WriteLine('Content-Disposition: form-data; name="userfile"; filename="' + FileName + '"');
            WriteLine('Content-Type: application/octet-stream');
            WriteLine('');
         end;

         Boundry := #13#10+'--'+Boundry+'--';

         BufferIn.dwStructSize := sizeof( INTERNET_BUFFERS );
         BufferIn.Next := nil;
         BufferIn.lpcszHeader := PChar(Header);
         BufferIn.dwHeadersLength := Length(Header);
         BufferIn.dwHeadersTotal := 1;
         BufferIn.lpvBuffer := nil;
         BufferIn.dwBufferLength := 0;
         BufferIn.dwBufferTotal := Length(Buffer) + Length(Boundry);// + SendFile.FileSize;
         if Assigned(SendFile) then
         begin
            BufferIn.dwBufferTotal := BufferIn.dwBufferTotal + SendFile.FileSize;
         end;
         BufferIn.dwOffsetLow := 0;
         BufferIn.dwOffsetHigh := 0;

         //Debug('Total size to send : ' + IntToStr(BufferIn.dwBufferTotal));
         Prog.setNoActions(BufferIn.dwBufferTotal);

         if Assigned(SendFile) then
         begin
            Prog.SetMessage('Uploading...');
         end
         else
         begin
            Prog.SetMessage('Sending Request...');
         end;

         // The new IE or Win2K service pack allows us to set this flag now
         // in fact if we set it later it gets cleared again...
         if Options.GetAllowUnknownCA then
         begin
            QueryLen := sizeof(Flags);

            JInternetQueryOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
             @Flags, QueryLen);

            Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
            JInternetSetOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
                             @Flags, Sizeof(Flags) );
         end;

         //Debug('Postfile HttpSendRequestEx+');
         if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
         begin
            Debug('Postfile HttpSendRequestEx*');
            if Options.GetAllowUnknownCA and (GetLastError = ERROR_INTERNET_INVALID_CA) then
            begin
               QueryLen := sizeof(Flags);

               JInternetQueryOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
                @Flags, QueryLen);

               Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
               JInternetSetOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
                                @Flags, Sizeof(Flags) );

// do we need to write the data again???

               if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
               begin
                  // big trouble this time...
                  raise InetException.Create('HttpSendRequest failed');
               end;

               // the https was a success but the script was not for some reason
               // we need to say try again, again...
               raise InetException.Create('HttpSendRequest failed');
            end
            else
            begin
               raise InetException.Create('HttpSendRequest failed');
            end;
         end;
         //Debug('Postfile HttpSendRequestEx-');

         WriteString(Buffer);
         if Assigned(SendFile) then
         begin
            SendFileContents;
         end;
         WriteString(Boundry);
         //Debug('Postfile HttpEndRequest+');
         if not JHttpEndRequest(Request, nil, 0, 0) then
         begin
            Debug('Postfile HttpEndRequest*');


            raise InetException.Create('HttpEndRequest failed');
         end;
         //Debug('Postfile HttpEndRequest-');
         Prog.SetMessage('Reading Response...');

         // find out the ssl key size

         QueryLen := sizeof(Strength);
         //Debug('Postfile InternetQueryOption+');
         if JInternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, @Strength, QueryLen) then
         begin
            //Debug('Postfile InternetQueryOption-');
            Options.setSSLStrength(Strength);
         end
         else
         begin
            Debug('Postfile InternetQueryOption*');
            Debug('Error getting INTERNET_OPTION_SECURITY_FLAGS');
         end;

         ReadResult;
         Prog.SetMessage('Done');
      finally
         //Debug('Postfile InternetCloseHandle+');
         JInternetCloseHandle(Request);
         //Debug('Postfile InternetCloseHandle-');
      end;
   finally
      if Assigned(SendFile) then
      begin
         SendFile.Free;
      end;
   end;
   Prog.phaseDone;
end;

end.