mysock.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

Begin
   If FSocket = INVALID_SOCKET Then
      FConnected := False;
   Result := FConnected;
End;

Function TClientSock.GetRemoteHost : String;
Begin
   Result := INet_NToA(FRecvAddrIn.SIn_Addr);
End;

Constructor TClientSock.Create(AOwner : TComponent);
Begin
   Inherited Create(AOwner);
   FHostName := '';
   FPortName := '';
   FSocket := INVALID_SOCKET;
   FInBuffer := '';
   FOutBuffer := '';
   FBlocking := False;
   FConnected := False;
End;

// This Constructor Assumes NewSocket Is A Valid Socket Handle

Constructor TClientSock.CreateWithSocket(AOwner : TComponent; NewSocket : TSocket);
Begin
   Create(nil);
   FSocket := NewSocket;
   FConnected := True;
   WinSock.WSAAsyncSelect(FSocket, Handle, WM_SOCK, FD_READ Or FD_CLOSE Or FD_CONNECT Or FD_WRITE);
End;

Destructor TClientSock.Destroy;
Begin
   If FConnected Then Close;
   Inherited Destroy;
End;

Procedure TClientSock.Loaded;
Begin
   If Not (csDesigning In ComponentState) Then
      Begin
         SetBlocking(FBlocking);
      End;
End;


Procedure TClientSock.OnSockMessage(Var Message : TMessage);
Var Event : Word;
    Error : Word;
    Res   : Integer;
Begin
   // Message Handling For Non-Blocking Sockets
   Event := WinSock.WSAGetSelectEvent(Message.LParam);
   Error := WinSock.WSAGetSelectError(Message.LParam);
   If Error > WSABASEERR Then
      exit
   Else
      // Messages Mean Different Things Depending On Whether You're Listening Or Not
      Case Event Of
         FD_CONNECT : Begin
                         FConnected := True;
                         If Assigned(FOnConnect) Then
                            FOnConnect(Self);
                      End;
         FD_CLOSE   : Begin
                         If Assigned(FOnDisconnect) Then
                            FOnDisconnect(Self);
                         Close;
                      End;
         FD_READ    : Begin
                        Res := WinSock.Recv(FSocket, FCharBuf, SizeOf(FCharBuf), 0);
                        If Res > 0 Then
                          FInBuffer := FInBuffer + Copy(FCharBuf, 1, Res);
                        If Assigned(FOnRead) Then FOnRead(Self, Length(FInBuffer));
                      End;
         FD_WRITE   : Begin
                         If FOutBuffer <> '' Then
                            Send('');
                         If Assigned(FOnWrite) Then
                            FOnWrite(Self);
                      End;
   else
     Message.Result := DefWindowProc(Handle, Message.Msg, message.Wparam, Message.Lparam);
   end;
End;

Function TClientSock.Open : Boolean;
Var Res : Integer;
Begin
   If FSocket = INVALID_SOCKET Then
      Begin
         FSocket := WinSock.Socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
         FSockAddrIn.SIn_Family := AF_INET;
         FSockAddrIn.SIn_Port := PortLookup(FPortName);
         FSockAddrIn.SIn_Addr := HostLookup(FHostName);
         SetBlocking(FBlocking);
         Res := WinSock.Connect(FSocket, FSockAddrIn, SizeOf(TSockAddrIn));
         If FBlocking Then Begin
           If Res = 0 Then Begin
             FConnected := True;
             If Assigned(FOnConnect) Then FOnConnect(Self);
           End Else Begin
             Close;
           end;
         end;
       end;
    Result := FConnected;
  ProcessMessages;
End;

Function TClientSock.Close : Boolean;
Begin
   Result := (WinSock.CloseSocket(FSocket) = 0);
   FSocket := INVALID_SOCKET;
   FConnected := False;
//  ProcessMessages;
End;

Function TClientSock.Send(Value : String) : Boolean;
Var Remain : Integer;
Begin
  Result := True;
  If FSocket = INVALID_SOCKET Then
     Raise ESockException.Create('Send - Socket Not Connected');
  FOutBuffer := FOutBuffer + Value;
  If FOutBuffer = '' Then Exit;
  If FBlocking Then Begin
    Remain := Length(FOutBuffer);
    // While Any Content Remains Or No Errors Have Happened, Then Loop
    While Remain > 0 Do Begin
      Remain := WinSock.Send(FSocket, FOutBuffer[1], Length(FOutBuffer), 0);
      If (Remain = SOCKET_ERROR) And (WinSock.WSAGetLastError <> WSAEINPROGRESS) Then Begin
        Raise ESockException.Create('Send - Socket Error');
      End Else Begin
        If Remain > 0 Then
          Delete(FOutBuffer, 1, Remain);
        Remain := Length(FOutBuffer);
      End;
    End;
    FOutBuffer := '';
  End Else Begin
     // Do Not Loop For A Non-Blocking Socket
     Remain := WinSock.Send(FSocket, FOutBuffer[1], Length(FOutBuffer), 0);
     If Remain > 0 Then Delete(FOutBuffer, 1, Remain);
  End;
  ProcessMessages;
End;

Function TClientSock.Receive : String;
Begin
   Result := ReceiveCount(-1);
End;

Function TClientSock.ReceiveCount(Count : Integer) : String;
Var Res   : Integer;
    FDSet : PFDSet;
    TV    : PTimeVal;
    Err   : Integer;
    Cnt   : Integer;
Begin
  ProcessMessages;
   If (FSocket = INVALID_SOCKET) And (FInBuffer = '') Then
      Raise ESockException.Create('Receive - Socket Not Connected');
   Cnt := Count;
   If (Cnt = -1) Or (Cnt > SizeOf(FCharBuf)) Then
      Cnt := SizeOf(FCharBuf);
   If FBlocking Then Begin
     FDSet := New(PFDSet);
     FDSet^.FD_Count := 1;
     FDSet^.FD_Array[0] := FSocket;
     If FBlockTime >= 0 Then Begin
       TV := New(PTimeVal);
       TV^.tv_sec := FBlockTime;
     End Else
       TV := Nil;
     // Used To Loop While We're Connected And Anything Is In The Input Queue
     If FConnected And (WinSock.Select(FSocket, FDSet, Nil, Nil, TV) > 0) Then Begin
       Res := WinSock.Recv(FSocket, FCharBuf, Cnt, 0);
       If (Res = SOCKET_ERROR) Then Begin
         Err := WSAGetLastError;
         Result := '';
         FInBuffer := '';
         Dispose(FDSet);
         Dispose(TV);
         Raise ESockException.Create('Receive - Socket Error '+ErrToStr(Err));
       End Else Begin
         If Res > 0 Then
           FInBuffer := FInBuffer + Copy(FCharBuf, 1, Res)
         Else
           If Res = 0 Then Begin
             Close;
             If Assigned(FOnDisconnect) Then
               FOnDisconnect(Self);
           End;
        End;
       End;
       Result := FInBuffer;
       FInBuffer := '';
       Dispose(FDSet);
       Dispose(TV);
     End Else Begin
       // non-blocking
       If((Count<>-1) And (Length(FInBuffer)>Count)) Then Begin
         Result := Copy(FInBuffer, 1, Count);
         Delete(FInBuffer, 1, Count);
       End Else Begin
         Result := FInBuffer;
         FInBuffer := '';
       End;
     End;
  ProcessMessages;
End;



Function TClientSock.HostLookup(Value : String) : TInAddr;
Type PLongInt = ^LongInt;
Var PHost : PHostEnt;
    Res   : Integer;
