mysocket.pas

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

  TempClass: TWndClass;
  ClassRegistered: Boolean;
begin
  UtilWindowClass.hInstance := HInstance;
  ClassRegistered := GetClassInfo(HInstance, UtilWindowClass.lpszClassName,
    TempClass);
  if not ClassRegistered or (TempClass.lpfnWndProc <> @DefWindowProc) then
  begin
    if ClassRegistered then
      Windows.UnregisterClass(UtilWindowClass.lpszClassName, HInstance);
    Windows.RegisterClass(UtilWindowClass);
  end;
  Result := CreateWindow(UtilWindowClass.lpszClassName,
    '', WS_POPUP, 0, 0, 0, 0, 0, 0, HInstance, nil);
  if Assigned(Method) then
    SetWindowLong(Result, GWL_WNDPROC, Longint(MakeObjectInstance(Method)));
end;

procedure DeallocateHWnd(Wnd: THandle);
var
  Instance: Pointer;
begin
  Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
  DestroyWindow(Wnd);
  if Instance <> @DefWindowProc then FreeObjectInstance(Instance);
end;
{$ENDIF}
/////////////////////////////////////////////////////////////////////////////////////////////////////////

constructor TClSock.Create;
begin
  inherited;
  FWndHandle := AllocateHwnd(OnSockMsg);
  FClSock := INVALID_SOCKET;
  FResolve := False;
  FBuffer := TNetBuffer.Create;

end;

destructor TClSock.Destroy;
begin
  DoClose;
  DeallocateHwnd(FWndHandle);
  FBuffer.Free;
  inherited;
end;

function TClSock.TestResolve(IP: String): Boolean;
begin
  Result := inet_addr(PChar(IP)) <> LongInt(INADDR_NONE);
end;

function TClSock.ResolveAddr(Value: Pointer): LongInt;
var
  addr: in_addr;
  hostent: PHostEnt;
begin
  Result := -1;
  hostent := Value;
  if hostent^.h_addr_list <> nil then
  begin
    addr.S_addr := PLongInt(hostent^.h_addr_list^)^;
    Result := addr.S_addr;
  end else
    Exit;
end;

procedure TClSock.InitConnect(dwIP: LongWord);
var
  dest_sin: TSockAddr;
begin
  DoClose;
  FClSock := socket(AF_INET, SOCK_STREAM, 0);
  WSAAsyncSelect(FClSock, FWndHandle, WSA_NETEVENT, FD_CONNECT or FD_CLOSE or FD_READ or FD_WRITE);

  dest_sin.sin_family := AF_INET;
  dest_sin.sin_addr.s_addr := dwIP;
  dest_sin.sin_port := htons(FDestPort);

  if (WinSock.connect(FClSock, dest_sin, SizeOf(TSockAddr)) = SOCKET_ERROR) and (WSAGetLastError <> WSAEWOULDBLOCK) then
  begin
    DoClose;  
    if Assigned(OnError) then
      FOnError(Self, ERR_SOCKET, 'connect() returned SOCKET_ERROR');
    if Assigned(OnConnectError) then
      FOnConnectError(Self);
    Exit;
  end;
end;

procedure TClSock.OnSockMsg(var Msg: TMessage);
var
  rc: Integer;
  buf: array[0..1023] of Byte;
  inaddr: in_addr;
