mysocket.pas

DarkMoon v4.11 (远程控制) 国外收集的代码,控件下载: http://www.winio.cn/Blogs/jishuwenzhang/200712/20071208230135.

  begin
    FSocks := 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
    FSock.SendData(buf, 3);             //Send SOCKS5 initialization packet
  end
  {$IFNDEF REMOVEHTTP}
  else if ProxyType = P_HTTP then
    FSock.SendStr(CreateHTTP_INIT);
  {$ENDIF}
end;

{$IFNDEF REMOVEHTTP}
procedure TProxySock.SendHTTPData(Buffer: Pointer; BufLen: LongWord);
var
  buf: TRawPkt;
begin
  if BufLen = 0 then Exit;
  Inc(FICQSeq);
  PktInitRaw(@buf);
  PktStr(@buf, CreateHTTP_Header('POST', 'http://' + FICQPIP + '/data?sid=' + FICQSID + '&seq=' + IntToStr(FICQSeq), FICQPIP, BufLen));
  PktAddArrBuf(@buf, Buffer, BufLen);
  FSock.Ip := ProxyHost;
  FSock.DestPort := ProxyPort;
  if not FSock.Connected then
    FSock.Connect(False);
  FSock.SendData(buf, buf.Len);
end;

procedure TProxySock.HandleHTTPDataPak(Buffer: Pointer; BufLen: LongWord);
var
  pkt: TRawPkt;
  ptype: Word;
  sw: LongWord;
begin
  Move(Buffer^, pkt.Data, BufLen);
  pkt.Len := 0;
  GetInt(@pkt, 2); //Version
  ptype := GetInt(@pkt, 2);
  Inc(pkt.Len, 6);
  case ptype of
    2 {HELLO REPLY}:
    begin
      sw := GetInt(@pkt, 4); FICQSid := IntToHex(sw, 8);
      sw := GetInt(@pkt, 4); FICQSid := FICQSid + IntToHex(sw, 8);
      sw := GetInt(@pkt, 4); FICQSid := FICQSid + IntToHex(sw, 8);
      sw := GetInt(@pkt, 4); FICQSid := FICQSid + IntToHex(sw, 8);
      FICQPIP := GetWStr(@pkt);
      FICQPPort := GetLInt(@pkt, 2);
      CreateHTTP_LOGIN(@pkt, Host, Port);
      SendHTTPData(@pkt, pkt.Len);
    end;
    5 {FLAP PACKETS}:
      OnReceive(Ptr(LongWord(@pkt.Data) + pkt.Len + 2), BufLen - pkt.Len - 2);
  end;
end;

procedure TProxySock.HandleHTTPData(Buffer: Pointer; BufLen: LongWord);
function GetHTTPStatus(List: TStringList): String;
var
  i, c: Word;
  S: String;
begin
  if List.Count < 1 then Exit;
  S := List.Strings[0]; c := 0;
  for i := 1 to Length(S) do
    if c = 1 then
      Result := Result + S[i]
    else
      if S[i] = ' ' then Inc(c);
end;

function GetHTTPLength(List: TStringList): Integer;
var
  i: Word;
begin
  Result := 0;
  if List.Count < 1 then Exit;
  for i := 0 to List.Count - 1 do
    if Copy(List.Strings[i], 0, 16) = 'Content-Length: ' then
    begin
      Result := StrToInt(Copy(List.Strings[i], 16, $FF));
      Exit;
    end;
end;

{$WARNINGS OFF}
procedure HandleICQPakHTTP(Buffer: Pointer; BufLen: LongWord);
var
  Len: Word;
  Buf: TRawPkt;
  l: LongWord;
begin
  l := 0;
  if BufLen > $FFFF then Exit;
  while True do
  begin
    if l = BufLen then Break;
    Len := Swap16(PWord(Buffer)^);
    if (Len > 8192) or (Len < 12) then Break;
    Move(Ptr(LongWord(Buffer) + 2)^, Buf, Len);
    Inc(l, Len + 2);
    Buffer := Ptr(LongWord(Buffer) + Len + 2);
    {Handle ICQ Pak packet}
    HandleHTTPDataPak(@Buf, Len);
    //LogText('proto.txt', DumpPacket(@Buf, Len));
  end;
