dm5314_usimpletcp.pas

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

                     { check whether data available }
                     if IoctlSocket(tmpSocket, FIONREAD, DataAvail) = SOCKET_ERROR then
                      begin
                       SocketError(tmpSocket, WSAGetLastError);
                       Exit;
                      end;
                     if DataAvail = 0 then Break;

                     Handled := False;
                     DoDataAvailable(tmpTCPClient, DataAvail, Handled);

                     if not Handled then
                       ReceiveStreamFrom(tmpSocket, MS, DataAvail, False);
                    end;

                   if not Handled and (MS.Size <> 0) then
                    begin
                     Seek(0, soFromBeginning); { to beginning of stream }
                     DoRead(tmpTCPClient, MS);
                    end; 
                 finally
                   Free;
                 end;
               end;
      FD_CLOSE: DoClose(Msg.wParam);
      FD_ACCEPT: DoAccept;
      FD_CONNECT: DoConnect;            
     end;
   end;
end;

procedure TCustomSimpleSocket.SocketError(Socket: TSocket; ErrorCode: Integer);
var
  ErrorMsg: String;
begin
  case ErrorCode of
    WSAEINTR: ErrorMsg := 'Interrupted system call';
    WSAEBADF: ErrorMsg := 'Bad file number';
    WSAEACCES: ErrorMsg := 'Permission denied';
    WSAEFAULT: ErrorMsg := 'Bad address';
    WSAEINVAL: ErrorMsg := 'Invalid argument';
    WSAEMFILE: ErrorMsg := 'Too many open files';
    WSAEWOULDBLOCK: ErrorMsg := 'Operation would block';
    WSAEINPROGRESS: ErrorMsg := 'Operation now in progress';
    WSAEALREADY: ErrorMsg := 'Operation already in progress';
    WSAENOTSOCK: ErrorMsg := 'Socket operation on non-socket';
    WSAEDESTADDRREQ: ErrorMsg := 'Destination address required';
    WSAEMSGSIZE: ErrorMsg := 'Message too long';
    WSAEPROTOTYPE: ErrorMsg := 'Protocol wrong type for socket';
    WSAENOPROTOOPT: ErrorMsg := 'Protocol not available';
    WSAEPROTONOSUPPORT: ErrorMsg := 'Protocol not supported';
    WSAESOCKTNOSUPPORT: ErrorMsg := 'Socket type not supported';
    WSAEOPNOTSUPP: ErrorMsg := 'Operation not supported on socket';
    WSAEPFNOSUPPORT: ErrorMsg := 'Protocol family not supported';
    WSAEAFNOSUPPORT: ErrorMsg := 'Address family not supported by protocol family';
    WSAEADDRINUSE: ErrorMsg := 'Address already in use';
    WSAEADDRNOTAVAIL: ErrorMsg := 'Can''t assign requested address';
    WSAENETDOWN: ErrorMsg := 'Network is down';
    WSAENETUNREACH: ErrorMsg := 'Network is unreachable';
    WSAENETRESET: ErrorMsg := 'Network dropped connection on reset';
    WSAECONNABORTED: ErrorMsg := 'Software caused connection abort';
    WSAECONNRESET: ErrorMsg := 'Connection reset by peer';
    WSAENOBUFS: ErrorMsg := 'No buffer space available';
    WSAEISCONN: ErrorMsg := 'Socket is already connected';
    WSAENOTCONN: ErrorMsg := 'Socket is not connected';
    WSAESHUTDOWN: ErrorMsg := 'Can''t send after socket shutdown';
    WSAETOOMANYREFS: ErrorMsg := 'Too many references: can''t splice';
    WSAETIMEDOUT: ErrorMsg := 'Connection timed out';
    WSAECONNREFUSED: ErrorMsg := 'Connection refused';
    WSAELOOP: ErrorMsg := 'Too many levels of symbolic links';
    WSAENAMETOOLONG: ErrorMsg := 'File name too long';
    WSAEHOSTDOWN: ErrorMsg := 'Host is down';
    WSAEHOSTUNREACH: ErrorMsg := 'No route to host';
    WSAENOTEMPTY: ErrorMsg := 'Directory not empty';
    WSAEPROCLIM: ErrorMsg := 'Too many processes';
    WSAEUSERS: ErrorMsg := 'Too many users';
    WSAEDQUOT: ErrorMsg := 'Disk quota exceeded';
    WSAESTALE: ErrorMsg := 'Stale NFS file handle';
    WSAEREMOTE: ErrorMsg := 'Too many levels of remote in path';
    WSASYSNOTREADY: ErrorMsg := 'Network sub-system is unusable';
    WSAVERNOTSUPPORTED: ErrorMsg := 'WinSock DLL cannot support this application';
    WSANOTINITIALISED: ErrorMsg := 'WinSock not initialized';
    WSAHOST_NOT_FOUND: ErrorMsg := 'Host not found';
    WSATRY_AGAIN: ErrorMsg := 'Non-authoritative host not found';
    WSANO_RECOVERY: ErrorMsg := 'Non-recoverable error';
    WSANO_DATA: ErrorMsg := 'No Data';
    else ErrorMsg := 'Not a WinSock error ?';
  end;
  
  if Assigned(FOnError) then
    FOnError(Self, Socket, ErrorCode, ErrorMsg)
  else
    //raise Exception.Create(ErrorMsg);
