icqsock.pas

本程序是转载的

procedure TCustomSocket.ProcessBuffer;
var
  ret: Integer;
  Buf: array[0..CNetPktLen - 1] of Byte;
begin
  if FSocket <> INVALID_SOCKET then
    while True do
    begin
      FBuffer.Enter;
      ret := FBuffer.GetPacket(@Buf);
      FBuffer.Leave;
      if (ret < 1) then begin {All data has been sent}
        if (not FDataSentEvent) then
          Synchronize(OnDataSent);
        FDataSentEvent := True;
        Exit;
      end;
      if send(FSocket, Buf, ret, 0) = SOCKET_ERROR then begin
        FLastError := WSAGetLastError;
        FLastErrMsg := ICQLanguages[FErrLang].Translate(IMSG_ESOCK_SEND);
        Synchronize(OnError);
        Break;
      end else
      FBuffer.Enter;
      if FBuffer.SkipData(ret) then
        FBuffer.DelPacket;
      FBuffer.Leave;
    end;
end;

{Tries to resolve host and stores result in FIp, returns False on error}
function TCustomSocket.Resolve(const Host: String): Integer;
var
  he: PHostEnt;
begin
  Result := inet_addr(PChar(Host));
  if DWord(Result) = DWord(INADDR_NONE) then
  begin
    he := gethostbyname(PChar(Host));
    if he = nil then Exit;
    Result := PInteger(he^.h_addr_list^)^;
  end;
end;

{** Main Thread **}
procedure TCustomSocket.Execute;
var
  sin: sockaddr_in;
  buf: array[0..CNetPktLen - 1] of Char;
  rc: Integer;
begin
  if (FDoConnect) and (not Terminated) then begin
    {Resolving Host}
    FIp := Resolve(FHost);
    {$IFDEF DEBUGDC}
      SendDebugFmtEx('Resolved FHost=%s to FIp=%d', [FHost, FIP], mtInformation);
    {$ENDIF}
    if DWord(FIp) = DWord(INADDR_NONE) then begin
      if (not Terminated) then begin
        FLastError := WSAGetLastError;
        FLastErrMsg := ICQLanguages[FErrLang].Translate(IMSG_ESOCK_RESOLVE);
        Synchronize(OnError);
      end;
      Exit;
    end else begin
      sin.sin_family := PF_INET; sin.sin_addr.S_addr := FIp; sin.sin_port := htons(FPort);
      {Connecting...}
      if WinSock.connect(FSocket, sin, SizeOf(sin)) = SOCKET_ERROR then begin
        FLastError := WSAGetLastError;
        FLastErrMsg := ICQLanguages[FErrLang].Translate(IMSG_ESOCK_CONNECT);
        if (not Terminated) then Synchronize(OnConnectError);
        Exit;
      end;
    end;
  end;
  {Connected successfully!}
  FConnected := True;
  {$IFDEF DEBUGDC}
    SendDebugEx('Connected', mtInformation);
  {$ENDIF}
  Synchronize(OnConnect);
  {Receiving data if any avaible}
  while not Terminated do begin
  {
     If no data arrived in 100ms we send qued data to the connected socket.
     That slows sometimes connection, but doesn't require another thread
     for sending.
  }
    if Assync and (not WaitForRead(FSocket, 10)) then begin
      ProcessBuffer;
    end else begin
    {$IFDEF DEBUGDC}
      SendDebugEx('Using OnRecv.', mtInformation);
    {$ENDIF}

      rc := recv(FSocket, buf, SizeOf(buf), 0);
      if (rc = 0) and (not Terminated) then begin Synchronize(OnDisconnect); Break; end;
      if (rc = SOCKET_ERROR) then begin
        rc := WSAGetLastError;
        if ((rc = WSAECONNRESET) or (rc = WSAECONNABORTED)) and (not Terminated) then begin Synchronize(OnDisconnect); Break; end;
        if (not Terminated) then begin
          FLastError := rc;
          FLastErrMsg := ICQLanguages[FErrLang].Translate(IMSG_ESOCK_RECV);
          Synchronize(OnError);
        end;
        Break;
      end;
      Buffer := @buf;
      BufLen := rc;
      if rc > 0 then
        if Assync then
          Synchronize(OnReceive)
        else
          OnReceive;
    end;
  end;
end;

{Start work w/o allocating the new socket}
procedure TCustomSocket.StartWork(Socket: TSocket);
begin
  if FWorking then Exit else FWorking := True;
  FDoConnect := False; FConnected := False;
  FSocket := Socket;
  Resume;
