Delphi、post 使用 WinInet 并跟踪上传进度
Delphi, post with WinInet and track upload progress
与相关：
如何提出 post 请求并跟踪进度？
这不起作用（查看评论）：
procedure StatusCallback(
hInet: HINTERNET;
Context: DWORD_PTR;
Status: DWORD;
pInformation: Pointer;
InfoLength: DWORD ); stdcall;
var
s: string;
c: Cardinal;
begin
case Status of
INTERNET_STATUS_CLOSING_CONNECTION: s := 'Closing the connection to the server';
INTERNET_STATUS_CONNECTED_TO_SERVER: s := 'Successfully connected to the socket address: ';
INTERNET_STATUS_CONNECTING_TO_SERVER: s := 'Connecting to the socket address';
INTERNET_STATUS_CONNECTION_CLOSED: s := 'Successfully closed the connection to the server';
INTERNET_STATUS_CTL_RESPONSE_RECEIVED: s := 'Not implemented';
INTERNET_STATUS_HANDLE_CLOSING: s := 'This handle value has been terminated';
INTERNET_STATUS_HANDLE_CREATED: s := 'InternetConnect has created the new handle';
INTERNET_STATUS_INTERMEDIATE_RESPONSE: s :=
'Received an intermediate (100 level) status code message from the server';
INTERNET_STATUS_NAME_RESOLVED: s := 'Successfully found the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_PREFETCH: s := 'Not implemented';
INTERNET_STATUS_RECEIVING_RESPONSE: s := 'Waiting for the server to respond to a request ';
INTERNET_STATUS_REDIRECT: s := 'HTTP request is about to automatically redirect the request ' +
PAnsiChar(pInformation);
INTERNET_STATUS_REQUEST_COMPLETE: s := 'An asynchronous operation has been completed';
INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' +
IntToStr(NativeUInt(pInformation)) + ' Byte';
INTERNET_STATUS_RESOLVING_NAME: s := 'Looking up the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server: ' +
IntToStr(NativeUInt(pInformation)) + ' Byte';
INTERNET_STATUS_SENDING_REQUEST: s := 'Sending the information request to the server.';
INTERNET_STATUS_STATE_CHANGE:
begin
s := 'Moved between a secure (HTTPS) and a nonsecure (HTTP) site.';
case DWORD(pInformation) of
INTERNET_STATE_CONNECTED: s := s + #13#10 + 'Connected state. Mutually exclusive with disconnected state.';
INTERNET_STATE_DISCONNECTED: s := s + #13#10 +
'Disconnected state. No network connection could be established.';
INTERNET_STATE_DISCONNECTED_BY_USER: s := s + #13#10 + 'Disconnected by user request.';
INTERNET_STATE_IDLE: s := s + #13#10 + 'No network requests are being made by Windows Internet.';
INTERNET_STATE_BUSY: s := s + #13#10 + 'Network requests are being made by Windows Internet.';
end;
end;
end;
tss.Add(s);
end;
function Https_Post(var callSettings: httpCallSettings; xServer,xRes: string): Integer;
const
BufferSize=1024*64;
var
hInet : HINTERNET;
hConnect : HINTERNET;
hRequest : HINTERNET;
dwc: UInt64;
ErrorCode : Integer;
lpdwBufferLength: DWORD;
lpdwReserved : DWORD;
dwBytesRead : DWORD;
lpdwNumberOfBytesAvailable: DWORD;
heads: ansistring;
header: TStringStream;
begin
tss := tstringlist.Create;
Result :=0;
callSettings.Response :='';
hInet := InternetOpen(PChar(callSettings.uAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if hInet=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetOpen Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
hConnect := InternetConnect(hInet, PChar(xServer), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, dwc);
if hConnect=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetConnect Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
hRequest := HttpOpenRequest(hConnect, 'POST', PChar(xRes), HTTP_VERSION, '', nil, INTERNET_FLAG_SECURE, dwc);
if hRequest=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpOpenRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
Header := TStringStream.Create('');
with Header do
begin
WriteString('Host: ' + xServer + sLineBreak);
WriteString('User-Agent: '+ callSettings.uAgent + SLineBreak);
WriteString('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'+SLineBreak);
WriteString('Accept-Language: en-us,en;q=0.5' + SLineBreak);
WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7'+SLineBreak);
WriteString('Keep-Alive: 300'+ SLineBreak);
if callSettings.ExtraHeader <> '' then WriteString(callSettings.ExtraHeader + SlineBreak);
if callSettings.CType <> '' then WriteString('Content-Type: ' + callSettings.cType + SlineBreak);
WriteString('Connection: keep-alive'+ SlineBreak + SlineBreak);
end;
HttpAddRequestHeaders(hRequest, PChar(Header.DataString), Length(Header.DataString), HTTP_ADDREQ_FLAG_ADD);
InternetSetStatusCallback( hRequest, @StatusCallback );
//send the post request
if not HTTPSendRequest(hRequest, nil, 0, @callSettings.postvars[1], Length(callSettings.postvars)) then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpSendRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
lpdwBufferLength:=SizeOf(Result);
lpdwReserved :=0;
//get the response code
if not HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, lpdwBufferLength, lpdwReserved) then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpQueryInfo Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
CallSettings.CallStatus := Result;
//if the response code =200 then get the body
if Result=200 then
if InternetQueryDataAvailable(hRequest, lpdwNumberOfBytesAvailable, 0, 0) then
begin
SetLength(callSettings.response,lpdwNumberOfBytesAvailable);
InternetReadFile(hRequest, @callSettings.response[1], lpdwNumberOfBytesAvailable, dwBytesRead);
end
else
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetQueryDataAvailable Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
finally
InternetCloseHandle(hRequest);
end;
finally
InternetCloseHandle(hConnect);
end;
finally
InternetCloseHandle(hInet);
end;
showmessage(tss.Text);
end;
使用 InternetSetStatusCallback() 向 HTTP 会话注册回调函数，以在请求操作的各个阶段接收状态信息。
请注意文档中的以下警告：
Note The callback function specified in the lpfnInternetCallback parameter will not be called on asynchronous operations for the request handle when the dwContext parameter of HttpOpenRequest is set to zero (INTERNET_NO_CALLBACK), or the connection handle when the dwContext handle of InternetConnect is set to zero (INTERNET_NO_CALLBACK).
试试像这样的东西：
function SockAddrToString(pAddr: LPSOCKADDR; AddrSize: DWORD): String;
var
Buf: array[0..40] of Char;
Len: DWORD;
begin
Result := '';
Len := Length(Buf);
if WSAAddressToString(pAddr, AddrSize, nil, Buf, Len) = 0 then
SetString(Result, Buf, Len-1);
end;
procedure StatusCallback(
hInet: HINTERNET;
Context: DWORD_PTR;
Status: DWORD;
pInformation: Pointer;
InfoLength: DWORD ); stdcall;
var
s: string;
begin
case Status of
INTERNET_STATUS_CLOSING_CONNECTION: s := 'Closing the connection to the server';
INTERNET_STATUS_CONNECTED_TO_SERVER: s := 'Successfully connected to the socket address: ' + SockAddrToString(PSOCKADDR(pInformation), InfoLength);
INTERNET_STATUS_CONNECTING_TO_SERVER: s := 'Connecting to the socket address: ' + SockAddrToString(PSOCKADDR(pInformation), InfoLength);
INTERNET_STATUS_CONNECTION_CLOSED: s := 'Successfully closed the connection to the server';
INTERNET_STATUS_CTL_RESPONSE_RECEIVED: s := 'Not implemented';
INTERNET_STATUS_HANDLE_CLOSING: s := 'This handle value has been terminated';
INTERNET_STATUS_HANDLE_CREATED: s := 'InternetConnect has created the new handle';
INTERNET_STATUS_INTERMEDIATE_RESPONSE: s := 'Received an intermediate (100 level) status code message from the server';
INTERNET_STATUS_NAME_RESOLVED: s := 'Successfully found the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_PREFETCH: s := 'Not implemented';
INTERNET_STATUS_RECEIVING_RESPONSE: s := 'Waiting for the server to respond to a request';
INTERNET_STATUS_REDIRECT: s := 'HTTP request is about to automatically redirect the request ' +
PAnsiChar(pInformation);
INTERNET_STATUS_REQUEST_COMPLETE: s := 'An asynchronous operation has been completed';
INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' + IntToStr(PDWORD(pInformation)^) + ' Bytes';
INTERNET_STATUS_RESOLVING_NAME: s := 'Looking up the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server';
INTERNET_STATUS_SENDING_REQUEST: s := 'Sending the information request to the server';
INTERNET_STATUS_STATE_CHANGE:
begin
s := 'Moved between a secure (HTTPS) and a nonsecure (HTTP) site.';
case PDWORD(pInformation)^ of
INTERNET_STATE_CONNECTED: s := s + #13#10 + 'Connected state. Mutually exclusive with disconnected state.';
INTERNET_STATE_DISCONNECTED: s := s + #13#10 + 'Disconnected state. No network connection could be established.';
INTERNET_STATE_DISCONNECTED_BY_USER: s := s + #13#10 + 'Disconnected by user request.';
INTERNET_STATE_IDLE: s := s + #13#10 + 'No network requests are being made by Windows Internet.';
INTERNET_STATE_BUSY: s := s + #13#10 + 'Network requests are being made by Windows Internet.';
end;
end;
end;
tss.Add(s);
end;
procedure WinInetCheck(Success: Boolean; Function: PChar);
var
ErrorCode : Integer;
begin
if not Success then
begin
ErrorCode := GetLastError;
raise Exception.CreateFmt('%s Error %d: %s', [Function, ErrorCode, GetWinInetError(ErrorCode)]);
end;
end;
function Https_Post(var callSettings: httpCallSettings; xServer, xRes: string): Integer;
const
BufferSize = 1024*64;
AcceptTypes: array[0..] of PChar = ('text/html', 'application/xhtml+xml', 'application/xml;q=0.9', '*/*;q=0.8', nil);
var
hInet : HINTERNET;
hConnect : HINTERNET;
hRequest : HINTERNET;
dwBufferLength: DWORD;
dwReserved : DWORD;
dwBytesRead : DWORD;
dwNumberOfBytesAvailable: DWORD;
Header: TStringStream;
sHeader: String;
begin
Result := 0;
tss := TStringList.Create;
try
callSettings.Response := '';
hInet := InternetOpen(PChar(callSettings.uAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
WinInetCheck(hInet <> nil, 'InternetOpen');
try
hConnect := InternetConnect(hInet, PChar(xServer), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
WinInetCheck(hConnect <> nil, 'InternetConnect');
try
hRequest := HttpOpenRequest(hConnect, 'POST', PChar(xRes), HTTP_VERSION, '', @AcceptTypes, INTERNET_FLAG_SECURE or INTERNET_FLAG_KEEP_CONNECTION, 1);
WinInetCheck(hRequest <> nil, 'HttpOpenRequest');
try
Header := TStringStream.Create('');
try
Header.WriteString('Accept-Language: en-us,en;q=0.5' + #13#10);
Header.WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7' + #13#10);
Header.WriteString('Keep-Alive: 300' + #13#10);
if callSettings.ExtraHeader <> '' then
Header.WriteString(callSettings.ExtraHeader + #13#10);
if callSettings.CType <> '' then
Header.WriteString('Content-Type: ' + callSettings.cType + #13#10);
sHeader := Header.DataString;
WinInetCheck(HttpAddRequestHeaders(hRequest, PChar(sHeader), Length(sHeader), HTTP_ADDREQ_FLAG_ADD), 'HttpAddRequestHeaders');
finally
Header.Free;
end;
InternetSetStatusCallback(hRequest, @StatusCallback);
//send the post request
WinInetCheck(HTTPSendRequest(hRequest, nil, 0, @callSettings.postvars[1], Length(callSettings.postvars)), 'HttpSendRequest');
//get the response code
dwBufferLength := SizeOf(Result);
dwReserved := 0;
WinInetCheck(HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, dwBufferLength, dwReserved), 'HttpQueryInfo');
CallSettings.CallStatus := Result;
//if the response code =200 then get the body
if Result = 200 then
begin
WinInetCheck(InternetQueryDataAvailable(hRequest, dwNumberOfBytesAvailable, 0, 0), 'InternetQueryDataAvailable');
SetLength(callSettings.response, dwNumberOfBytesAvailable);
if dwNumberOfBytesAvailable <> 0 then
WinInetCheck(InternetReadFile(hRequest, @callSettings.response[1], dwNumberOfBytesAvailable, dwBytesRead), 'InternetReadFile');
end;
finally
InternetCloseHandle(hRequest);
end;
finally
InternetCloseHandle(hConnect);
end;
finally
InternetCloseHandle(hInet);
end;
ShowMessage(tss.Text);
finally
tss.Free;
end;
end;
与相关：
如何提出 post 请求并跟踪进度？
这不起作用（查看评论）：
procedure StatusCallback(
hInet: HINTERNET;
Context: DWORD_PTR;
Status: DWORD;
pInformation: Pointer;
InfoLength: DWORD ); stdcall;
var
s: string;
c: Cardinal;
begin
case Status of
INTERNET_STATUS_CLOSING_CONNECTION: s := 'Closing the connection to the server';
INTERNET_STATUS_CONNECTED_TO_SERVER: s := 'Successfully connected to the socket address: ';
INTERNET_STATUS_CONNECTING_TO_SERVER: s := 'Connecting to the socket address';
INTERNET_STATUS_CONNECTION_CLOSED: s := 'Successfully closed the connection to the server';
INTERNET_STATUS_CTL_RESPONSE_RECEIVED: s := 'Not implemented';
INTERNET_STATUS_HANDLE_CLOSING: s := 'This handle value has been terminated';
INTERNET_STATUS_HANDLE_CREATED: s := 'InternetConnect has created the new handle';
INTERNET_STATUS_INTERMEDIATE_RESPONSE: s :=
'Received an intermediate (100 level) status code message from the server';
INTERNET_STATUS_NAME_RESOLVED: s := 'Successfully found the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_PREFETCH: s := 'Not implemented';
INTERNET_STATUS_RECEIVING_RESPONSE: s := 'Waiting for the server to respond to a request ';
INTERNET_STATUS_REDIRECT: s := 'HTTP request is about to automatically redirect the request ' +
PAnsiChar(pInformation);
INTERNET_STATUS_REQUEST_COMPLETE: s := 'An asynchronous operation has been completed';
INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' +
IntToStr(NativeUInt(pInformation)) + ' Byte';
INTERNET_STATUS_RESOLVING_NAME: s := 'Looking up the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server: ' +
IntToStr(NativeUInt(pInformation)) + ' Byte';
INTERNET_STATUS_SENDING_REQUEST: s := 'Sending the information request to the server.';
INTERNET_STATUS_STATE_CHANGE:
begin
s := 'Moved between a secure (HTTPS) and a nonsecure (HTTP) site.';
case DWORD(pInformation) of
INTERNET_STATE_CONNECTED: s := s + #13#10 + 'Connected state. Mutually exclusive with disconnected state.';
INTERNET_STATE_DISCONNECTED: s := s + #13#10 +
'Disconnected state. No network connection could be established.';
INTERNET_STATE_DISCONNECTED_BY_USER: s := s + #13#10 + 'Disconnected by user request.';
INTERNET_STATE_IDLE: s := s + #13#10 + 'No network requests are being made by Windows Internet.';
INTERNET_STATE_BUSY: s := s + #13#10 + 'Network requests are being made by Windows Internet.';
end;
end;
end;
tss.Add(s);
end;
function Https_Post(var callSettings: httpCallSettings; xServer,xRes: string): Integer;
const
BufferSize=1024*64;
var
hInet : HINTERNET;
hConnect : HINTERNET;
hRequest : HINTERNET;
dwc: UInt64;
ErrorCode : Integer;
lpdwBufferLength: DWORD;
lpdwReserved : DWORD;
dwBytesRead : DWORD;
lpdwNumberOfBytesAvailable: DWORD;
heads: ansistring;
header: TStringStream;
begin
tss := tstringlist.Create;
Result :=0;
callSettings.Response :='';
hInet := InternetOpen(PChar(callSettings.uAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
if hInet=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetOpen Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
hConnect := InternetConnect(hInet, PChar(xServer), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, dwc);
if hConnect=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetConnect Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
hRequest := HttpOpenRequest(hConnect, 'POST', PChar(xRes), HTTP_VERSION, '', nil, INTERNET_FLAG_SECURE, dwc);
if hRequest=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpOpenRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
Header := TStringStream.Create('');
with Header do
begin
WriteString('Host: ' + xServer + sLineBreak);
WriteString('User-Agent: '+ callSettings.uAgent + SLineBreak);
WriteString('Accept: text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8'+SLineBreak);
WriteString('Accept-Language: en-us,en;q=0.5' + SLineBreak);
WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7'+SLineBreak);
WriteString('Keep-Alive: 300'+ SLineBreak);
if callSettings.ExtraHeader <> '' then WriteString(callSettings.ExtraHeader + SlineBreak);
if callSettings.CType <> '' then WriteString('Content-Type: ' + callSettings.cType + SlineBreak);
WriteString('Connection: keep-alive'+ SlineBreak + SlineBreak);
end;
HttpAddRequestHeaders(hRequest, PChar(Header.DataString), Length(Header.DataString), HTTP_ADDREQ_FLAG_ADD);
InternetSetStatusCallback( hRequest, @StatusCallback );
//send the post request
if not HTTPSendRequest(hRequest, nil, 0, @callSettings.postvars[1], Length(callSettings.postvars)) then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpSendRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
lpdwBufferLength:=SizeOf(Result);
lpdwReserved :=0;
//get the response code
if not HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, lpdwBufferLength, lpdwReserved) then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpQueryInfo Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
CallSettings.CallStatus := Result;
//if the response code =200 then get the body
if Result=200 then
if InternetQueryDataAvailable(hRequest, lpdwNumberOfBytesAvailable, 0, 0) then
begin
SetLength(callSettings.response,lpdwNumberOfBytesAvailable);
InternetReadFile(hRequest, @callSettings.response[1], lpdwNumberOfBytesAvailable, dwBytesRead);
end
else
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetQueryDataAvailable Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
finally
InternetCloseHandle(hRequest);
end;
finally
InternetCloseHandle(hConnect);
end;
finally
InternetCloseHandle(hInet);
end;
showmessage(tss.Text);
end;
使用 InternetSetStatusCallback() 向 HTTP 会话注册回调函数，以在请求操作的各个阶段接收状态信息。
请注意文档中的以下警告：
Note The callback function specified in the lpfnInternetCallback parameter will not be called on asynchronous operations for the request handle when the dwContext parameter of
HttpOpenRequestis set to zero (INTERNET_NO_CALLBACK), or the connection handle when the dwContext handle ofInternetConnectis set to zero (INTERNET_NO_CALLBACK).
试试像这样的东西：
function SockAddrToString(pAddr: LPSOCKADDR; AddrSize: DWORD): String;
var
Buf: array[0..40] of Char;
Len: DWORD;
begin
Result := '';
Len := Length(Buf);
if WSAAddressToString(pAddr, AddrSize, nil, Buf, Len) = 0 then
SetString(Result, Buf, Len-1);
end;
procedure StatusCallback(
hInet: HINTERNET;
Context: DWORD_PTR;
Status: DWORD;
pInformation: Pointer;
InfoLength: DWORD ); stdcall;
var
s: string;
begin
case Status of
INTERNET_STATUS_CLOSING_CONNECTION: s := 'Closing the connection to the server';
INTERNET_STATUS_CONNECTED_TO_SERVER: s := 'Successfully connected to the socket address: ' + SockAddrToString(PSOCKADDR(pInformation), InfoLength);
INTERNET_STATUS_CONNECTING_TO_SERVER: s := 'Connecting to the socket address: ' + SockAddrToString(PSOCKADDR(pInformation), InfoLength);
INTERNET_STATUS_CONNECTION_CLOSED: s := 'Successfully closed the connection to the server';
INTERNET_STATUS_CTL_RESPONSE_RECEIVED: s := 'Not implemented';
INTERNET_STATUS_HANDLE_CLOSING: s := 'This handle value has been terminated';
INTERNET_STATUS_HANDLE_CREATED: s := 'InternetConnect has created the new handle';
INTERNET_STATUS_INTERMEDIATE_RESPONSE: s := 'Received an intermediate (100 level) status code message from the server';
INTERNET_STATUS_NAME_RESOLVED: s := 'Successfully found the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_PREFETCH: s := 'Not implemented';
INTERNET_STATUS_RECEIVING_RESPONSE: s := 'Waiting for the server to respond to a request';
INTERNET_STATUS_REDIRECT: s := 'HTTP request is about to automatically redirect the request ' +
PAnsiChar(pInformation);
INTERNET_STATUS_REQUEST_COMPLETE: s := 'An asynchronous operation has been completed';
INTERNET_STATUS_REQUEST_SENT: s := 'Successfully sent the information request to the server: ' + IntToStr(PDWORD(pInformation)^) + ' Bytes';
INTERNET_STATUS_RESOLVING_NAME: s := 'Looking up the IP address: ' + PAnsiChar(pInformation);
INTERNET_STATUS_RESPONSE_RECEIVED: s := 'Successfully received a response from the server';
INTERNET_STATUS_SENDING_REQUEST: s := 'Sending the information request to the server';
INTERNET_STATUS_STATE_CHANGE:
begin
s := 'Moved between a secure (HTTPS) and a nonsecure (HTTP) site.';
case PDWORD(pInformation)^ of
INTERNET_STATE_CONNECTED: s := s + #13#10 + 'Connected state. Mutually exclusive with disconnected state.';
INTERNET_STATE_DISCONNECTED: s := s + #13#10 + 'Disconnected state. No network connection could be established.';
INTERNET_STATE_DISCONNECTED_BY_USER: s := s + #13#10 + 'Disconnected by user request.';
INTERNET_STATE_IDLE: s := s + #13#10 + 'No network requests are being made by Windows Internet.';
INTERNET_STATE_BUSY: s := s + #13#10 + 'Network requests are being made by Windows Internet.';
end;
end;
end;
tss.Add(s);
end;
procedure WinInetCheck(Success: Boolean; Function: PChar);
var
ErrorCode : Integer;
begin
if not Success then
begin
ErrorCode := GetLastError;
raise Exception.CreateFmt('%s Error %d: %s', [Function, ErrorCode, GetWinInetError(ErrorCode)]);
end;
end;
function Https_Post(var callSettings: httpCallSettings; xServer, xRes: string): Integer;
const
BufferSize = 1024*64;
AcceptTypes: array[0..] of PChar = ('text/html', 'application/xhtml+xml', 'application/xml;q=0.9', '*/*;q=0.8', nil);
var
hInet : HINTERNET;
hConnect : HINTERNET;
hRequest : HINTERNET;
dwBufferLength: DWORD;
dwReserved : DWORD;
dwBytesRead : DWORD;
dwNumberOfBytesAvailable: DWORD;
Header: TStringStream;
sHeader: String;
begin
Result := 0;
tss := TStringList.Create;
try
callSettings.Response := '';
hInet := InternetOpen(PChar(callSettings.uAgent), INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
WinInetCheck(hInet <> nil, 'InternetOpen');
try
hConnect := InternetConnect(hInet, PChar(xServer), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 1);
WinInetCheck(hConnect <> nil, 'InternetConnect');
try
hRequest := HttpOpenRequest(hConnect, 'POST', PChar(xRes), HTTP_VERSION, '', @AcceptTypes, INTERNET_FLAG_SECURE or INTERNET_FLAG_KEEP_CONNECTION, 1);
WinInetCheck(hRequest <> nil, 'HttpOpenRequest');
try
Header := TStringStream.Create('');
try
Header.WriteString('Accept-Language: en-us,en;q=0.5' + #13#10);
Header.WriteString('Accept-Charset: ISO-8859-1,utf-8;q=0.7,*;q=0.7' + #13#10);
Header.WriteString('Keep-Alive: 300' + #13#10);
if callSettings.ExtraHeader <> '' then
Header.WriteString(callSettings.ExtraHeader + #13#10);
if callSettings.CType <> '' then
Header.WriteString('Content-Type: ' + callSettings.cType + #13#10);
sHeader := Header.DataString;
WinInetCheck(HttpAddRequestHeaders(hRequest, PChar(sHeader), Length(sHeader), HTTP_ADDREQ_FLAG_ADD), 'HttpAddRequestHeaders');
finally
Header.Free;
end;
InternetSetStatusCallback(hRequest, @StatusCallback);
//send the post request
WinInetCheck(HTTPSendRequest(hRequest, nil, 0, @callSettings.postvars[1], Length(callSettings.postvars)), 'HttpSendRequest');
//get the response code
dwBufferLength := SizeOf(Result);
dwReserved := 0;
WinInetCheck(HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER, @Result, dwBufferLength, dwReserved), 'HttpQueryInfo');
CallSettings.CallStatus := Result;
//if the response code =200 then get the body
if Result = 200 then
begin
WinInetCheck(InternetQueryDataAvailable(hRequest, dwNumberOfBytesAvailable, 0, 0), 'InternetQueryDataAvailable');
SetLength(callSettings.response, dwNumberOfBytesAvailable);
if dwNumberOfBytesAvailable <> 0 then
WinInetCheck(InternetReadFile(hRequest, @callSettings.response[1], dwNumberOfBytesAvailable, dwBytesRead), 'InternetReadFile');
end;
finally
InternetCloseHandle(hRequest);
end;
finally
InternetCloseHandle(hConnect);
end;
finally
InternetCloseHandle(hInet);
end;
ShowMessage(tss.Text);
finally
tss.Free;
end;
end;