end;

function TCustomSimpleSocket.SendBufferTo(Socket: TSocket; Buffer: PChar; BufLength: Integer): Integer; // bytes sent
begin
  Result := 0;
  if (Socket <> INVALID_SOCKET) and (BufLength <> 0) then
   begin
    Result := WinSock.Send(Socket, Buffer^, BufLength, 0);
    if Result = SOCKET_ERROR then
      SocketError(Socket, WSAGetLastError);
   end;
end;

function  TCustomSimpleSocket.SendStreamTo(Socket: TSocket; Stream: TStream): Integer; // returns N of bytes sent
var
  Buffer: Pointer;
  SavePosition: LongInt;
begin
  Result := 0;
  if (Socket <> INVALID_SOCKET) and (Stream <> nil) then
   begin
    { save position in stream and go to beginning }
    SavePosition := Stream.Position;
    Stream.Seek(0, soFromBeginning);
    try
      { allocate memory for swap buffer }
      GetMem(Buffer, Stream.Size);
      try
        { filling the buffer from stream }
        Stream.Read(Buffer^, Stream.Size);

        { SENDING! }
        Result := WinSock.Send(Socket, Buffer^, Stream.Size, 0);
        if Result = SOCKET_ERROR then { process the error if occurs }
          SocketError(Socket, WSAGetLastError);
      finally
        { release memory taken for buffer }
        FreeMem(Buffer);
      end;  
    finally
      { restore position in stream }
      Stream.Seek(SavePosition, soFromBeginning);
    end;  
   end;
end;

function TCustomSimpleSocket.ReceiveFrom(Socket: TSocket; Buffer: PChar; BufLength: Integer; ReceiveCompletely: Boolean): Integer;
var
  p: Pointer;
  DataAvail: LongInt;
begin
  Result := recv(Socket, Buffer^, BufLength, 0);
  if Result = SOCKET_ERROR then
   begin
    SocketError(Socket, WSAGetLastError);
    Exit;
   end;

  if ReceiveCompletely then
   while Result < BufLength do
    begin
     if IoctlSocket(Socket, FIONREAD, DataAvail) = SOCKET_ERROR then
      begin
       SocketError(Socket, WSAGetLastError);
       Exit;
      end;
     if DataAvail = 0 then Continue;

     p := Pointer(Integer(Buffer) + Result);
     DataAvail := recv(Socket, p^, BufLength - Result, 0);
     if DataAvail = SOCKET_ERROR then
      begin
       SocketError(Socket, WSAGetLastError);
       Exit;
      end;
     inc(Result, DataAvail);
    end;
end;

function  TCustomSimpleSocket.ReceiveStreamFrom(Socket: TSocket; Stream: TStream; DataSize: Integer; ReceiveCompletely: Boolean): Integer;
var
  Buf: Pointer;
begin
  Result := 0;
  if DataSize <= 0 then Exit;
  
  GetMem(Buf, DataSize);
  try
    Result := ReceiveFrom(Socket, Buf, DataSize, ReceiveCompletely);
    if Result <> 0 then
      Stream.Write(Buf^, Result);
  finally
    FreeMem(Buf);
  end;
end;
{------------------------------------------------------------}

{ TSimpleTCPServer }
constructor TSimpleTCPServer.Create(aOwner: TComponent);
begin
  inherited Create(aOwner);
  FConnections := TList.Create;
end;

destructor TSimpleTCPServer.Destroy;
begin
  Listen := False;  // cancel listening

  FConnections.Free;
  inherited Destroy;
end;

procedure TSimpleTCPServer.SocketError(Socket: TSocket; ErrorCode: Integer);
begin
  Listen := true;  // cancel listening
  inherited;
