?? postfile.pas
字號:
WriteLine('Content-Disposition: form-data; name="userfile"; filename="' + FileName + '"');
WriteLine('Content-Type: application/octet-stream');
WriteLine('');
end;
Boundry := #13#10+'--'+Boundry+'--';
BufferIn.dwStructSize := sizeof( INTERNET_BUFFERS );
BufferIn.Next := nil;
BufferIn.lpcszHeader := PChar(Header);
BufferIn.dwHeadersLength := Length(Header);
BufferIn.dwHeadersTotal := 1;
BufferIn.lpvBuffer := nil;
BufferIn.dwBufferLength := 0;
BufferIn.dwBufferTotal := Length(Buffer) + Length(Boundry);// + SendFile.FileSize;
if Assigned(SendFile) then
begin
BufferIn.dwBufferTotal := BufferIn.dwBufferTotal + SendFile.FileSize;
end;
BufferIn.dwOffsetLow := 0;
BufferIn.dwOffsetHigh := 0;
Prog.SetMessage('Sending Request...');
//Debug('Postfile HttpSendRequestEx+');
{ if not HttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
begin
Debug('Postfile HttpSendRequestEx*');
raise InetException.Create('HttpSendRequest failed');
end;}
if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
begin
Debug('Postfile HttpSendRequestEx*');
if Options.GetAllowUnknownCA and (GetLastError = ERROR_INTERNET_INVALID_CA) then
begin
QueryLen := sizeof(Flags);
JInternetQueryOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
@Flags, QueryLen);
Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
JInternetSetOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
@Flags, Sizeof(Flags) );
if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
begin
// big trouble this time...
raise InetException.Create('HttpSendRequest failed');
end;
end
else
begin
raise InetException.Create('HttpSendRequest failed');
end;
end;
//Debug('Postfile HttpSendRequestEx-');
WriteString(Buffer);
if Assigned(SendFile) then
begin
SendFileContents;
end;
WriteString(Boundry);
//Debug('Postfile HttpEndRequest+');
if not JHttpEndRequest(Request, nil, 0, 0) then
begin
Debug('Postfile HttpEndRequest*');
raise InetException.Create('HttpEndRequest failed');
end;
//Debug('Postfile HttpEndRequest-');
Prog.SetMessage('Downloading...');
SetLength(QueryBuffer, 1024);
QueryLen := Length(QueryBuffer);
QueryIdx := 0;
//Debug('Postfile HttpQueryInfo+');
if JHttpQueryInfo(Request, HTTP_QUERY_CONTENT_LENGTH, PChar(QueryBuffer), QueryLen, QueryIdx) then
begin
//Debug('Postfile HttpQueryInfo-');
SetLength(QueryBuffer, QueryLen);
//Debug(QueryBuffer);
Prog.setNoActions(StrToInt(QueryBuffer));
end
else
begin
Debug('Postfile HttpQueryInfo*');
Debug('Error ' + IntToStr(GetLastError));
end;
ReadResult;
Prog.SetMessage('Done');
finally
//Debug('Postfile InternetCloseHandle+');
JInternetCloseHandle(Request);
//Debug('Postfile InternetCloseHandle-');
end;
finally
if Assigned(SendFile) then
begin
SendFile.Free;
end;
RecvFile.Free;
end;
Prog.phaseDone;
end;
var
Character : array[0..61] of Char = ('a','b','c','d','e','f','g','h','i','j',
'k','l','m','n','o','p','q','r','s','t',
'u','v','w','x','y','z','A','B','C','D',
'E','F','G','H','I','J','K','L','M','N',
'O','P','Q','R','S','T','U','V','W','X',
'Y','Z','1','2','3','4','5','6','7','8',
'9','0');
function TPostFile.GenerateBoundryString : String;
var
i : Integer;
function GetChar : Char;
begin
Result := Character[Random(62)];
end;
begin
for i := 1 to 16 do
begin
Result := Result + GetChar;
end;
Result := 'POSTFILE' + Result + 'POSTFILE';
end;
procedure TPostFile.Post(Keys : TStringList; Values : TStringList; FileName : String; Results : TStringList);
var
Request : HINTERNET;
Buffer : String;
SendFile : TBinaryFile;
SentLength : DWORD;
procedure WriteString(S : String);
var
Actual : DWORD;
begin
//Debug('Postfile InternetWriteFile+');
if not JInternetWriteFile(Request, PChar(S), Length(S), Actual) then
begin
Debug('Postfile InternetWriteFile*');
raise InetException.Create('InternetWriteFile failed');
end;
//Debug('Postfile InternetWriteFile-');
if Int64(Actual) < Length(S) then
begin
Debug('Short write. Len = ' + IntToStr(Length(S)) + ' Actual = ' + IntToStr(Actual));
end;
SentLength := SentLength + Actual;
//Debug('Amount sent = ' + IntToStr(SentLength));
Prog.SetPos(SentLength);
end;
procedure WriteLine(S : String);
begin
Buffer := Buffer + S + #13#10;
end;
procedure SendFileContents;
var
BytesRemaining : Int64;
Buffer : String;
begin
BytesRemaining := SendFile.FileSize;
while BytesRemaining > 0 do
begin
if BytesRemaining < 1024 then
begin
SetLength(Buffer, BytesRemaining);
end
else
begin
SetLength(Buffer, 1024);
end;
SendFile.BlockRead2(PChar(Buffer), Length(Buffer));
WriteString(Buffer);
BytesRemaining := BytesRemaining - Length(Buffer);
end;
end;
procedure ReadResult;
var
Actual : DWORD;
Buffer : String;
TempBuffer : String;
begin
while true do
begin
SetLength(Buffer, 1024);
//Debug('Postfile InternetReadFile+');
if not JInternetReadFile(Request, PChar(Buffer), Length(Buffer), Actual) then
begin
Debug('Postfile InternetReadFile*');
raise InetException.Create('InternetReadFile failed');
end;
//Debug('Postfile InternetReadFile-');
if Actual = 0 then
begin
break;
end;
SetLength(Buffer, Actual);
TempBuffer := TempBuffer + Buffer;
end;
Results.Text := TempBuffer;
end;
var
Header : String;
Boundry : String;
Flags : DWORD;
BufferIn : INTERNET_BUFFERS;
i : Integer;
QueryLen : DWORD;
Strength : DWORD;
begin
Prog.setNoActions(0);
if Connection = nil then
begin
Connect;
end;
Prog.SetMessage('Opening...');
SendFile := nil;
try
if Length(FileName) > 0 then
begin
SendFile := TBinaryFile.Create;
SendFile.Assign(FileName);
SendFile.Open(OPEN_READ_ONLY);
end;
Flags := INTERNET_FLAG_NO_CACHE_WRITE;
if UseHTTPS then
begin
Flags := Flags or INTERNET_FLAG_SECURE;
end;
if AllowWrongProperName then
begin
Flags := Flags or INTERNET_FLAG_IGNORE_CERT_CN_INVALID;
end;
if AllowExpiredCertificate then
begin
Flags := Flags or INTERNET_FLAG_IGNORE_CERT_DATE_INVALID;
end;
//Debug('Postfile HttpOpenRequest+');
Request := JHttpOpenRequest(Connection, 'POST', PChar(ScriptName), nil, nil, nil, Flags, 0);
if Request = nil then
begin
Debug('Postfile HttpOpenRequest*');
raise InetException.Create('HttpOpenRequest failed');
end;
//Debug('Postfile HttpOpenRequest-');
try
Boundry := GenerateBoundryString;
Header := 'Content-Type: multipart/form-data; boundary=' + Boundry;
for i := 0 to Keys.Count - 1 do
begin
WriteLine('--'+Boundry);
WriteLine('Content-Disposition: form-data; name="' + Keys[i] + '"');
WriteLine('');
WriteLine(Values[i]);
end;
WriteLine('--'+Boundry);
WriteLine('Content-Disposition: form-data; name="pramcount"');
WriteLine('');
WriteLine(IntToStr(Keys.Count));
if Assigned(SendFile) then
begin
WriteLine('--'+Boundry);
WriteLine('Content-Disposition: form-data; name="userfile"; filename="' + FileName + '"');
WriteLine('Content-Type: application/octet-stream');
WriteLine('');
end;
Boundry := #13#10+'--'+Boundry+'--';
BufferIn.dwStructSize := sizeof( INTERNET_BUFFERS );
BufferIn.Next := nil;
BufferIn.lpcszHeader := PChar(Header);
BufferIn.dwHeadersLength := Length(Header);
BufferIn.dwHeadersTotal := 1;
BufferIn.lpvBuffer := nil;
BufferIn.dwBufferLength := 0;
BufferIn.dwBufferTotal := Length(Buffer) + Length(Boundry);// + SendFile.FileSize;
if Assigned(SendFile) then
begin
BufferIn.dwBufferTotal := BufferIn.dwBufferTotal + SendFile.FileSize;
end;
BufferIn.dwOffsetLow := 0;
BufferIn.dwOffsetHigh := 0;
//Debug('Total size to send : ' + IntToStr(BufferIn.dwBufferTotal));
Prog.setNoActions(BufferIn.dwBufferTotal);
if Assigned(SendFile) then
begin
Prog.SetMessage('Uploading...');
end
else
begin
Prog.SetMessage('Sending Request...');
end;
// The new IE or Win2K service pack allows us to set this flag now
// in fact if we set it later it gets cleared again...
if Options.GetAllowUnknownCA then
begin
QueryLen := sizeof(Flags);
InternetQueryOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
@Flags, QueryLen);
Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
InternetSetOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
@Flags, Sizeof(Flags) );
end;
//Debug('Postfile HttpSendRequestEx+');
if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
begin
Debug('Postfile HttpSendRequestEx*');
if Options.GetAllowUnknownCA and (GetLastError = ERROR_INTERNET_INVALID_CA) then
begin
QueryLen := sizeof(Flags);
JInternetQueryOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
@Flags, QueryLen);
Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
JInternetSetOption (Request, INTERNET_OPTION_SECURITY_FLAGS,
@Flags, Sizeof(Flags) );
// do we need to write the data again???
if not JHttpSendRequestEx(Request, @BufferIn, nil, HSR_INITIATE, 0) then
begin
// big trouble this time...
raise InetException.Create('HttpSendRequest failed');
end;
// the https was a success but the script was not for some reason
// we need to say try again, again...
raise InetException.Create('HttpSendRequest failed');
end
else
begin
raise InetException.Create('HttpSendRequest failed');
end;
end;
//Debug('Postfile HttpSendRequestEx-');
WriteString(Buffer);
if Assigned(SendFile) then
begin
SendFileContents;
end;
WriteString(Boundry);
//Debug('Postfile HttpEndRequest+');
if not JHttpEndRequest(Request, nil, 0, 0) then
begin
Debug('Postfile HttpEndRequest*');
raise InetException.Create('HttpEndRequest failed');
end;
//Debug('Postfile HttpEndRequest-');
Prog.SetMessage('Reading Response...');
// find out the ssl key size
QueryLen := sizeof(Strength);
//Debug('Postfile InternetQueryOption+');
if JInternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, @Strength, QueryLen) then
begin
//Debug('Postfile InternetQueryOption-');
Options.setSSLStrength(Strength);
end
else
begin
Debug('Postfile InternetQueryOption*');
Debug('Error getting INTERNET_OPTION_SECURITY_FLAGS');
end;
ReadResult;
Prog.SetMessage('Done');
finally
//Debug('Postfile InternetCloseHandle+');
JInternetCloseHandle(Request);
//Debug('Postfile InternetCloseHandle-');
end;
finally
if Assigned(SendFile) then
begin
SendFile.Free;
end;
end;
Prog.phaseDone;
end;
end.
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -