📄 urlpost.pas
字号:
unit UrlPost;
interface
function HtmlEncode(s: string): string;
procedure PostURL(const aUrl: string; FTPostQuery: string);
implementation
uses
Windows, WinInet;
function HtmlEncode(s: string): string;
var
i, v1, v2: integer;
function i2s(b: byte): char;
begin
if b <= 9 then result := chr($30 + b)
else result := chr($41 - 10 + b);
end;
begin
result := '';
for i := 1 to length(s) do
if s[i] = ' ' then result := result + '+'
else if (s[i] < ' ') or (s[i] in ['/', '\', ':', '&', '?', '|']) then
begin
v1 := ord(s[i]) mod 16;
v2 := ord(s[i]) div 16;
result := result + '%' + i2s(v2) + i2s(v1);
end
else result := result + s[i];
end;
procedure PostURL(const aUrl: string; FTPostQuery: string);
var
hSession: HINTERNET;
hConnect, hRequest: hInternet;
lpBuffer: array[0..1024 + 1] of Char;
dwBytesRead: DWORD;
HttpStr:String;
HostName, FileName: String;
FTResult: Boolean;
AcceptType: LPStr;
Buf: Pointer;
dwBufLen, dwIndex: DWord;
// 字符串转小写
function LowerCase(const Source: string): string;
var
TempChar: Char;
StrLen: Integer;
PSource,
PDest: PChar;
begin
StrLen := Length(Source);
SetLength(Result, StrLen);
PSource := @Source[1];
PDest := @Result[1];
while (StrLen > 0) do
begin
TempChar := PSource^;
if (TempChar >= 'A') and (TempChar <= 'Z') then Inc(TempChar, 32);
PDest^ := TempChar;
Inc(PSource);
Inc(PDest);
Dec(StrLen);
end;
end;
procedure ParseURL(URL: String; var HostName, FileName: String);
procedure ReplaceChar(c1, c2: Char; var St: String);
var
p: Integer;
begin
while True do
begin
p := Pos(c1, St);
if p = 0 then Break
else St[p] := c2;
end;
end;
var
i: Integer;
begin
if Pos(LowerCase('http://'), LowerCase(URL)) <> 0 then
System.Delete(URL, 1, 7);
i := Pos('/', URL);
HostName := Copy(URL, 1, i);
FileName := Copy(URL, i, Length(URL) - i + 1);
if (Length(HostName) > 0) and (HostName[Length(HostName)] = '/') then
SetLength(HostName, Length(HostName) - 1);
end;
begin
hSession := InternetOpen('MyApp', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
try
if Assigned(hSession) then
begin
ParseURL(aUrl, HostName, FileName);
hConnect := InternetConnect(hSession, PChar(HostName),
INTERNET_DEFAULT_HTTP_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
AcceptType := PChar('Accept: */*');
hRequest := HttpOpenRequest(hConnect, 'POST', PChar(FileName), 'HTTP/1.0',
nil, @AcceptType, INTERNET_FLAG_RELOAD, 0);
//
HttpSendRequest(hRequest, 'Content-Type: application/x-www-form-urlencoded', 47,
PChar(FTPostQuery), Length(FTPostQuery));
dwIndex := 0;
dwBufLen := 1024;
GetMem(Buf, dwBufLen);
FTResult := HttpQueryInfo(hRequest, HTTP_QUERY_CONTENT_LENGTH,
Buf, dwBufLen, dwIndex);
if FTResult=True then
try
while True do
begin
dwBytesRead := 1024;
InternetReadFile(hRequest, @lpBuffer, 1024, dwBytesRead);
if dwBytesRead = 0 then break;
lpBuffer[dwBytesRead] := #0;
HttpStr:=HttpStr+lpBuffer;
end;
finally
InternetCloseHandle(hRequest);
InternetCloseHandle(hConnect);
end;
end;
finally
InternetCloseHandle(hSession);
end;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -