Wininet请求包装类简稿

unit uWnWinetClass;

interface

uses
  Windows,Messages,SysUtils,Classes,WinInet;

const
  CONST_AGENT = 'Wininet by Enli';
  BUFFER_SIZE = 4096;

type
  //定义http的请求调用方式
  //TWinWrapVerbs = (wwvGET, wwvPOST, wwvMPOST);
  //定义协议版本
  TWinHttpVersion = (wwvHttp1,wwvHttp11);
  //错误类型，没有错误为wwecNil
  TWinInetErrorCauses = (wwecNil,                             //0
                         wwecAttemptConnect,                  //1
                         wwecOpen,                            //2
                         wwecConnect,                         //3
                         wwecOpenRequest,                     //4
                         wwecConfigureRequest,                //5
                         wwecExecRequest,                     //6
                         wwecEndRequest,                      //7
                         wwecTimeOut,                         //8
                         wwecUPD,                             //9
                         wwecAbort,                           //10
                         wwecStatus,                          //11
                         wwecHeader,                          //12
                         wwecContentLength,                   //13
                         wwecContentType,                     //14
                         wwecReadFile,                        //15
                         wwecWriteFile);                      //16

  TProxyInfo = record
    FProxyType : Integer; //-1: preConfig 0: noproxy 1: sock4 2: sock5 3: http
    FProxyServer : string;
    FProxyPort : Integer;
    FProxyUserName : string;
    FProxyUserPass : string;
  end;
  TWnWinetClass = class
  private
    FNet: HINTERNET;
    FRequest: HINTERNET;
    FSession: HINTERNET;
    FRequestStream: TMemoryStream;
    FResponseStream: TMemoryStream;
    FVerb: string;
    FAbort: Boolean;
    FWininetStateChanged: Boolean;
    FTimeOut: Integer;
    FSecure: Boolean;
    FProxyInfo: TProxyInfo;
    FServerPort: Integer;
    FEncodeUrl: string;
    FErrInfo: string;
    FServerPass: string;
    FServerUser: string;
    FServerName: string;
    FProxy : string;
    FHttpHeader: string;
    FData: array [0 .. BUFFER_SIZE] of Char;
    FErrorCause: TWinInetErrorCauses;
    FHttpVersion: TWinHttpVersion;
    FStatus: integer;
    FContentType: string;
    FContentLength: Int64;
    FTotal: Int64;
    FResponseHeader: string;
    procedure SetAbort(const Value: Boolean);
    procedure FixServerInfo;
    procedure FixProxyServerInfo;
    function OpenConnection: Boolean;
    function OpenRequest: Boolean;
    function ConfigureRequest: Boolean;
    function PerformMethod: Boolean;
    function DetectProxyServer: DWORD;
    function PortToUse(APort: Integer): Integer;
    function FetchHeader(AFlags: integer): Boolean;
    function ReadResponse: Boolean; // 读取接受数据
    function ReadResponseHeader: Boolean;  //获取返回数据包头
    function FixContentLength: Boolean; // 获取接受数据的大小
    function FixContentType: Boolean; // 获取接受数据的类型
    function FixWinINetError(AError: integer): string;
    function GetHttpVersion: string;
    procedure AssignError(AError: TWinInetErrorCauses);
  public
    constructor Create;
    destructor Destroy; override;
    property Abort: Boolean read FAbort write SetAbort;
    property Response: TMemoryStream read FResponseStream;
    property HttpVersion: TWinHttpVersion read FHttpVersion write FHttpVersion;
    property ServerName: string read FServerName write FServerName;
    property ServerPort: Integer read FServerPort write FServerPort;
    property ServerUser: string read FServerUser write FServerUser;
    property ServerPass: string read FServerPass write FServerPass;
    property ProxyInfo: TProxyInfo read FProxyInfo write FProxyInfo;
    property HttpHeader: string read FHttpHeader write FHttpHeader;
    property ResponseHeader: string read FResponseHeader write FResponseHeader;
    property Status: Integer read FStatus;
    property ContentLength: Int64 read FContentLength;
    property Total: Int64 read FTotal;
    property ErrInfo: string read FErrInfo;
    property ErrorCause: TWinInetErrorCauses read FErrorCause;
    procedure CleanUp(isAll: Boolean);
    function HttpGet(isUrl:string;iiTimeout:Integer;ASecure:Boolean = False):boolean;
    function HttpPost(isUrl:string;AStream:TMemoryStream;iiTimeout:Integer;ASecure:Boolean = False):boolean;
    class function StreamToHex(AStream: TMemoryStream): string;
    class procedure HexToStream(AStream: TMemoryStream;AHex: string);
  end;

implementation

{ TWnWinetClass }

procedure TWnWinetClass.AssignError(AError: TWinInetErrorCauses);
var
  I, H: Integer;
  LTemp: string;
  LR: Cardinal;
begin
  FErrorCause := AError;
  if Length(FErrInfo) = 0 then
  begin
    LR := GetLastError;
    if (LR < 12000) or (LR < 12175) then
    begin
      H := GetModuleHandle('wininet.dll');
      SetLength(LTemp, 256);
      I := FormatMessage(FORMAT_MESSAGE_FROM_HMODULE, Pointer(H), LR, 0,
        PChar(LTemp), 256, nil);
      SetLength(LTemp, I);
      FErrInfo := 'Error '+IntTostr(LR)+':'+LTemp;
    end
    else
      FErrInfo := 'Error '+IntTostr(LR)+':'+SysErrorMessage(GetLastError);
  end;
end;

procedure TWnWinetClass.CleanUp(isAll: Boolean);
begin
  if isAll then
  begin
    if Assigned(FRequest) then
    begin
      InternetCloseHandle(FRequest);
      FRequest := nil;
    end;
    if Assigned(FSession) then
    begin
      InternetCloseHandle(FSession);
      FSession := nil;
    end;
    if Assigned(FNet) then
    begin
      InternetCloseHandle(FNet);
      FNet := nil;
    end;
  end;
  //FResponse.Clear;
  SetLength(FProxy,0);
end;


function TWnWinetClass.ConfigureRequest: Boolean;
  function SetUPD(AOption: DWORD; AUPD: PChar): Boolean;
  begin
    Result := (Length(AUPD) = 0) or InternetSetOption
      (FRequest, AOption, AUPD, Length(AUPD));
  end;

begin
  Result := False;
  if FAbort then
    Exit;
  // 设置HTTP头
  {if FFileSize > 0 then
  begin
    if Length(FHttpHeader) > 0 then
      FHttpHeader := FHttpHeader + #13#10'Range: bytes=' + IntTostr(FFileSize)
        + '-'#13#10
    else
      FHttpHeader := 'Range: bytes=' + IntTostr(FFileSize) + '-'#13#10;
  end;}
  if Length(FHttpHeader) > 0 then
  begin
    Result := HttpAddRequestHeaders(FRequest, PWideChar(FHttpHeader), Cardinal
        (-1), HTTP_ADDREQ_FLAG_ADD or HTTP_ADDREQ_FLAG_REPLACE);

    if not Result then
    begin
      AssignError(wwecConfigureRequest);
      Exit;
    end;
  end;
  // 设置超时
  if (FTimeOut < 1) or (FTimeOut > 999) then
    FTimeOut := 30;
  FTimeOut := FTimeOut * 1000;
  Result := InternetSetOption(FNet, INTERNET_OPTION_CONNECT_TIMEOUT, @FTimeOut,
    SizeOf(integer)) and InternetSetOption
    (FNet, INTERNET_OPTION_RECEIVE_TIMEOUT, @FTimeOut, SizeOf(integer))
    and InternetSetOption(FNet, INTERNET_OPTION_SEND_TIMEOUT, @FTimeOut, SizeOf
      (integer));

  if not(Result) then
  begin
    AssignError(wwecTimeOut);
    Exit;
  end;
  // 设置代理用户密码，访问用户密码
  if SetUPD(INTERNET_OPTION_PROXY_USERNAME, PChar(FProxyInfo.FProxyUserName))
    and SetUPD(INTERNET_OPTION_PROXY_PASSWORD, PChar(FProxyInfo.FProxyUserPass)
    ) and SetUPD(INTERNET_OPTION_USERNAME, PChar(FServerPass)) and SetUPD
    (INTERNET_OPTION_PASSWORD, PChar(FServerUser)) then
  else
    AssignError(wwecUPD);

end;

constructor TWnWinetClass.Create;
begin
  inherited;
  FResponseStream := TMemoryStream.Create;
  FRequest := nil;
  FSession := nil;
  FRequestStream := nil;
  FNet := nil;
  FAbort := False;
  FSecure := False;
  FWininetStateChanged := False;
  SetLength(FEncodeUrl,0);
  SetLength(FErrInfo,0);
  SetLength(FServerUser,0);
  SetLength(FServerPass,0);
  SetLength(FProxy,0);
  FVerb := 'GET';

end;

destructor TWnWinetClass.Destroy;
begin
  FResponseStream.Free;
  inherited;
end;

function TWnWinetClass.DetectProxyServer: DWORD;
begin
   //-1: preConfig 0: noproxy 1: sock4 2: sock5 3: http
  //Result:
  //INTERNET_OPEN_TYPE_PRECONFIG                   0
  //INTERNET_OPEN_TYPE_DIRECT                      1
  //INTERNET_OPEN_TYPE_PROXY                       3
  //INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY 4
  with FProxyInfo do
  case (FProxyType-1) of
    0: Result := INTERNET_OPEN_TYPE_DIRECT;
    1:
    begin
      Result := INTERNET_OPEN_TYPE_PROXY;
      FProxy := Format('socks=%s:%s',[FProxyServer,Inttostr(FProxyPort)]);
    end;
    2:
    begin
      Result := INTERNET_OPEN_TYPE_PROXY;
      FProxy := Format('socks5=%s:%s',[FProxyServer,Inttostr(FProxyPort)]);
    end;
    3:
    begin
      Result := INTERNET_OPEN_TYPE_PROXY;
      FProxy := Format('%s:%s',[FProxyServer,Inttostr(FProxyPort)]);
    end;
  else
      Result := INTERNET_OPEN_TYPE_PRECONFIG;
  end;
end;

function TWnWinetClass.FetchHeader(AFlags: integer): Boolean;
var
  BufLen, Index: DWORD;
begin
  Result := False;
  if FAbort then Exit;
  Index := 0;
  BufLen := BUFFER_SIZE;
  FillChar(FData, BufLen, 0);
  Result := HttpQueryInfo(FRequest, AFlags, @FData, BufLen, Index);
end;

function TWnWinetClass.FixContentLength: Boolean;
var
  LTemp: string;
begin
  Result := False;
  if FAbort then Exit;
  Result := FetchHeader(HTTP_QUERY_CONTENT_LENGTH);
  LTemp := FData;
  if Result then
    FContentLength := StrToInt64Def(LTemp, 0)
  else
    AssignError(wwecContentLength);
end;

function TWnWinetClass.FixContentType: Boolean;
begin
  Result := False;
  if FAbort then Exit;
  Result := FetchHeader(HTTP_QUERY_CONTENT_TYPE);
  if Result then
    FContentType := FData
  else
    AssignError(wwecContentType);
end;

procedure TWnWinetClass.FixProxyServerInfo;
var
  ls1ServerName, lsPort: string;
  liLoc: Integer;
begin
  ls1ServerName := LowerCase(FServerName);
  liLoc := Pos(':', ls1ServerName);
  if liLoc = 0 then Exit;
  lsPort := Copy(ls1ServerName, liLoc + 1, Length(ls1ServerName) - liLoc);
  FServerName := PChar(Copy(ls1ServerName, 1, liLoc - 1));
  FServerPort := StrToIntDef(lsPort,FServerPort);
end;

procedure TWnWinetClass.FixServerInfo;
var
  ls1ServerName, lsPort: string;
  liLoc: Integer;
begin
  if FProxyInfo.FProxyType = 0 then Exit;
  ls1ServerName := LowerCase(FProxyInfo.FProxyServer);
  liLoc := Pos(':', ls1ServerName);
  if liLoc = 0 then Exit;
  lsPort := Copy(ls1ServerName, liLoc + 1, Length(ls1ServerName) - liLoc);
  FProxyInfo.FProxyServer := PChar(Copy(ls1ServerName, 1, liLoc - 1));
  FProxyInfo.FProxyPort := StrToIntDef(lsPort,FProxyInfo.FProxyPort);
end;

function TWnWinetClass.FixWinINetError(AError: integer): string;
begin
  //Result := 'Http Status: ' + IntTostr(AError);
  if FetchHeader(HTTP_QUERY_STATUS_TEXT) then
    Result := FData
  //if not Result then
  else
  begin
    AssignError(wwecStatus);
    Exit;
  end;
end;

function TWnWinetClass.GetHttpVersion: string;
begin
  if FHttpVersion = wwvHttp1 then
    Result := 'HTTP/1.0'
  else
    Result := 'HTTP/1.1';
end;

class procedure TWnWinetClass.HexToStream(AStream: TMemoryStream;AHex: string);
var
  I,iLen: Integer;
  LTemp: string;
  LB : Byte;
begin
  iLen := Length(AHex);
  if (iLen mod 3) <> 0 then
  begin
    Assert(False,'hex字符串错误');
    Exit;
  end;
  for I := 0 to (iLen div 3) - 1 do
  begin
    LTemp := Copy(AHex,I*3+1,2);
    LB := StrToIntDef('$'+LTemp,0);
    AStream.WriteBuffer(Lb,1);
    //Assert(Pos(IntToStr(LB),LTemp)=0,'asdf');
  end;


end;

function TWnWinetClass.HttpGet(isUrl: string; iiTimeout: integer;
  ASecure: Boolean): boolean;
begin
  FVerb := 'GET';
  FRequest := nil;
  FRequestStream := nil;
  SetLastError(0);
  FErrInfo := '';
  FErrorCause := wwecNil;
  Result := False;
  FEncodeUrl := isUrl;
  FTimeOut := iiTimeout;
  FSecure := ASecure;
  FixServerInfo;
  FixProxyServerInfo;
  Result := OpenConnection
  and OpenRequest
  and ConfigureRequest
  and PerformMethod;
  CleanUp(True);
end;

function TWnWinetClass.HttpPost(isUrl: string; AStream: TMemoryStream;
  iiTimeout: Integer; ASecure: Boolean): boolean;
begin
  FVerb := 'POST';
  FRequestStream := AStream;
  SetLastError(0);
  FErrInfo := '';
  FErrorCause := wwecNil;
  Result := False;
  FEncodeUrl := isUrl;
  FTimeOut := iiTimeout;
  FSecure := ASecure;
  FixServerInfo;
  FixProxyServerInfo;
  Result := OpenConnection
  and OpenRequest
  and ConfigureRequest
  and PerformMethod;
  CleanUp(True);
end;

function TWnWinetClass.OpenConnection: Boolean;
var
  LProxyType: DWORD;

  function WW_AttemptConnect: Boolean;
  begin
    Result := (CompareText(FServerName, 'localhost') = 0) or
      (InternetAttemptConnect(0) = ERROR_SUCCESS);
    if not (Result) then AssignError(wwecAttemptConnect);
  end;

  procedure CancelMaxConnectLimite();
  var
    liPerServer1, liPerServer2: Integer;
  begin
    try
      liPerServer1 := 5;
      liPerServer2 := 10;
      //INTERNET_OPTION_MAX_CONNS_PER_SERVER  73
      InternetSetOption(nil, 73, @liPerServer1, SizeOf(Integer));
      //INTERNET_OPTION_MAX_CONNS_PER_1_0_SERVER  74
      InternetSetOption(nil, 74, @liPerServer2, SizeOf(Integer));
    except
    end;
  end;

  function WW_InternetOpen: Boolean;
  var
    ltInfo: INTERNET_CONNECTED_INFO;
  begin
    FNet := InternetOpen(PChar(CONST_AGENT), LProxyType, PChar(FProxy), nil, 0);

    Result := (FNet <> nil);
    if Result then begin
      try
        if not FWininetStateChanged then begin
          //INTERNET_OPTION_CONNECTED_STATE  50
          //取消IE的脱机状态
          ltInfo.dwConnectedState := INTERNET_STATE_CONNECTED;
          ltInfo.dwFlags := 0;          // ISO_FORCE_DISCONNECTED;
          InterNetSetOption(FNet, INTERNET_OPTION_CONNECTED_STATE, @ltInfo, SizeOf(ltInfo));
        end;
      except
      end;
      //InternetSetStatusCallBack(FNet, @StatusCallBack);

      //INTERNET_OPTION_HTTP_DECODING
      if InternetSetOption(FNet, 65, @Result, 1) then begin
        Beep;
      end;
    end else begin
      AssignError(wwecOpen);
    end;
  end;

  function WW_InternetConnect: Boolean;
  var
    context: dword;
  begin
    //同步通讯设置
    context := 0;
    //异步通讯需要设置特定值
    //FCallBackContext.CallbackID := 0;
    //context:=dword(@FCallBackContext);
    FSession := InternetConnect(FNet, PChar(FServerName),
        PortToUse(FServerPort), '', '', INTERNET_SERVICE_HTTP, 0, context);
    Result := (FSession <> nil);
    if not (Result) then AssignError(wwecConnect);
  end;

begin
  Result := False;
  if FAbort then Exit;
  if WW_AttemptConnect then
  begin
    LProxyType := DetectProxyServer;
    SetLastError(0);
    if not FWininetStateChanged then CancelMaxConnectLimite();
    Result := WW_InternetOpen and WW_InternetConnect;
    FWininetStateChanged := True;
  end;
end;

function TWnWinetClass.OpenRequest: Boolean;
var
  context, ATimeOut, dwFlags: DWORD;
begin
  Result := False;
  if FAbort then
    Exit;
  context := 0;
  if FSecure then
  begin
    FRequest := HTTPOpenRequest(FSession, PChar(FVerb), PChar(FEncodeUrl), PChar
        (GetHttpVersion), nil, nil,
      INTERNET_FLAG_KEEP_CONNECTION or INTERNET_FLAG_SECURE or
        SECURITY_FLAG_IGNORE_UNKNOWN_CA or SECURITY_FLAG_IGNORE_CERT_CN_INVALID
        or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID, context);
    ATimeOut := 0;
    dwFlags := 0;

    if (FRequest <> nil) and (not InternetQueryOption(FRequest,
        INTERNET_OPTION_SECURITY_FLAGS, Pointer(@ATimeOut), dwFlags)) then
    begin
      GetLastError;
    end;
  end
  else
  begin
    FRequest := HTTPOpenRequest(FSession, PChar(FVerb), PChar(FEncodeUrl), PChar
        (getHttpVersion), nil, nil, { Ord(FSecure) * INTERNET_FLAG_SECURE or }
      INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_RELOAD or
        INTERNET_FLAG_KEEP_CONNECTION, context);
  end;
  Result := (FRequest <> nil);
  if not(Result) then
    AssignError(wwecOpenRequest);
end;

function TWnWinetClass.PerformMethod: Boolean;
var
  ATimeOut, dwFlags: DWORD;
  // LErr: Cardinal;
begin
  Result := False;
  if FAbort then Exit;
  if Assigned(FRequestStream) and (FRequestStream.Size > 0) then
    Result := HTTPSendRequest(FRequest, nil, 0, FRequestStream.Memory, FRequestStream.Size)
  else
    Result := HTTPSendRequest(FRequest, nil, 0, nil, 0);
  // Result := HTTPSendRequest(FRequest, D_C_T, D_C_T_S, nil, 0);
  if not(Result) then
  begin
    if GetLastError = ERROR_INTERNET_INVALID_CA then // WinInet 无效证书颁发机构错误
    begin
      ATimeOut := 0;
      dwFlags := 0;
      InternetQueryOption(FRequest, INTERNET_OPTION_SECURITY_FLAGS, Pointer
          (@ATimeOut), dwFlags);
      dwFlags := dwFlags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
      InternetSetOption(FRequest, INTERNET_OPTION_SECURITY_FLAGS, @dwFlags,
        SizeOf(integer));
      Result := HTTPSendRequest(FRequest, nil, 0, nil, 0);
    end
    else
    begin
      AssignError(wwecExecRequest);
      Exit;
    end;
  end;

  Result := ReadResponseHeader
    and FixContentLength and FixContentType and ReadResponse;

end;

function TWnWinetClass.PortToUse(APort: Integer): Integer;
begin
  if APort > 0 then
    Result := APort
  else
    if FSecure then
      Result := INTERNET_DEFAULT_HTTPS_PORT
    else
      Result := INTERNET_DEFAULT_HTTP_PORT;
end;

function TWnWinetClass.ReadResponse: Boolean;
var
  ASize, ARead: DWORD;
  ABuffer: Pointer;
begin
  Result := False;
  if FAbort then Exit;
  FResponseStream.Clear;
  ASize := BUFFER_SIZE;
  FTotal := 0;
  ABuffer := AllocMem(ASize);
  try
    // HookDataReadSized;
    repeat
      Result := InternetReadFile(FRequest, ABuffer, ASize, ARead);
      if not Result then
      begin
        AssignError(wwecReadFile);
        Break;
      end;
      if (ARead > 0) then
      begin
        FResponseStream.WriteBuffer(ABuffer^, ARead);
        Inc(FTotal, ARead);
        //FTotal := ARead;
        //HookDataReadSized;
      end;
    until ((ARead = 0) or FAbort);
    FResponseStream.Seek(0,0);
  finally
    FreeMem(ABuffer, 0);
  end;
end;

function TWnWinetClass.ReadResponseHeader: Boolean;
begin
  Result := False;
  if FAbort then Exit;
  Result := FetchHeader(HTTP_QUERY_STATUS_CODE);
  if not Result then
  begin
    AssignError(wwecStatus);
    Exit;
  end;
  FStatus := StrToIntDef(FData, -1);
  if FAbort then Exit;
  Result := FetchHeader(HTTP_QUERY_RAW_HEADERS_CRLF);
  if Result then
    FResponseHeader := FData
  else
    AssignError(wwecHeader);
end;

procedure TWnWinetClass.SetAbort(const Value: Boolean);
begin
  FAbort := Value;
end;

class function TWnWinetClass.StreamToHex(AStream: TMemoryStream): string;
var
  I: Integer;
  Lb: Byte;
begin
  Result := '';
  AStream.Seek(0,0);
  for I := 1 to AStream.Size do
  begin
    AStream.ReadBuffer(LB,1);
    Result := Result + IntToHex(Ord(Lb),2)+ ' ';
    //if (I mod ALen) = 0 then
    //  Result := Result + #13#10;
  end;

end;

end.