DELPHI TTcpServer控件使用实例

Accept事件

procedure TForm5.tcpsrvr1Accept(Sender: TObject; ClientSocket: TCustomIpClient);
var
 read:TServerClientSocket;
begin
 read:=TServerClientSocket.Create(ClientSocket);
 read.OnWellConnected:=OnContent;
 read.OnWellDisConnected:=OnContent;
 read.OnWellReadRecord:=OnReadData;
 read.exec;
 read.Free;
end;

数据接收线程类

unit TcpServerClientSocket;

interface
uses
  SysUtils,  Classes, Controls,DateUtils,
  IOUtils,ActiveX, Generics.Collections,SyncObjs,Sockets,Uni, DB, MemDS, DBAccess, SQLServerUniProvider,
  UniProvider, SQLiteUniProvider,LocalDataClass,BufClass, other,NetPack;
type
 TServerClientSocket=class
 private
   WellName:string;
   ClientSocket: TCustomIpClient;
   FOnWellConnected:TOnMyNetDataEvent;
   FOnWellDisConnected:TOnMyNetDataEvent;
   FOnWellReadRecord:TOnMyNetDataEvent;
 published
  property OnWellConnected:TOnMyNetDataEvent  read FOnWellConnected write FOnWellConnected;
  property OnWellDisConnected:TOnMyNetDataEvent  read FOnWellDisConnected write FOnWellDisConnected;
  property OnWellReadRecord:TOnMyNetDataEvent  read FOnWellReadRecord write FOnWellReadRecord;
 public
   constructor Create(ReadSocket: TCustomIpClient);
   procedure exec;
 end;
implementation

{ TMyClientSocket }

constructor TServerClientSocket.Create(ReadSocket: TCustomIpClient);
begin
 ClientSocket:=ReadSocket;

 WellName:='未知井';
end;

procedure TServerClientSocket.exec;
var
  FNetPack:TMyNetUNPack;
  ReadBuf:RMySendPack;
  ReadData:RSendContent;
  ReadSize:Integer;
  NetMsg:RMyNetMsg;
  Lock:TCriticalSection;
begin
 Lock:=TCriticalSection.Create;
   FNetPack:=TMyNetUNPack.Create;
    try
     ReadSize:=ClientSocket.ReceiveBuf(ReadBuf,SizeOf(RMySendPack));
    except
     ReadSize:=0
    end;

   if ReadSize=0 then
   begin
    ClientSocket.Disconnect;
   end
   else
    begin
       FNetPack.AddValue:=ReadBuf;
       if ReadBuf.ID=SEND_CONNECT then
       begin
         //发送连接信息
         WellName:=FNetPack.value;
         readdata.JH:=WellName;
         ReadData.PushTime:=now;
         Readdata.Content:='';
         if Assigned(OnWellConnected) then
         begin
          Lock.Enter;
          OnWellConnected(ReadData);
          Lock.Leave;
         end;
         NetMsg.star:=BUFREAD_OK;
         try
          ClientSocket.SendBuf(NetMsg,SizeOf(RMyNetMsg));
         except

         end;
       end
       else
       begin
        ClientSocket.Disconnect;
       end;
    end;
    while ClientSocket.Connected do
     begin
      try
       ReadSize:=ClientSocket.ReceiveBuf(ReadBuf,SizeOf(RMySendPack));
       if ReadSize<>SizeOf(RMySendPack) then
       begin
        ClientSocket.Disconnect;
        Break;
       end;
       FNetPack.AddValue:=ReadBuf;
       if ReadBuf.ID=SEND_CONNECT then
       begin
         //发送连接信息
         WellName:=FNetPack.value;
         readdata.JH:=WellName;
         ReadData.PushTime:=now;
         Readdata.Content:='';
         if Assigned(OnWellConnected) then
         begin
          Lock.Enter;
          OnWellConnected(ReadData);
          Lock.Leave;
         end;
       end;
       if ReadBuf.isEnd and (ReadBuf.ID=SEND_DATA) then
       begin
         readdata.JH:=WellName;
         ReadData.PushTime:=now;
         Readdata.Content:=FNetPack.value;
         if Assigned(OnWellReadRecord) then
         begin
          Lock.Enter;
          OnWellReadRecord(ReadData);
          Lock.Leave;
         end;
       end;

        NetMsg.star:=BUFREAD_OK;
        ReadSize:=ClientSocket.SendBuf(NetMsg,SizeOf(RMyNetMsg));
       if ReadSize<>SizeOf(RMyNetMsg) then
       begin
        ClientSocket.Disconnect;
        Break;
       end;

      except
       ClientSocket.Disconnect;
       Break;
      end;
     end;
     //发送断开信息
     readdata.JH:=WellName+'断开';
     ReadData.PushTime:=now;
     Readdata.Content:='';
     if Assigned(OnWellDisConnected) then
     begin
      Lock.Enter;
      OnWellDisConnected(ReadData);
      Lock.Leave;
     end;
    ClientSocket.Disconnect;
   FNetPack.Free;
   Lock.Free;
end;

end.