begin
  case Msg.Msg of
    WSA_RESOLVE_COMPLETE:
    begin
      if FResolve then
      begin
        if Assigned(OnResolve) then
        begin
          if HIWORD(Msg.wParam) <> 0 then
          begin
           if Assigned(OnError) then
              FOnError(Self, ERR_SOCKET, 'Cannot resolve host');
            if Assigned(OnResolveFailed) then
              FOnFailed(Self);
            Exit;
          end;
          inaddr.S_addr := ResolveAddr(@FHostIP);
          if Assigned(OnResolve) then
            FOnResolve(Self, inet_ntoa(inaddr));
          Exit;
        end;
      end;
      if HIWORD(Msg.wParam) <> 0 then
      begin
        DoClose;      
        if Assigned(OnError) then
          FOnError(Self, ERR_SOCKET, 'Cannot resolve host');
        if Assigned(OnConnectError) then
          FOnConnectError(Self);
        Exit;
      end;
      InitConnect(ResolveAddr(@FHostIP));
    end;
    WSA_NETEVENT:
    begin
      if WSAGetSelectEvent(Msg.lParam) = FD_READ then
      begin
        rc := recv(Msg.wParam, buf, SizeOf(buf) - 1, 0);
        if rc <> SOCKET_ERROR then
        begin
          if Assigned(OnRecieve) then
            FOnRecv(Self, Msg.wParam, @buf, rc);
        end else
        begin
          if Assigned(OnError) then
            FOnError(Self, ERR_SOCKET, 'Received some data, but recv() returned 0');
          Disconnect;
        end;
        Exit;
      end
      //Connection with server was lost
      else if WSAGetSelectEvent(Msg.lParam) = FD_CLOSE then
        Disconnect
      //Connection with server has been estabilished or connection error
      else if WSAGetSelectEvent(Msg.lParam) = FD_CONNECT then
      begin
        if HIWORD(Msg.lParam) = 0 then
        begin
          if Assigned(OnConnect) then
            FOnConnect(Self);
        end else
        begin
          DoClose;
          if Assigned(OnError) then
            FOnError(Self, ERR_SOCKET, 'Cannot connect: no rote to host.');
          if Assigned(OnConnectError) then
            FOnConnectError(Self);
          Exit;
        end;
      end
      else if WSAGetSelectEvent(Msg.lParam) = FD_WRITE then
      begin
        FCanWrite := True;
        ProcessBuffer;
      end;
    end else
      Msg.Result := DefWindowProc(FWndHandle, Msg.Msg, Msg.WParam, Msg.LParam);
  end;
end;

procedure TClSock.ProcessBuffer;
var
  ret: Integer;
  Buf: array[0..CNetPktLen - 1] of Byte;
begin
  if not FCanWrite then Exit;
  if FClSock <> INVALID_SOCKET then
  begin
    while True do
    begin
      ret := FBuffer.GetPacket(@Buf);
      if ret < 1 then begin if Assigned(OnDataSent) then FOnDataSent(Self); Exit; end; {All data has been sent}
      ret := send(FClSock, Buf, ret, 0);
      if ret = SOCKET_ERROR then
      begin
        if WSAGetLastError = WSAEWOULDBLOCK then
          FCanWrite := False
        else begin
          if Assigned(OnError) then
            FOnError(Self, ERR_SOCKET, 'Could not send data');
          Disconnect;
        end;
        Exit;
      end else
        if FBuffer.SkipData(ret) then
          FBuffer.DelPacket;
    end;
  end;
end;

function TClSock.IsConnected: Boolean;
begin
  Result := FClSock <> INVALID_SOCKET;
end;

procedure TClSock.Connect(ClearBuffer: Boolean = True);
begin
  FResolve := False;
  if ClearBuffer then FBuffer.Clear;
  if not TestResolve(FIp) then
  begin
    if WSAAsyncGetHostByName(FWndHandle, WSA_RESOLVE_COMPLETE, PChar(FIp), @FHostIp, SizeOf(FHostIp)) = 0 then
    begin
      DoClose;
      if Assigned(OnError) then
        FOnError(Self, ERR_SOCKET, 'Cannot init async. resolving');
      if Assigned(OnConnectError) then
        FOnConnectError(Self);
      Exit;
    end;
  end else
  begin
    InitConnect(inet_addr(PChar(FIp)));
  end;
end;

procedure TClSock.Resolve;
begin
  FBuffer.Clear;
  if not TestResolve(FIp) then
  begin
    FResolve := True;
    if WSAAsyncGetHostByName(FWndHandle, WSA_RESOLVE_COMPLETE, PChar(FIp), @FHostIp, SizeOf(FHostIp)) = 0 then
    begin
      DoClose;    
      if Assigned(OnError) then
        FOnError(Self, ERR_SOCKET, 'Cannot init async. resolving');
      if Assigned(OnResolveFailed) then
        FOnFailed(Self);
    end;
  end else
  begin
    FResolve := False;
    if Assigned(OnResolve) then
      FOnResolve(Self, FIp);
  end;