end;
{$WARNINGS ON}

var
  i: LongWord;
  List: TStringList;
  l: LongWord;
  s: String;
begin
  if BufLen < 1 then Exit;
  for i := 0 to BufLen - 1 do
  begin
    FBuf[FCurLen] := PByte(LongWord(Buffer) + i)^;
    Inc(FCurLen);
    if flen = 0 then
      if FCurLen > 3 then
        if Copy(PChar(@FBuf), FCurLen - 3, 4) = #13#10#13#10 then
        begin
          FCurLen := 0;
          List := TStringList.Create;
          List.Text := PChar(@FBuf);
          s := GetHTTPStatus(List);
          flen := GetHTTPLength(List);
          List.Free;
          if s <> '200 OK' then
          begin
            if Assigned(OnError) then
              FOnError(Self, ERR_PROTOCOL, 'Http proxy returned invalid status: ' + s);
            FSock.Disconnect;
            FICQRecv.Disconnect;
            Exit;
          end;
        end;
    if (FCurLen = flen) and (FCurLen <> 0) then
    begin
      l := FCurLen; flen := 0; FCurLen := 0; {using l, avoiding AVs}
      HandleICQPakHTTP(@FBuf, l);
      InitRecvConnection;
      {send HTTP_RECV}
      //FSock.SendStr(CreateHTTP_RECV(FICQPIP, FICQSID))
    end;
  end;
end;
{$ENDIF}

{Called when something received on socket.}
procedure TProxySock.OnSockRecv(Sender: TObject; Socket: TSocket; Buffer: Pointer; BufLen: LongWord);
var
  i: Word;
  UserLen, PassLen: Word;
  procedure DoSocks5Connect;
  var
    len: Word;
    buf: array[0..255] of Byte;
  begin
    if not UseProxyResolve 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 UseProxyResolve 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)^ := inet_addr(PChar(Host));
    end;
    PWord(LongWord(@buf) + 4 + Len)^ := htons(Port);
    FSock.SendData(buf, 6 + Len);
  end;

