Hi!
I have written a small unit to help me post data to servers expecting a HTML form. Shown below, (i have stripped away some very specific stuff so it might not compile), is the general idea and it seems to work pretty well.
If anyone cares to comment about this - i have a feeling it can be improved - i'd appreciate it. Especially how i have used the various RTC data types and Info objects...
type
TClientUtilsEventClass = class
private
class procedure PostMultipartBeginRequest(Sender: TRtcConnection);
class procedure PostMultipartDataSent(Sender: TRtcConnection);
class procedure PostMultipartDataReceived(Sender: TRtcConnection);
end;
const
CR = #$0d;
LF = #$0a;
CRLF = CR + LF;
C64k = 65536;
class procedure TClientUtilsEventClass.PostMultipartBeginRequest(Sender: TRtcConnection);
var
Cli: TRtcDataClient absolute Sender;
begin
Cli.WriteHeader;
end;
class procedure TClientUtilsEventClass.PostMultipartDataSent(Sender: TRtcConnection);
var
lSize: int64;
Cli: TRtcDataClient absolute Sender;
begin
if Cli.Request.ContentLength > Cli.Request.ContentOut then
begin
lSize := Cli.Request.ContentLength - Cli.Request.ContentOut;
if lSize > C64k then lSize := C64k;
Cli.Write(RtcBytesToString(Copy(Cli.Request.Info.asByteArray['payload'], Cli.Request.ContentOut, lSize)));
end;
end;
class procedure TClientUtilsEventClass.PostMultipartDataReceived(Sender: TRtcConnection);
var
Cli: TRtcDataClient absolute Sender;
begin
if Cli.Response.Done then
Cli.Info['response'] := Cli.Read;
end;
function PostHTTPMultipart(const aCommand: string; lAttachments: TStrings): Variant;
procedure AddFile(aPayload: TRtcHugeString; aBound: RtcString; aFileName: string);
begin
aPayload.Add('--' + aBound + CRLF);
aPayload.Add(Utf8Encode('content-disposition: form-data; name="datafile"; filename="' + aFileName +'"') + CRLF);
aPayload.Add(Utf8Encode('content-type: application/octet-string') + CRLF + CRLF);
aPayload.Add(Read_file(aFileName));
aPayload.Add(CRLF);
end;
procedure AddField(aPayload: TRtcHugeString; aBound: RtcString; aFieldName, aFieldContent: string);
begin
aPayload.Add('--' + aBound + CRLF);
aPayload.Add(Utf8Encode('content-disposition: form-data; name="' + aFieldName + '"') + CRLF + CRLF);
aPayload.Add(Utf8Encode(aFieldContent));
aPayload.Add(CRLF);
end;
var
I: Integer;
lPostMultipartRequest: TRtcDataRequest;
lPostMultipartHttpClient: TRtcHttpClient;
lPayload: TRtcHugeString;
lBound: RtcString;
begin
lPayload := TRtcHugeString.Create;
lPostMultipartRequest := TRtcDataRequest.Create(nil);
lPostMultipartHttpClient := TRtcHttpClient.Create(nil);
try
with lPostMultipartHttpClient do
begin
AutoConnect := true;
Blocking := true;
ReconnectOn.ConnectLost := true;
ServerAddr := 'www.aserver.com'; //GUploadUtilsServerAddress;
ServerPort := '80'; //GUploadUtilsServerPort;
UseSSL := false; //GUploadUtilsUseSSL;
end;
lBound := IntToHex(Random(MaxInt), 8) + '_MySystem_boundary';
with lPostMultipartRequest do
begin
Client := lPostMultipartHttpClient;
OnBeginRequest := TClientUtilsEventClass.PostMultipartBeginRequest;
OnDataSent := TClientUtilsEventClass.PostMultipartDataSent;
OnDataReceived := TClientUtilsEventClass.PostMultipartDataReceived;
Request.Method := 'POST';
Request.FileName := '/' + aCommand;
Request.Host := lPostMultipartHttpClient.ServerAddr + ':' + lPostMultipartHttpClient.ServerPort;
// Request.Value[''] / Request.Cookies / et. al.
// Payload/Content Body call once for each field
AddField(lPayload, lBound, 'form_field_name', 'Form field value');
// Attachments...
for I := 0 to lAttachments.Count - 1 do
begin
AddFile(lPayload, lBound, lAttachments[I]);
end;
lPayload.Add('--' + lBound + '--' + CRLF);
Request.Info.asByteArray['payload'] := lPayload.GetEx;
Request.ContentLength := lPayload.Size;
Request.ContentType := 'multipart/form-data; boundary=' + lBound;
Post;
end;
with lPostMultipartHttpClient do
begin
DisconnectNow;
if not Info.isNull['response'] then
Result := Info['response'];
end;
end;
finally
lPostMultipartHttpClient.Free;
lPostMultipartRequest.Free;
lPayload.Free;
end;
end;
TIA,
/Dany