unit SendHTTPRequest;
interface
uses
Windows, SysUtils,
M_WinHttp,
// siehe: http://www.tek-tips.com/faqs.cfm?fid=7493
JwaWinCrypt;
// siehe: http://jedi-apilib.sourceforge.net
implementation
function SendRequest(Host :
String;
Service :
String;
Proxy :
String;
SoapAction : WideString;
RequestData : UTF8String;
CertName :
String;
FName :
String;
var ErrCode : Integer;
var ErrText :
String):Boolean;
var
hConnect, hRequest, hSession : HInternet;
UserAgent : WideString;
dwContext, BytesRead, BytesWritten, HeaderLen, OptionLen : Cardinal;
szBuffer :
array[1..32768]
of byte;
DownloadSize : Int64;
FHandle, I : Integer;
FSizeRead : DWord;
hStore : HCERTSTORE;
pCert : PCertContext;
S :
String;
procedure CleanUp;
begin
if hSession <>
nil then WinHttpCloseHandle(hSession);
if hConnect <>
nil then WinHttpCloseHandle(hConnect);
if hRequest <>
nil then WinHttpCloseHandle(hRequest);
CloseHandle(FHandle);
end;
begin
Result:=False; ErrCode:=0; ErrText:='
';
hConnect :=
nil;
hRequest :=
nil;
UserAgent:='
Mozilla/5.0 (MSIE 9.0; Windows NT 6.1; Trident/5.0)';
FHandle:=FileCreate(FName);
if (FHandle < 0)
then
begin
ErrCode:=GetLastError;
ErrText:='
Can not create file';
Exit;
end;
hSession := WinHttpOpen(PWideChar(UserAgent),
WINHTTP_ACCESS_TYPE_NAMED_PROXY,
PWideChar(WideString(Proxy)),
WINHTTP_NO_PROXY_BYPASS,
0);
if (hSession =
NIL)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
Exit;
end;
hConnect:=WinHttpConnect(hSession,
PWideChar(WideString(Host)),
INTERNET_DEFAULT_HTTPS_PORT,
0);
if (hConnect =
NIL)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
hRequest:=WinHttpOpenRequest(hConnect,
PWideChar(WideString('
POST')),
PWideChar(WideString(Service)),
nil,
WINHTTP_NO_REFERER,
WINHTTP_DEFAULT_ACCEPT_TYPES,
WINHTTP_FLAG_SECURE
or WINHTTP_FLAG_ESCAPE_DISABLE
{0});
if (hRequest =
NIL)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
// Zertifikatspeicher (MY) öffnen...
hStore:=CertOpenStore(CERT_STORE_PROV_SYSTEM,
0,
0,
CERT_SYSTEM_STORE_CURRENT_USER,
WideChar(WideString('
MY')));
if (hStore =
NIL)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
// Zertifikat lesen...
pCert:=CertFindCertificateInStore(hStore,
X509_ASN_ENCODING,
0,
CERT_FIND_SUBJECT_STR,
PWideChar(WideString(CertName)),
NIL);
if (pCert =
NIL)
then
begin
ErrCode:=99;
ErrText:='
Error CertFindCertificateInStore';
CleanUp; Exit;
end;
// und dem Request als Option hinzufügen...
if not WinHttpSetOption(hRequest,
WINHTTP_OPTION_CLIENT_CERT_CONTEXT,
pCert,
SizeOf(CERT_CONTEXT))
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
// Zertifikatspeicher schließen...
CertFreeCertificateContext(pCert);
CertCloseStore(hStore, 0);
// Requestdaten vorbereiten...
dwContext:=0;
FillChar(szBuffer, SizeOf(szBuffer), 0);
I:=1; OptionLen:=Length(RequestData);
repeat
szBuffer[I]:=Ord(RequestData[I]);
Inc(I);
until (I > OptionLen);
S:='
';
for I:=1
to Length(RequestData)
do S:=S+Char(szBuffer[I]);
HeaderLen:=Length(SoapAction) * 2;
OptionLen:=Length(RequestData);
// und abschicken...
if not WinHttpSendRequest(hRequest,
WINHTTP_NO_ADDITIONAL_HEADERS,
0,
@szBuffer,
OptionLen,
OptionLen,
dwContext)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
// Antwort holen...
if not WinHttpReceiveResponse(hRequest,
nil)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
// und lesen...
FillChar(szBuffer, SizeOf(szBuffer), 0);
if not WinHttpReadData(hRequest, @szbuffer, sizeof(szbuffer), BytesRead)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
// und in Ausgabedatei schreiben...
while (BytesRead > 0)
do
begin
WriteFile(FHandle, szBuffer, BytesRead, BytesWritten,
nil);
FillChar(szBuffer, SizeOf(szBuffer), 0);
if not WinHttpReadData(hRequest, @szbuffer, sizeof(szbuffer), BytesRead)
then
begin
ErrCode:=GetLastError;
ErrText:=WinHttpSysErrorMessage(ErrCode);
CleanUp; Exit;
end;
end;
CleanUp;
Result:=True;
end;
{ SendRequest }
if SendRequest('
dhl.serviceportal.net',
// Host,
'
service/soap/dhl/',
// Service
'
12.174.13.120:8080',
// Proxy,
'
CreateShipmentResponse',
// SoapAction,
'
...',
// RequestData
'
...',
// Fingerprint des Zertifikats
'
c:\soap\response.xml',
// Antwortdatei
ErrCode,
// Fehlercode
ErrText)
// Fehlertext
then
begin
...
end;