delphi中通過TIdhttp控制項上載檔案

2021-04-13 09:12:23 字數 4678 閱讀 5195

附帶的例子由於indy版本的問題,有點小問題(其實用文字工具修改一下dfm,去掉新增的屬性就可以了)。我乾脆把原始碼給貼出來吧,版權屬於原作者

一.用於實現form流格式的單元(m**ultipartformdata.pas)

unit m**ultipartformdata;

inte***ce

uses

sysutils, classes;

const

content_type = 'multipart/form-data; boundary=';

crlf = #13#10;

content_disposition = 'content-disposition: form-data; name="%s"';

file_name_place_holder = '; filename="%s"';

content_type_place_holder = 'content-type: %s' + crlf + crlf;

content_length = 'content-length: %d' + crlf;

type

tm**ultipartformdatastream = class(tmemorystream)

private

fboundary: string;

frequestcontenttype: string;

function generateuniqueboundary: string;

public

procedure addformfield(const fieldname, fieldvalue: string);

procedure addfile(const fieldname, filename, contenttype: string; filedata: tstream); overload;

procedure addfile(const fieldname, filename, contenttype: string); overload;

procedure preparestreamfordispatch;

constructor create;

property boundary: string read fboundary;

property requestcontenttype: string read frequestcontenttype;

end;

implementation

constructor tm**ultipartformdatastream.create;

begin

inherited;

fboundary := generateuniqueboundary;

frequestcontenttype := content_type + fboundary;

end;

procedure tm**ultipartformdatastream.addfile(const fieldname, filename,

contenttype: string; filedata: tstream);

varsformfieldinfo: string;

buffer: pchar;

isize: int64;

begin

isize := filedata.size;

sformfieldinfo := format(crlf + '--' + boundary + crlf + content_disposition +

file_name_place_holder + crlf + content_length +

content_type_place_holder, [fieldname, filename, isize, contenttype]);

write(pointer(sformfieldinfo)^, length(sformfieldinfo));

filedata.position := 0;

getmem(buffer, isize);

tryfiledata.read(buffer^, isize);

write(buffer^, isize);

finally

freemem(buffer, isize);

end;

end;

procedure tm**ultipartformdatastream.addfile(const fieldname, filename,

contenttype: string);

varfilestream: tfilestream;

begin

filestream := tfilestream.create(filename, fmopenread or fmsharedenywrite);

tryaddfile(fieldname, filename, contenttype, filestream);

finally

filestream.free;

end;

end;

procedure tm**ultipartformdatastream.addformfield(const fieldname,

fieldvalue: string);

varsformfieldinfo: string;

begin

sformfieldinfo := format(crlf + '--' + boundary + crlf + content_disposition + crlf + crlf +

fieldvalue, [fieldname]);

write(pointer(sformfieldinfo)^, length(sformfieldinfo));

end;

function tm**ultipartformdatastream.generateuniqueboundary: string;

begin

result := '---------------------------' + formatdatetime('mmddyyhhnnsszzz', now);

end;

procedure tm**ultipartformdatastream.preparestreamfordispatch;

varsformfieldinfo: string;

begin

sformfieldinfo := crlf + '--' + boundary + '--' + crlf;

write(pointer(sformfieldinfo)^, length(sformfieldinfo));

position := 0;

end;

end.

二。呼叫的方法:

1。先包含m**ultipartformdata(uses m**ultipartformdata;)

2。把如下**加到需要的地方

//新增表單的字段 (前乙個引數是欄位名,後乙個引數是字段值)

multipartformdatastream.addformfield('personname', edtpersonname.text);

multipartformdatastream.addformfield('description', edtdescription.text);

//新增上載的檔案(第乙個是欄位名,第二個是檔名,第三個是檔案型別)

multipartformdatastream.addfile(edtfile.name, edtfile.text, edtmimetype.text);

multipartformdatastream.preparestreamfordispatch;

multipartformdatastream.position := 0;

//呼叫idhttp的post方法,第乙個引數是用於處理上載form的asp/php等等指令碼,第三個是接收指令碼執行完成後的返回內容)

從這些**可以引出很多應用:

1。asp裡呼叫其它指令碼語言如(php,jsp,等等)。把這段**用元件實現,在asp中呼叫,就可以 了。

2。從普通的應用程式呼叫asp,php等等指令碼

3。傳統的html中,必須在瀏覽器中選擇檔案,才能上載(號稱是為了安全),通過這個就可以實現

不通過選擇檔案,實現上載。 

delphi通過UniDAC直連oracle資料庫

1.通過uniquery查詢資料 uniquery.close uniquery.sql.clear uniquery.sql.text select from abc uniquery.open 出現的問題 先使用uniquery查abc表,再用uniquery查d表,查完程式直接死掉。解決辦法 ...

delphi通過winexec執行服務註冊

delphi xe 10.2.2 通過呼叫winexec進行服務註冊,這樣寫 winexec pansichar aaa.exe install sw hide 可以成功註冊,但是這樣寫就一直不能註冊服務var v str string begin v str aaa.exe install win...

delphi 實現通過ip位址獲取mac位址

function sendarp ipaddr ulong temp dword ulmacaddr pointer ulmacaddrleng pointer dword stdcall external iphlpapi.dll name sendarp function getmacbyip ...