Begin
   If Value = '' Then
      Exit;
   FillChar(Result, SizeOf(TInAddr), #0);
   If Pos(Value[1],'0123456789') > 0 Then
      // If It's Dot-Notation, Just Convert It From An IP Address
      Result := TInAddr(WinSock.Inet_Addr(PChar(Value)))
   Else
      Begin
         Res := IPCache.IndexOf(Value);
         If Res >= 0 Then
            // It's Cached... Don't Bother Doing A Lookup
            Result.S_Addr := U_Long(IPCache.Objects[Res])
         Else
            Begin
               // Isn't Cached, Have To Do A GetHostByName
               If Value <> '' Then
                  Begin
                     PHost := WinSock.GetHostByName(PChar(Value));
                     If PHost <> Nil Then
                        Begin
                           Result.S_Addr := LongInt(PLongInt(PHost^.H_Addr_List^)^);
                           IPCache.AddObject(Value, Pointer(Result.S_Addr));
                        End
                     Else
                        Raise ESockException.Create('Host Lookup - Could Not Find Host Entry');
                  End
               Else
                  Result.S_Addr := HToNL(INADDR_ANY);
            End;
      End;
End;

Function TClientSock.PortLookup(Value : String) : U_Short;
Var PEnt : PServEnt;
Begin
   If Pos(Value[1],'0123456789') > 0 Then
      // It's Numeric, Just Convert It To A Network Byte Order Integer
      Result := HToNS(StrToInt(Value))
   Else
      Begin
         // Otherwise, Perform A GetServByName Based On The Protocol
         PEnt := WinSock.GetServByName(PChar(Value), 'tpc');
         If PEnt <> Nil Then
            Result := PEnt^.S_Port
         Else
            Raise ESockException.Create('Port Lookup - Could Not Find Service Entry');
      End;
End;

// TCustomServerSock

Procedure TCustomServerSock.SetPortName(Value : String);
Begin
   if (csLoading in Componentstate) then begin
     fportname:= value;
     exit;
   end;
   If factive Then
     raise ESockException.Create('Can''t change portname while active');
   FPortName := Value;
End;

function TCustomServerSock.GetClientCount : Integer;
begin
  with FClientlist.locklist do result:=count;
  FClientlist.Unlocklist;
end;

Function TCustomServerSock.Close : Boolean;
Begin
   Result := (WinSock.CloseSocket(FSocket) = 0);
   FSocket := INVALID_SOCKET;
   FActive := False;
  ProcessMessages;
End;
Procedure TCustomServerSock.SetListen(Value : Boolean);
Var WasListen : Boolean;
    Addr      : TSockAddr;
    Res       : Integer;
    I         : Integer;
    LockList  : TList;

Begin
   If (csDesigning In ComponentState) Then
      Begin
         Factive := Value;
         exit;
      End
   Else
      If (csReading In ComponentState) Then
         Begin
            // If We Haven't Loaded Yet, Just Set The Value And Exit
            FActive := Value;
            Exit;
         End;
   WasListen := FActive;
   If (FSocket <> INVALID_SOCKET) And (Not WasListen) Then
      Begin
         FActive := False;
         Raise ESockException.Create('Listen - Socket Already In Use');
      End;
   Factive := Value;
   If Factive Then
      Begin
         If Not WasListen Then
            Begin
               // Have To Create A Socket Start Asynchronous Listening
               Factive := False;
               FSocket := WinSock.Socket(AF_INET, SOCK_STREAM, IPPROTO_IP);
               FillChar(Addr, SizeOf(Addr), #0);
               Addr.SIn_Family := AF_INET;
               Addr.SIn_Port := PortLookup(FPortName);
               Addr.SIn_Addr.S_Addr := HToNL(INADDR_ANY);
               WinSock.WSAAsyncSelect(FSocket, Handle, WM_SOCK, FD_ACCEPT);
               Res := WinSock.Bind(FSocket, Addr, SizeOf(Addr));
               If Res <> 0 Then
                  Raise ESockException.Create('Listen - Error Binding Socket');
               Res := WinSock.Listen(FSocket, 5);
               If Res <> 0 Then
                  Raise ESockException.Create('Listen - Error Starting Listen');
               Factive := True;
            End;
      End
   Else
      Begin
        locklist:=FClientList.LockList;
        for i:=0 to locklist.count-1 do begin
          TSockThread(Locklist[i]).ClientSock.FMustClose:=true;
        end;
        FClientlist.UnlockList;
        While GetClientCount>0 do begin
          sleep(10);