end;

procedure TClSock.DoClose;
begin
  if FClSock <> INVALID_SOCKET then
  begin
    closesocket(FClSock);
    FClSock := INVALID_SOCKET;
  end;
end;

procedure TClSock.Disconnect;
var
  OldSock: TSocket;
begin
  OldSock := FClSock;
  DoClose;
  if OldSock <> INVALID_SOCKET then
    if Assigned(OnDisconnect) then
      FOnDisconnect(Self);
end;

procedure TClSock.SendData(var Buf; BufLen: LongWord);
begin
  if Assigned(OnPktParse) then
    FOnPktParse(Self, @Buf, BufLen);
  FBuffer.AddPacket(@Buf, BufLen);
  ProcessBuffer;
end;

procedure TClSock.SendStr(const Value: String);
begin
  SendData(PChar(Value)^, Length(Value));
end;

function GetLocalIP: LongInt;
type
  PaPInAddr = ^TaPInAddr;
  TaPInAddr = array[0..$FFFE] of PInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  Buffer: array[0..63] of Char;
  I: Integer;
begin
  Result := -1;
  GetHostName(Buffer, SizeOf(Buffer));
  phe := GetHostByName(buffer);
  if phe = nil then Exit;
  pptr := PaPInAddr(Phe^.h_addr_list);
  I := 0;
  while pptr^[I] <> nil do
  begin
    Result := pptr^[I]^.S_addr;
    Inc(I);
  end;
end;

function FindBindPort: Word;
var
  i: Word;
  srv_address: sockaddr_in;
  sock: TSocket;
begin
  Result := 0;
  sock := socket(AF_INET, SOCK_STREAM, 0);
  if sock = INVALID_SOCKET then
    Exit;
  srv_address.sin_family := AF_INET;
  srv_address.sin_addr.s_addr := INADDR_ANY;
  for i := 3000 to 50000 do
  begin
    srv_address.sin_port := htons(i);
    if bind(sock, srv_address, SizeOf(srv_address)) <> SOCKET_ERROR then
    begin
      closesocket(sock);
      Result := i;
      Exit;
    end;
  end;
end;

{@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@2}

constructor TProxySock.Create;
begin
  inherited Create;
  //Socket for working with TCP connections
  FSrcLen := 0;

  {$IFNDEF REMOVEHTTP}
  FCurLen := 0;
  FLen := 0;
  FICQSEQ := 0;

  FICQRecv := TClSock.Create;
  FICQRecv.OnConnect := OnHTTPRecvSockConnect;
  FICQRecv.OnRecieve := OnSockRecv;
  {$ENDIF}

  FSock := TClSock.Create;
  FSock.OnRecieve := OnSockRecv;
  FSock.OnDisconnect := OnSockDisconnect;
  FSock.OnConnectError := OnSockConnectError;
  FSock.OnPktParse := OnPktParse;
  FSock.OnConnect := OnSockConnect;
  FSock.OnResolve := OnSockResolve;
  FSock.OnResolveFailed := OnSockResolveFailed;
  FSock.OnError := OnSockError;
end;

{*** DESTRUCTOR ***}
destructor TProxySock.Destroy;
begin
  FSock.OnRecieve := nil;          //.                                               .
  FSock.OnDisconnect := nil;       //.                                               .
  FSock.OnConnectError := nil;     //.   DO NOT USE NOTIFICATIONS WHILE DESTROYING   .
  FSock.OnPktParse := nil;         //.      THE OBJECT, CAUSES ACCESS VIOLATIONS     .
  FSock.OnConnect := nil;          //.                                               .
  FSock.OnResolve := nil;          //.
  FSock.OnError := nil;
  FSock.Free;

  {$IFNDEF REMOVEHTTP}
  FICQRecv.OnError := nil;
  FICQRecv.OnDisconnect := nil;
  FICQRecv.Free;
  {$ENDIF}
  
  inherited;
end;