end;

{Start work with new socket}
procedure TCustomSocket.Connect;
begin
  if FWorking then Exit else FWorking := True;
  FDoConnect := True; FConnected := False;
  FSocket := WinSock.socket(PF_INET, SOCK_STREAM, 0);
  if FSocket = INVALID_SOCKET then begin
    FLastError := WSAGetLastError;
    FLastErrMsg :=  ICQLanguages[FErrLang].Translate(IMSG_ESOCK_SOCKET);
    Synchronize(OnError);
    Exit;
  end;
  Resume;
end;

{Frees the WSA socket}
procedure TCustomSocket.FreeSocket;
begin
  if not Terminated then
    Terminate;
  if FSocket <> INVALID_SOCKET then begin
    closesocket(FSocket);
    FSocket := INVALID_SOCKET;
  end;
  FWorking := False;
end;

{Sends data to connected socket}
procedure TCustomSocket.SendData(Buffer: Pointer; Len: LongWord);
begin
  {$IFDEF DEBUGDC}
    SendDebugEx('SendData', mtInformation);
  {$ENDIF}
  if Len = 0 then Exit;
  if (Assync) and (FBuffer <> nil) then begin
    FDataSentEvent := False;
    FBuffer.Enter;
    FBuffer.AddPacket(Buffer, Len);
    FBuffer.Leave;
  end else
    if send(FSocket, Buffer^, Len, 0) = SOCKET_ERROR then begin
      FLastError := WSAGetLastError;
      FLastErrMsg :=  ICQLanguages[FErrLang].Translate(IMSG_ESOCK_SEND);
      Synchronize(OnError);
      Exit;
    end;
end;