begin
  if BufLen = 0 then Exit;
  if ProxyType = P_SOCKS4 then
  begin
    for i := 0 to BufLen - 1 do
    begin
      FSrcBuf[FSrcLen] := PByte(LongWord(Buffer) + i)^;
      Inc(FSrcLen);
      if FSrcLen = 8 then
      begin
        FProxyType := P_NONE;           //After we connected to proxy we work as usual
        Dec(BufLen, i);
        FSrcLen := 0;
        if PByte(Ptr(LongWord(Buffer) + 1))^ <> 90 then
        begin
          if Assigned(OnError) then
            FOnError(Self, ERR_PROXY, 'SOCKS4 server cannot connect to remote server');
          if Assigned(OnConnectError) then
            FOnConnectError(Self);
          Exit;
        end;
        FSock.OnPktParse := OnPktParse;
        if Assigned(OnConnectProc) then
          FOnConnectProc(Self);
        if i < BufLen - 1 then
          OnSockRecv(Sender, Socket, Ptr(LongWord(Buffer) + i), BufLen);        //Continue handling of remaining data
      end;
    end;
    Exit;
  end else
  if ProxyType = P_SOCKS5 then
  begin
    for i := 0 to BufLen - 1 do
    begin
      FSrcBuf[FSrcLen] := PByte(LongWord(Buffer) + i)^;
      Inc(FSrcLen);
      case FSocks of
        0:
        begin
          if FSrcLen = 2 then
          begin
            if FSrcBuf[1] = $ff then
            begin
              if Assigned(OnError) then
                FOnError(Self, ERR_PROXY, 'Auth methods are not supported by SOCKS5 server');
              if Assigned(OnConnectError) then
                FOnConnectError(Self);
              Exit;
            end;
            FSrcLen := 0;
            if FSrcBuf[1] = 2 then
            begin
              UserLen := Length(ProxyUserID);
              PassLen := Length(ProxyPass);
              FSrcBuf[0] := 1;
              FSrcBuf[1] := UserLen;
              Move(PChar(ProxyUserID)^, Ptr(LongWord(@FSrcBuf) + 2)^, UserLen);
              FSrcBuf[UserLen + 2] := PassLen;
              Move(PChar(ProxyPass)^, Ptr(LongWord(@FSrcBuf) + 3 + UserLen)^, UserLen);
              FSock.SendData(FSrcBuf, 3 + UserLen + PassLen);
              Inc(FSocks);
            end else
            begin
              Inc(FSocks, 2);
              DoSocks5Connect;
            end;
          end;
        end;
        1:
        begin
          if FSrcLen = 2 then
          begin
            if FSrcBuf[1] <> 0 then
            begin
              if Assigned(OnError) then
                FOnError(Self, ERR_PROXY, 'SOCKS5 server cannot authenticate us');
              if Assigned(OnConnectError) then
                FOnConnectError(Self);
              Exit;
            end;
            FSrcLen := 0;
            Inc(FSocks);
            DoSocks5Connect;
          end;
        end;
        2:
        begin
          if FSrcLen = 10 then
          begin
            if (FSrcBuf[0] <> 5) or (FSrcBuf[1] <> 0) then
            begin
              if Assigned(OnError) then
                FOnError(Self, ERR_PROXY, 'SOCKS5 server cannot connect to remote server');
              if Assigned(OnConnectError) then
                FOnConnectError(Self);
              Exit;
            end;
            FSrcLen := 0;
            ProxyType := P_NONE;
            FSock.OnPktParse := OnPktParse;
            if Assigned(OnConnectProc) then
              FOnConnectProc(Self);
            if i < BufLen - 1 then
              OnSockRecv(Sender, Socket, Ptr(LongWord(Buffer) + i), BufLen);        //Continue handling of remaining data
          end;
        end;
      end;
    end;
    Exit;
  end; {$IFNDEF REMOVEHTTP} else
  if ProxyType = P_HTTP then
  begin
    HandleHTTPData(Buffer, BufLen);
    InitRecvConnection;
    Exit;
  end;{$ENDIF}
  OnReceive(Buffer, BufLen);
end;

{Called when some data has been sent through socket.}
procedure TProxySock.OnPktParse(Sender: TObject; Buffer: Pointer; BufLen: LongWord);
begin
  if Assigned(OnPktParseA) then
    FOnPktParse(Sender, Buffer, BufLen, False);
end;

{Sending data throgh socket.}
procedure TProxySock.SendData(var Buf; BufLen: LongWord);
{$IFNDEF REMOVEHTTP}
var
  pkt: TRawPkt;
{$ENDIF}
begin
  {$IFNDEF REMOVEHTTP}
  if FProxyType <> P_HTTP then
    FSock.SendData(Buf, BufLen)
  else begin
    if Assigned(OnPktParseA) then
      FOnPktParse(Self, @Buf, BufLen, False);
    CreateHTTP_DATA(@pkt, $0005, @Buf, BufLen);
    SendHTTPData(@pkt, pkt.Len);
  end;
  {$ELSE}
  FSock.SendData(Buf, BufLen)  
  {$ENDIF}
end;

{Forward handlers.}
procedure TProxySock.OnReceive;
begin
  if Assigned(OnReceiveProc) then
    FOnRecv(Self, FSock.FClSock, Buffer, BufLen);
end;

function TMySock.GetClientSocket: TSocket;
begin
  Result := FSock.FClSock;
end;

procedure TMySock.SetClientSocket(Socket: TSocket);
begin
  FSock.FClSock := Socket;
end;

function TMySock.IsConnected: Boolean;
begin
  Result := FSock.IsConnected;
end;



{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
{-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=}
constructor TSrvSock.Create;
begin
  inherited;
  FWndHandle := AllocateHwnd(OnSockMsg);
  FSrvSock := INVALID_SOCKET;

  FPort := 0;
end;

destructor TSrvSock.Destroy;
begin
  StopServer;
  DeallocateHwnd(FWndHandle);
  
  inherited;
end;

procedure TSrvSock.OnSockMsg(var Msg: TMessage);
var
  rc: Integer;
  acc_sin_len: Integer;
  acc_sin: sockaddr_in;
  FClSock: TSocket;
  FCl: TMySock;
begin
  case Msg.Msg of
    WSA_ACCEPT:
    begin
      if WSAGETSELECTERROR(Msg.lParam) <> 0 then
      begin
        MessageBox(0, 'accept() Error', 'Error', MB_OK);
        //WSAAsyncSelect(FSrvSock, FWndHandle, 0, 0);
        Exit;
      end;

      //Size of acc_sin
      acc_sin_len := SizeOf(acc_sin);

      //Allow connection
      FClSock := accept(FSrvSock, @acc_sin, @acc_sin_len);

      if FClSock = INVALID_SOCKET then
      begin
        MessageBox(0, 'accept() Error, invalid socket', 'Error', MB_OK);
        Exit;
      end;

      FCl := TMySock.Create;
      FCl.ClientSocket := FClSock;

      //Allow network notifies in client socket
      rc := WSAAsyncSelect(FClSock, FCl.WndHandle, WSA_NETEVENT,
        FD_READ or FD_CLOSE or FD_WRITE);
      if rc > 0 then
      begin
        closesocket(FClSock);
        MessageBox(0, 'WSAAsyncSelect Error', 'Error', MB_OK);
        FCl.Free;
        Exit;
      end;
      if Assigned(OnClientConnected) then
        FOnClientConnected(Self, FCl);
    end else
      Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.WParam, Msg.LParam);
  end;
end;


function TSrvSock.StartServer(Port: Word): Boolean;
var
  srv_address: sockaddr_in;
  rc: Integer;
begin
  Result := False;
  FPort := 0;

  //Creating server socket
  FSrvSock := socket(AF_INET, SOCK_STREAM, 0);
  if FSrvSock = INVALID_SOCKET then
  begin
    MessageBox(0, 'Could not create server socket()', 'Error', MB_OK);
    Exit;
  end;

  srv_address.sin_family := AF_INET;
  srv_address.sin_addr.s_addr := INADDR_ANY;  //Accept connection from all addresses
  srv_address.sin_port := htons(Port);        //Set local port

  //Binding a port
  if bind(FSrvSock, srv_address, SizeOf(srv_address)) = SOCKET_ERROR then
  begin
    //Closing socket on error
    closesocket(FSrvSock);
    MessageBox(0, 'Could not bind server', 'Error', MB_OK);
    Exit;
  end;

  //Setting socket in listen status
  if listen(FSrvSock, 5) = SOCKET_ERROR then
  begin
    closesocket(FSrvSock);
    MessageBox(0, 'listen() Error', 'Error', MB_OK);
    Exit;
  end;

  rc := WSAAsyncSelect(FSrvSock, FWndHandle, WSA_ACCEPT, FD_ACCEPT);
  if rc > 0 then
  begin
    closesocket(FSrvSock);
    MessageBox(0, 'WSAAsyncSelect Error', 'Error', MB_OK);
    Exit;
  end;

  Result := True;
  FPort := Port;
end;

function TSrvSock.StopServer: Boolean;
begin
  Result := False;
  if FSrvSock  <> INVALID_SOCKET then
  begin
    //Removing receiveing of all notifications
    WSAAsyncSelect(FSrvSock, FWndHandle, 0, 0);
    //If socket was created then close it
    closesocket(FSrvSock);
    FSrvSock := INVALID_SOCKET;
    Result := True;
  end;
end;

initialization
begin
  InitMySocket(WSA);

  {$IFNDEF USE_FORMS}
  InstBlockList := nil;
  InstFreeList := nil;
  {$ENDIF}
end;

finalization
begin
  FinalMySocket;
end;

end.