{Connect procedure. Use it to connect to the remote server.}
procedure TProxySock.Connect;
begin
  if (ProxyType = P_SOCKS4) or (ProxyType = P_SOCKS5) {$IFNDEF REMOVEHTTP} or (ProxyType = P_HTTP) {$ENDIF} then
  begin
    {$IFNDEF REMOVEHTTP}
    FICQRecv.Disconnect;
    {$ENDIF}

    FSock.Disconnect;

    FSock.OnPktParse := nil;       //Do not dump proxy data
    if not FResolve then
    begin
      FSock.IP := Host;
      FSock.Resolve;
      Exit;
    end;
    FSock.IP := ProxyHost;
    FSock.DestPort := ProxyPort;
    FSock.Connect;
  end else
  begin
    FSock.IP := Host;
    FSock.DestPort := Port;
    FSock.Connect;
  end;
end;

{Force socket disconnection.}
procedure TProxySock.Disconnect;
begin
  FSock.Disconnect;
  {$IFNDEF REMOVEHTTP}
  FICQRecv.Disconnect;
  {$ENDIF}
end;

{Called when socket cannot connect to remote host.}
procedure TProxySock.OnSockConnectError(Sender: TObject);
begin
  if Assigned(OnConnectError) then
    FOnConnectError(Self);
end;

{Called when closed connection.}
procedure TProxySock.OnSockDisconnect(Sender: TObject);
begin
  if Assigned(OnDisconnect) then
    FOnDisconnect(Self);
end;

procedure TProxySock.OnSockError(Sender: TObject; ErrorType: TErrorType; ErrorMsg: String);
begin
  if Assigned(OnError) then
    FOnError(Self, ErrorType, ErrorMsg);
end;

function TProxySock.GetWndHandle: THandle;
begin
  Result := FSock.WndHandle;
end;

{$IFNDEF REMOVEHTTP}
procedure TProxySock.InitRecvConnection;
begin
  FICQRecv.IP := ProxyHost;
  FICQRecv.DestPort := ProxyPort;
  FICQRecv.Disconnect;
  FICQRecv.Connect;
end;

procedure TProxySock.OnHTTPRecvSockConnect(Sender: TObject);
begin
  FICQRecv.SendStr(CreateHTTP_RECV(FICQPIP, FICQSID));
end;

procedure TProxySock.OnHTTPDataSent(Sender: TObject);
begin
  //FSock.Disconnect;
end;
{$ENDIF}

{Called when resolving of Host has been complete.}
procedure TProxySock.OnSockResolve(Sender: TObject; Addr: String);
begin
  if FProxyType = P_NONE then Exit;
  Host := Addr;
  FSock.IP := ProxyHost;
  FSock.DestPort := ProxyPort;
  FSock.Connect;
end;

{Called when resolving failed.}
procedure TProxySock.OnSockResolveFailed(Sender: TObject);
begin
  if Assigned(OnConnectError) then
    FOnConnectError(Self);
end;

{Called after our socket connected to server.}
procedure TProxySock.OnSockConnect(Sender: TObject);
var
  buf: array[0..255] of Byte;
begin
  if ProxyType = P_NONE then                                   //Do nothing if we are not using proxies
  begin
    if Assigned(OnConnectProc) then
      FOnConnectProc(Self);
    Exit
  end
  else if ProxyType = P_SOCKS4 then
  begin
    buf[0] := 4;                                                //Socks4
    buf[1] := 1;                                                //Code: 1 - Connect
    PWord(Ptr(LongWord(@Buf) + 2))^ := htons(Port);             //Port
    PDWord(Ptr(LongWord(@Buf) + 4))^ := inet_addr(PChar(Host)); //Host
    if ProxyAuth then                                           //Add some packet specified data when using proxy authentication
    begin
      if Length(ProxyUserID) > 0 then                           //Test if ProxyUserID string is not nil
        Move(PChar(ProxyUserID)^, buf[8], Length(ProxyUserID)); //If it's not then add it to packet
      buf[8 + Length(ProxyUserID) + 1] := 0;                    //Always present NULL termination byte
    end else
      buf[9] := 0;                                              //Always present NULL termination byte
    FSock.SendData(buf, 8 + Length(ProxyUserID) + 1);
  end
  else if ProxyType = P_SOCKS5 then