procedure TCustomSocket.SendStr(const Value: String);
begin
  SendData(@Value[1], Length(Value));
  if ClassName = 'THTTPSocket' then
  begin
    {$IFDEF PARSE}
    LogText('http.txt', 'Sent (proxy): '#13#10 + Value);
    {$ENDIF}
  end;
end;

procedure TCustomSocket.OnError;
begin
  FreeSocket;
end;

procedure TCustomSocket.OnConnect;
begin
end;

procedure TCustomSocket.OnConnectError;
begin
  FreeSocket;
end;

procedure TCustomSocket.OnDisconnect;
begin
  FreeSocket;
end;

procedure TCustomSocket.OnReceive;
begin
end;

procedure TCustomSocket.OnDataSent;
begin
end;






{ TProxySocket }

procedure TProxySocket.Execute;
begin
  if FProxyResolve then
    FDestIp := Resolve(FDestHost); {Resolve destination host, if possible}
  inherited;
end;



{ TEventSocket }

procedure TEventSocket.OnConnect;
begin
  if ClassName <> 'THTTPSocket' then begin
    if ProxyReady and Assigned(_OnConnect) then
      FOnConnect(Self);
  end else
    if Assigned(_OnConnect) then
      FOnConnect(Self);
  inherited;
end;

procedure TEventSocket.OnError;
begin
  inherited;
  if Assigned(_OnError) then
    FOnError(Self, ERR_SOCKET, FLastErrMsg);
end;

procedure TEventSocket.OnConnectError;
begin
  inherited;
  if Assigned(_OnConnectError) then
    FOnConnectError(Self);
end;

procedure TEventSocket.OnDisconnect;
begin
  inherited;
  if Assigned(_OnDisconnect) then
    FOnDisconnect(Self);
end;

procedure TEventSocket.OnReceive;
begin
  if ProxyReady then begin
    if Assigned(_OnReceive) then
      FOnReceive(Self, Buffer, BufLen);
  end else
    inherited;
end;

procedure TEventSocket.OnDataSent;
begin
  if Assigned(_OnDataSent) then
    FOnDataSent(Self);
end;





{ TSOCKS4Socket }

procedure TSOCKS4Socket.OnConnect;
var
  buf: array[0..255] of Byte;
begin
  inherited;
  if not ProxyReady then begin
    FSrcLen := 0;
    buf[0] := 4;                                                          //Socks4
    buf[1] := 1;                                                          //Code: 1 - Connect
    PWord(Ptr(LongWord(@Buf) + 2))^ := htons(Port);                       //Port
    if FProxyResolve then
      PDWord(Ptr(LongWord(@Buf) + 4))^ := inet_addr('0.0.0.1')            //SOCKS4a extension
    else
      PDWord(Ptr(LongWord(@Buf) + 4))^ := FDestIp;                        //Host
    if ProxyAuth then                                                     //Add some packet specified data when using proxy authentication
    begin
      if Length(ProxyUser) > 0 then                                       //Test if ProxyUserID string is not nil
        Move(ProxyUser[1], buf[8], Length(ProxyUser));                    //If it's not then add it to packet
      buf[8 + Length(ProxyUser)] := 0;                                    //Always present NULL termination byte
    end else
      buf[8] := 0;                                                        //Always present NULL termination byte
    SendData(@buf, 9 + Length(ProxyUser));                                //Send data
    if FProxyResolve then                                                 //SOCKS4a extension
      SendStr(FDestHost + #0);
  end;
end;

procedure TSOCKS4Socket.OnReceive;
var
  i: LongWord;
begin
  if not ProxyReady then begin
    for i := 0 to BufLen - 1 do
    begin
      FSrcBuf[FSrcLen] := PByte(LongWord(Buffer) + i)^;
      Inc(FSrcLen);
      if FSrcLen = 8 then
      begin
        Dec(BufLen, i);
        FSrcLen := 0;
        if PByte(Ptr(LongWord(Buffer) + 1))^ <> 90 then
        begin
          FLastError := 0;
          FLastErrMsg := ICQLanguages[FErrLang].Translate(IMSG_ESOCK_SOCKS4CONN);
          Synchronize(OnConnectError);
          Exit;
        end;
        ProxyReady := True;
        Synchronize(OnConnect);
        if i < BufLen - 1 then begin
          Buffer := Ptr(LongWord(Buffer) + i); //Continue handling of remaining data
          Synchronize(OnReceive);
        end;
      end;
    end;
  end else
    inherited;
end;




{ TSOCKS5Socket }

procedure TSOCKS5Socket.OnConnect;
var
  buf: array[0..2] of Byte;
begin
  inherited;
  if not ProxyReady then begin
    FSocksProgress := 0;                //Socks authorization progress
    buf[0] := 5;                        //Socks5
    buf[1] := 1;                        //Number of methods
    if ProxyAuth then                   //Choose auth method
      buf[2] := 2                       //Use authentication
    else
      buf[2] := 0;                      //Plain connect
    SendData(@buf, 3);                  //Send SOCKS5 initialization packet
  end;
end;

procedure TSOCKS5Socket.OnReceive;
  procedure DoSocks5Connect;
  var
    len: Word;
    buf: array[0..255] of Byte;
  begin
    if not ProxyResolve then         //Socks5 supports on-server-resolving
      len := 4
    else
      len := Length(Host) + 1;
    buf[0] := 5;                        //Socks5
    buf[1] := 1;                        //Command: connect
    buf[2] := 0;                        //Reserved
    if ProxyResolve then
    begin
      buf[3] := 3;
      buf[4] := len - 1;
      Move(PChar(Host)^, buf[5], len - 1);
    end else
    begin
      buf[3] := 1;
      PDWord(LongWord(@buf) + 4)^ := FDestIp;
    end;
    PWord(LongWord(@buf) + 4 + Len)^ := htons(Port);
    SendData(@buf, 6 + Len);
  end;
var
  i: LongWord;
  UserLen, PassLen: Word;
begin
  if not ProxyReady then begin
    for i := 0 to BufLen - 1 do
    begin
      FSrcBuf[FSrcLen] := PByte(LongWord(Buffer) + i)^;
      Inc(FSrcLen);
      case FSocksProgress of
        0:
        begin
          if FSrcLen = 2 then
          begin
            if FSrcBuf[1] = $ff then
            begin
              FLastError := 0;
              FLastErrMsg := ICQLanguages[FErrLang].Translate(IMSG_ESOCK_SOCKS5AUTH);
              Synchronize(OnConnectError);
              Exit;
            end;
            FSrcLen := 0;
            if FSrcBuf[1] = 2 then
            begin
              UserLen := Length(ProxyUser);
              PassLen := Length(ProxyPass);
              FSrcBuf[0] := 1;
              FSrcBuf[1] := UserLen;
              Move(PChar(ProxyUser)^, Ptr(LongWord(@FSrcBuf) + 2)^, UserLen);
              FSrcBuf[UserLen + 2] := PassLen;
              Move(PChar(ProxyPass)^, Ptr(LongWord(@FSrcBuf) + 3 + UserLen)^, UserLen);
              SendData(@FSrcBuf, 3 + UserLen + PassLen);
              Inc(FSocksProgress);
            end else
            begin
              Inc(FSocksProgress, 2);