HTTP File Upload

Unit HttpUploadFile.pas

unit HttpUploadFile;

interface

uses Windows, WinSock, SysUtils;

function HTTPPostData(host:string;script:string;filePath:string;remoteFilename:String):integer;

var
  sSock : TSocket;
  sAddr: TSockAddrIn;
  sWsa : TWSAData;
  sPort : integer = 80;
  rturn :integer;
  i: Integer;

implementation

//found somewhere on the net
function GetIPFromHost(const HostName: string): string;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  i: Integer;
  GInitData: TWSAData;
begin
  WSAStartup($101, GInitData);
  Result := '';
  phe := GetHostByName(PChar(HostName));
  if phe = nil then Exit;
  pPtr := PaPInAddr(phe^.h_addr_list);
  i := 0;
  while pPtr^[i] <> nil do
  begin
    Result := inet_ntoa(pptr^[i]^);
    Inc(i);
  end;
  WSACleanup;
end;

//credits to steve10120
function readFiletoString(fpath:string; var fbuffer:string):boolean;
  var
      fhandle: Thandle;
      dSize: DWORD;
      dRead: DWORD;

  begin
    Result:= False;
    fhandle := CreateFile(PChar(fpath), GENERIC_READ, FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
    if fhandle <> 0 then
      begin
         dSize := GetFileSize(fhandle, nil);
         if dSize<>0 then
          begin
            SetFilepointer(fhandle,0,nil, FILE_BEGIN);
            SetLength(fbuffer, dSize);
              if ReadFile(fhandle, fbuffer[1],dSize, dRead, nil) then
                begin
                  Result:= True;
                end;
             CloseHandle(fhandle);

          end;
      end;

end;

function HTTPPostData(host:string;script:string;filePath:string;remoteFilename:String):integer;
 var
  data : string;
  fileContents : string;
  bodySize: string;
  bodyContents: string;
  hostIp: string;
  boundary: string;
  formName: string;

 begin

   boundary :=  '---------------------------282861610524488';
   formName := 'data';
  //read file
  if  not readFiletoString(filePath,fileContents) then
    begin
      Result :=-1;
      exit;
    end;

  bodyContents := '--' + boundary + #13#10;
  bodyContents := bodyContents + 'Content-Disposition: form-data; name="'+formName+'"; filename="'+ remotefilename +'"';
  bodyContents := bodyContents + #13#10 + 'Content-Type: application/octet-stream';
  bodyContents := bodyContents + #13#10 + #13#10 + fileContents + #13#10;
  bodyContents := bodyContents  + '--'+ boundary + '--' + #13#10;

  bodySize := IntToStr(Length(bodyContents));



 //generate headers and body
  data := 'POST ' + script +' HTTP/1.1' + #13#10 + 'Host: ' + host  +#13#10;
  data := data + 'User-Agent: Uploador' + #13#10;
  data := data + 'Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8' + #13#10;
  data := data + 'Content-Type: multipart/form-data; boundary=' + boundary + #13#10;
  data := data + 'Connection: Keep-Alive' + #13#10;
  data := data + 'Content-Length: ' + bodySize + #13#10 + #13#10;


  data := data + bodyContents;

  WSAStartup($1010, sWsa);
  sSock := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);

  //get ip from hostname
  hostIp := GetIpFromHost(host);

  if  hostIp = '' then
    begin
      Result:=-2;
      Exit;
    end;
  

  sAddr.sin_family := AF_INET;
  sAddr.sin_port := hTons(sPort);
  sAddr.sin_addr.S_addr := inet_addr(PChar(hostIp));

  rturn := connect(sSock, sAddr, SizeOf(sAddr));

  if rturn = SOCKET_ERROR Then
    begin
      Result:=-3;
      exit;
    end
  else
    begin
      rturn:=send(sSock, data[1], Length(data), 0);
      Sleep(4000);
      closesocket(sSock);
      Result:=0;
    end;

 end;

end.

Unit1 :

uses WinSock, HttpUploadFile

//

procedure TForm1.btnBrowseClick(Sender: TObject);
begin
  opDialog.InitialDir := GetCurrentDir;
  opDialog.Options := [ofFileMustExist];
  opDialog.Execute();

  if opdialog.FileName <> ''  then
    begin
        editfilepath.Text := opDialog.FileName;
    end;
end;


procedure TForm1.btnUploadClick(Sender: TObject);
begin
  if editfilepath.Text <> '' then
    begin
      btnUpload.Enabled := False;
      btnBrowse.Enabled := False;
      // enter teh host, script here.
       case( HTTPPostData('localhost','/leadMX/test.php',editFilePath.Text , ExtractFileName(opdialog.FileName))) of
          0: MessageBox(0,'File Uploaded!', 'Success', MB_OK);
          -1: MessageBox(0,'Error reading file', 'Error', MB_OK);
          -2: MessageBox(0,'Error resolving host', 'Error', MB_OK);
          -3: MessageBox(0, 'Error connecting to host', 'Error', MB_OK);
        end;
      btnUpload.Enabled := True;
      btnBrowse.Enabled := True;

    end
  else
    begin
      MessageBox(0,'Please select a file first.', 'Error', MB_OK);
    end;
end;