1,593
社区成员
发帖
与我相关
我的任务
分享
unit uUpGuestfile;
interface
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
TMultiPartFormDataStream = 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
{ TMsMultiPartFormDataStream }
constructor TMultiPartFormDataStream.Create;
begin
inherited;
FBoundary := GenerateUniqueBoundary;
FRequestContentType := CONTENT_TYPE + FBoundary;
end;
procedure TMultiPartFormDataStream.AddFile(const FieldName, FileName,
ContentType: string; FileData: TStream);
var
sFormFieldInfo: 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);
try
FileData.Read(Buffer^, iSize);
Write(Buffer^, iSize);
finally
FreeMem(Buffer, iSize);
end;
end;
procedure TMultiPartFormDataStream.AddFile(const FieldName, FileName,
ContentType: string);
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
AddFile(FieldName, FileName, ContentType, FileStream);
finally
FileStream.Free;
end;
end;
procedure TMultiPartFormDataStream.AddFormField(const FieldName,
FieldValue: string);
var
sFormFieldInfo: string;
begin
sFormFieldInfo := Format(CRLF + '–' + Boundary + CRLF + CONTENT_DISPOSITION +
CRLF + CRLF + FieldValue, [FieldName]);
Write(Pointer(sFormFieldInfo)^, Length(sFormFieldInfo));
end;
function TMultiPartFormDataStream.GenerateUniqueBoundary: string;
begin
Result := '—————————' + FormatDateTime('mmddyyhhnnsszzz', Now);
end;
procedure TMultiPartFormDataStream.PrepareStreamForDispatch;
var
sFormFieldInfo: string;
begin
sFormFieldInfo := CRLF + '–' + Boundary + '–' + CRLF;
Write(Pointer(sFormFieldInfo)^, Length(sFormFieldInfo));
Position := 0;
end;
end.
function TfrmDmServer.UpfilestoPC(sfilename, sphotoimg: string): string;
var
sUpResult: string;
ResponseStream: TStringStream;
upMds: TMultiPartFormDataStream;
begin
upMds := TMultiPartFormDataStream.Create;
ResponseStream := TStringStream.Create;
try
idhtpSvr.Request.ContentType := upMds.RequestContentType;
upMds.AddFile('guest', sfilename, 'txt');
upMds.AddFile('photo', sphotoimg, 'jpg');
{ You must make sure you call this method *before* sending the stream }
upMds.PrepareStreamForDispatch;
upMds.Position := 0;
try
idhtpSvr.Post('http://IP地址/upfile',
upMds, ResponseStream);
except
on e: exception do
begin
Showmessage('意外:'+E.message);
end;
end;
ResponseStream.Position := 0;
sUpResult := ResponseStream.DataString;
sUpResult := UpperCase(Trim(sUpResult));
finally
upMds.Free;
ResponseStream.Free;
end;
<form name="form1" enctype="multipart/form-data" method="post" action="上传文件处理服务地址">
信息(txt): <input type="file" name="guest"></br>
照片(jpg): <input type="file" name="photo"></br>
<input type="submit" name="Submit" value="提交 ">
</form>