我的GetHttp适用于HTTP,但HTTPS返回无效数据

时间:2009-11-24 11:56:20

标签: delphi

我的GetHttp适用于HTTP,但HTTPS返回无效数据,这是测试程序:

GetHTTP( 'https://localhost/', '',温度,TRUE);   temp.SaveToFile( 'C:\ TEMP.TXT');

如何修复,任何想法?

function GetHTTP(AUrl, APostStr:ansistring; AStream:TStream; noncached :boolean =false): integer;
var
  Retry: Boolean;
  hSession, hConnect, hRequest: hInternet;
  RequestMethod, Header: ansistring;
  Buf:array[0..1023] of Char;
  ReadCount:Cardinal;
  dwError, dwErrorCode: DWORD;
  ptNil: Pointer;

  UrlInfo: TUrlInfo;
  flags : DWORD ;

  procedure SetTimeOut;
  var
    TimeOut: integer;
  begin
    TimeOut := 5 * 1000;
    InternetSetOption(hSession, INTERNET_OPTION_RECEIVE_TIMEOUT, @TimeOut,
      SizeOf(TimeOut));
  end;

  procedure GetHttpStatus; //StatusCode   
  var
    Len, Reserved: DWORD;
  begin
    Reserved := 0;
    Len := SizeOf(Result);
    HttpQueryInfo(hRequest, HTTP_QUERY_STATUS_CODE or HTTP_QUERY_FLAG_NUMBER,
      @Result, Len, Reserved) ;
  end;

 begin



   flags := 0;
  if noncached = true then flags := INTERNET_FLAG_RELOAD;

//  flags := INTERNET_FLAG_SECURE;    THIS   DID NOT HELP ??!!! output was blank with it

  Result := 0;
  if not GetUrlInfo(AUrl, UrlInfo) then Exit;
  hSession := InternetOpen(nil, INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  try
    SetTimeOut;
    hConnect := InternetConnect(hSession, pchar(UrlInfo.hostname),urlinfo.port,nil,nil,INTERNET_SERVICE_HTTP,INTERNET_FLAG_EXISTING_CONNECT ,0);

    try
      if APostStr = '' then
        RequestMethod := 'GET'
      else
        RequestMethod := 'POST';

      hRequest := HttpOpenRequest(hConnect, PChar(RequestMethod),Pchar(urlinfo.urlpath), 'HTTP/1.0', nil, nil,flags, 0);

      try
        if APostStr = '' then
          Header := ''
        else
          Header := 'Content-type: application/x-www-form-urlencoded';


 Retry:=True;
        while Retry do
        begin
          if HttpSendRequest(hRequest, PChar(Header),Length(Header), PChar(APostStr), Length(APostStr)) then
            dwErrorCode:=ERROR_SUCCESS
          else
            dwErrorCode:=GetLastError;
          dwError:=InternetErrorDlg(application.Handle, hRequest, dwErrorCode,
            FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
            FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
            FLAGS_ERROR_UI_FLAGS_GENERATE_DATA,
            ptNil);
          Retry:=(dwError=ERROR_INTERNET_FORCE_RETRY);
        end;

        //HttpSendRequest(hRequest, PChar(Header),Length(Header), PChar(APostStr), Length(APostStr));



        GetHttpStatus;
        if Result <> HTTP_STATUS_OK then Exit;
        while True do
        begin
          if not InternetReadFile(hRequest, @Buf, SizeOf(Buf), ReadCount) then
            Break;
            //res := GetLastError();
          if ReadCount = 0 then
            Break
          else
            AStream.Write(Buf, ReadCount);
        end;
      finally
        InternetCloseHandle(hRequest);
      end;
    finally
      InternetCloseHandle(hConnect);
    end;
  finally
    InternetCloseHandle(hSession);
  end;
end;

3 个答案:

答案 0 :(得分:2)

我只在Indy中做过这个,它使用OpenSSL并需要一些额外的DLL。您还需要为SSL显式创建IO处理程序。这是一个简化的代码示例。

MyHTTP := GetIdHTTP(True);
MyHTTP.Get(SomeSecureURL, MyStream);

...

function GetIdHTTP(aSecure: Boolean = False): TIdHTTP;
var
  lSSLIOHandler: TIdSSLIOHandlerSocketOpenSSL;
begin
  Result := TIdHTTP.Create(nil);

  if aSecure then
  begin
    lSSLIOHandler := TIdSSLIOHandlerSocketOpenSSL.Create;
    Result.IOHandler := lSSLIOHandler;
  end;
end;

答案 1 :(得分:2)

除了Indy之外,您还可以使用Delphi的THTTPReqResp组件(或者查看它如何处理HTTPS;它使用WinInet)。这是使用GET组件编写的GetHTTP:

function GetHTTP(AUrl, APostStr: String; AStream:TStream; noncached :boolean =false): Boolean;
var
  ReqResp: THTTPReqResp;
begin
  Result := False;
  ReqResp := THTTPReqResp.Create(nil);
  try
    { Get Case }
    if AUrl <> '' then
    begin
      ReqResp.URL := AUrl;
      ReqResp.Get(AStream);
      Result := True;
    end;
  finally
    ReqResp.Free;
  end;
end;

答案 2 :(得分:0)

https在不同的端口上运行,您需要告诉winsock执行安全连接。

检查https请求的urlinfo.port是否设置为443 你为https请求设置INTERNET_FLAG_SECURE标志。