end;

procedure TSimpleTCPServer.DoAccept;
var
  Tmp: Integer;
  tmpSocket: TSocket;
  tmpTCPClient: TSimpleTCPClient;
  IsAccept: Boolean;
begin
  Tmp := SizeOf(SockAddrIn);
  {$IFNDEF D3}
  tmpSocket := WinSock.Accept(FSocket, SockAddrIn, Tmp);
  {$ELSE}
  tmpSocket := WinSock.Accept(FSocket, @SockAddrIn, @Tmp);
  {$ENDIF}
  if tmpSocket = SOCKET_ERROR then
    SocketError(tmpSocket, WSAGetLastError);

{$WARNINGS OFF}
  tmpTCPClient := TSimpleTCPClient.Create(nil);
{$WARNINGS ON}
  tmpTCPClient.FSocket := tmpSocket;
  tmpTCPClient.FHost := inet_ntoa(SockAddrIn.SIn_Addr);
  tmpTCPClient.FPort := FPort;
  tmpTCPClient.FConnected := True;

  if Assigned(FOnAccept) then
   begin
    IsAccept := True;
    FOnAccept(Self, tmpTCPClient, IsAccept);
    if IsAccept then
      Connections.Add(tmpTCPClient)
    else
      tmpTCPClient.Free;
   end
  else
   Connections.Add(tmpTCPClient);

  if Assigned(FOnClientConnected) then
    FOnClientConnected(Self, tmpTCPClient);
end;

procedure TSimpleTCPServer.DoClose(Socket: TSocket);
var
  I: Integer;
  tmpTCPClient: TSimpleTCPClient;
begin
  tmpTCPClient := nil;
  I := FConnections.Count;
  if I <> 0 then
   for I := 0 to I - 1 do
    begin
     tmpTCPClient := FConnections[I];
     if tmpTCPClient.FSocket = Socket then
      begin
       FConnections.Delete(I);
       Break;
      end;
    end;

  if Assigned(tmpTCPClient) then
   begin
    if Assigned(FOnClientDisconnected) and not (csDestroying in ComponentState) then
      FOnClientDisconnected(Self, tmpTCPClient);
      
    tmpTCPClient.Free;
   end;
end;

procedure TSimpleTCPServer.DoDataAvailable(Client: TSimpleTCPClient; DataSize: Integer; var Handled: Boolean);
begin
  Handled := Assigned(FOnClientDataAvailable);
  if Handled then
    FOnClientDataAvailable(Self, Client, DataSize);
end;

procedure TSimpleTCPServer.DoRead(Client: TSimpleTCPClient; Stream: TStream);
begin
  if Assigned(FOnClientRead) then
    FOnClientRead(Self, Client, Stream);
end;

function TSimpleTCPServer.Send(Client: TSimpleTCPClient; Buffer: PChar; BufLength: Integer): Integer; // bytes sent
begin
  Result := SendBufferTo(Client.Socket, Buffer, BufLength);
end;

function  TSimpleTCPServer.SendStream(Client: TSimpleTCPClient; Stream: TStream): Integer; // returns N of bytes sent
begin
  Result := SendStreamTo(Client.FSocket, Stream);
end;

procedure TSimpleTCPServer.Broadcast(Buffer: PChar; BufLength: Integer);
var
  I: Integer;
begin
  I := FConnections.Count;
  if I <> 0 then
   for I := 0 to I - 1 do
    with TSimpleTCPClient(FConnections[I]) do
     SendBufferTo(FSocket, Buffer, BufLength);
end;

procedure TSimpleTCPServer.BroadcastStream(Stream: TStream);
var
  I: Integer;
begin
  I := FConnections.Count;
  if I <> 0 then
   for I := 0 to I - 1 do
    with TSimpleTCPClient(FConnections[I]) do
     SendStreamTo(FSocket, Stream);
end;

function TSimpleTCPServer.Receive(Client: TSimpleTCPClient; Buffer: PChar; BufLength: Integer; ReceiveCompletely: Boolean): Integer;
begin
  Result := ReceiveFrom(Client.FSocket, Buffer, BufLength, ReceiveCompletely);
end;

function TSimpleTCPServer.ReceiveStream(Client: TSimpleTCPClient; Stream: TStream; DataSize: Integer; ReceiveCompletely: Boolean): Integer;
begin
  Result := ReceiveStreamFrom(Client.FSocket, Stream, DataSize, ReceiveCompletely);
end;