DHL-Webservice nutzen

[EmWieMichael]

So, hier nun der angekündigte HTTP-Request-Code:

Delphi-Quellcode:

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;

Bei mir läuft der Code unter Delphi 2010. Wenn Du keine lokalen Zertifikate benötigst, kannst Du die Routine entsprechend anpassen (raus damit). Das Gleiche gilt für die Angabe des Proxys. Auf den Seiten von Microsoft kann man die möglichen Parameter der Funktionen nachlesen.

Viel Erfolg!

Gruß Michael