您现在的位置:首页 >> 网络通讯 >> 网络通讯 >> 内容

Delphi中用TWebBrowser上传多文件

时间:2011/9/3 15:12:35 点击:

  核心提示:使用:UploadFilesHttpPost(WebBrowser1,'http://test.org/check',[],[],['uploaded_file'],['C:\blank.htm']...

使用:

UploadFilesHttpPost(
  WebBrowser1,
  'http://test.org/check',
  [],
  [],
  ['uploaded_file'],
  ['C:\blank.htm'] );

 

procedure UploadFilesHttpPost(const wb:TWebBrowser; const URLstring: string; names, values, nFiles, vFiles: array of string) ;
var
  strData, n, v, boundary: string;
  URL: OleVariant;
  Flags: OleVariant;
  PostData: OleVariant;
  Headers: OleVariant;
  idx: Integer;

  ms: TMemoryStream;
  ss: TStringStream;
begin
  if Length(names) <> Length(values) then
    raise Exception.Create('UploadFilesHttpPost: Names and Values must have the same length.') ;
  if Length(nFiles) <> Length(vFiles) then
    raise Exception.Create('UploadFilesHttpPost: FileNames and FileValues must have the same length.') ;

  URL := 'about:blank';
  Flags := NavNoHistory or NavNoReadFromCache or NavNoWriteToCache or NavAllowAutosearch;
  wb.Navigate2(URL, Flags) ;
  while wb.ReadyState < READYSTATE_INTERACTIVE do Application.ProcessMessages;

  // anything random that WILL NOT occur in the data.
  boundary := '---------------------------123456789';

  strData := '';
  for idx := Low(names) to High(names) do
  begin
    n := names[idx];
    v := values[idx];

    strData := strData + '--' + boundary + #13#10 + 'Content-Disposition: form-data; name="' + n + '"' + #13#10#13#10 + v + #13#10;
  end;

  for idx := Low(nFiles) to High(nFiles) do
  begin
    n := nFiles[idx];
    v := vFiles[idx];

    strData := strData + '--' + boundary + #13#10 + 'Content-Disposition: form-data; name="' + n + '"; filename="' + v + '"' + #13#10;

    if v = '' then
    begin
       strData := strData + 'Content-Transfer-Encoding: binary''#13#10#13#10;
    end
    else
    begin
      if (CompareText(ExtractFileExt(v), '.JPG') = 0) or (CompareText(ExtractFileExt(v), '.JPEG') = 0) then
      begin
        strData := strData + 'Content-Type: image/pjpeg'#13#10#13#10;
      end
      else if (CompareText(ExtractFileExt(v), '.PNG') = 0) then
      begin
        strData := strData + 'Content-Type: image/x-png'#13#10#13#10;
      end
      else if (CompareText(ExtractFileExt(v), '.PDF') = 0) then
      begin
        strData := strData + 'Content-Type: application/pdf'#13#10#13#10;
      end
      else if (CompareText(ExtractFileExt(v), '.HTML') = 0) then
      begin
      end;

      strData := strData + 'Content-Type: text/html'#13#10#13#10;

      ms := TMemoryStream.Create;
      try
        ms.LoadFromFile(v) ;
        ss := TStringStream.Create('') ;
        try
          ss.CopyFrom(ms, ms.Size) ;

          strData := strData + ss.DataString + #13#10;
        finally
          ss.Free;
        end;
      finally
        ms.Free;
      end;
    end;

    strData := strData + '--' + boundary + '--'#13#10; // FOOTER
  end;

  strData := strData + #0;

  {2. you must convert a string into variant array of bytes and every character from string is a value in array}
  PostData := VarArrayCreate([0, Length(strData) - 1], varByte) ;

  { copy the ordinal value of the character into the PostData array}
  for idx := 1 to Length(strData) do PostData[idx-1] := Ord(strData[idx]) ;

  {3. prepare headers which will be sent to remote web-server}
  Headers := 'Content-Type: multipart/form-data; boundary=' + boundary + #13#10;

  {4. you must navigate to the URL with your script and send as parameters your array with POST-data and headers}
  URL := URLstring;
  wb.Navigate2(URL, Flags, EmptyParam, PostData, Headers) ;
  while wb.ReadyState < READYSTATE_INTERACTIVE do Application.ProcessMessages;
end;

 

作者:站长 来源:转载
共有评论 0相关评论
发表我的评论
  • 大名:
  • 内容:
  • 盒子文章(www.2ccc.com) © 2024 版权所有 All Rights Reserved.
  • 沪ICP备05001939号