关于WINSOCK API 学习DEMO

本人在学习WINSOCK的过程中，存在很多问题及不解的地方，写这个DEMO目的在于发上来让高手帮手指点一下，因为里面我用自定义协议方式进行通迅，没有用到异步I/O，但我好像在哪本书上看过，如果没有指定I/O模型，会默认选中选择I/O，不知对否。下面将代码贴上，共同学习，共同进步。该DEMO完成了一个简单的类似聊天室功能。里面感有些逻辑写复杂了，记得指点。呵呵。

 

uCommon.pas

 

unit uCommon;

interface

Const
   MAXSTRBUF=4096;//8192

   CLIENTOUTLINE='OUTONLINE';//User OutonLine
   CONNECTSUCCESS='SUCCESS';//user Connect
   LOGIN='USERLOGIN';//User inonLine
   LOGINSUCCESS='LOGINSUCCESS';
   GETUSERLIST='GETUSERLIST';
   ADDUSER='ADDUSER'; //to notice other user when an user online .
   DELUSER='DELUSER'; //to notice other user when an user outline .
   SERVOUT='SERVOUT';//Service OutOnline
   REFRESHUSER='REFRESHUSER';
   CLOSEUSER='CLOSEUSER'; //Detele an user from service .
   NEEDTRANSTOSPCUSER='NEEDTRANSTOSPCUSER'; //you can use the const when user use point to point comminute .

  
   UAUSLLYMSG='UMSG';

   type
      TMsgStruct=Packed Record
         MsgHead:Array[0..20] of Char;
         MsgText:Array[0..MAXSTRBUF] of Char;
         SendFromUser:Array[0..20] of Char;//Send Object
         RecvToUser:Array[0..20] of Char;//Recevie object
      end;

implementation

end.

 

 

Client:

 

 

unit Unit1;
{
     Client.Exe

     Use winsock api to write inter communicate .

     it is not use anyone component.

     if you thing to study Socket. i want to this demo very good.

     But there are a lot of bugs. And not use asynchronism I/O.

     Default use selected I/O.

     Anthor:Fengsh998
     QQ:19985430
}
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, winSock, StdCtrls,uCommon, Buttons;

Const
   Names:array [0..5] of String=('张三','李四','王五','陈六','贾宝','黛玉');
type

  TReadInfo=Class;
  TForm1 = class(TForm)
    Button1: TButton;
    Button3: TButton;
    Edit1: TEdit;
    ListBox1: TListBox;
    Memo1: TMemo;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button3Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    SendAndRecSock:TSocket;
    RI:TReadInfo;
    ServiceIP:String;
    procedure ReadServiceInfo(S: TSocket);
    procedure initWSA;
    procedure ClearWSA;

    procedure ConnectServic;
    procedure ToNoticeOutLine;
    procedure CloseClientSock;
    function SendMsg(S:TSocket;Msg:String;MsgType:String=UAUSLLYMSG;ToWhos:String=''):Integer;
  public
    { Public declarations }
  end;

  TReadInfo=Class(TThread)
     Private
       frm: TForm1;
       sk:TSocket;
     protected
       procedure Execute;override;
     public
       Constructor Create(afrm:TForm1;aClientScok:TSocket);
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
   ServiceIP:=inputbox('提示','请输入服务端IP','192.168.10.4');
   if ServiceIP=EmptyStr then Exit;

   ConnectServic;
   RI:=TReadInfo.Create(self,SendAndRecSock);
   RI.FreeOnTerminate:=True;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
   idx:integer;
begin
   idx:=ListBox1.ItemIndex;
   if idx<>-1 then
   begin
      SendMsg(SendAndRecSock,Trim(Edit1.Text),NEEDTRANSTOSPCUSER,ListBox1.Items[idx]);
      Memo1.Lines.Add('我对'+ListBox1.Items[idx]+'说： '+DateTimeToStr(Now));
      Memo1.Lines.Add(Trim(Edit1.Text));
   end
   else
   begin
      SendMsg(SendAndRecSock,Trim(Edit1.Text));
      Memo1.Lines.Add('刚我骂管理员了!'+DateTimeToStr(Now));
   end;

   Edit1.Clear;
end;

procedure TForm1.ClearWSA;
begin
  if WSACleanup<>0 then
     Raise Exception.Create('Clean winsock fail!');
end;

procedure TForm1.CloseClientSock;
begin
   if Assigned(RI) then
     RI.Terminate;

   if SendAndRecSock<>INVALID_SOCKET then
      CloseSocket(SendAndRecSock);
end;

procedure TForm1.ConnectServic;
var
   ClientAddr:TSockAddr;
begin
   //Create Send or Receive Socket
   SendAndRecSock := Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);
   if SendAndRecSock=INVALID_SOCKET then
       Raise Exception.Create('Create Send Socket Fails!');

   //Set Connect Addr
   ClientAddr.sin_family := AF_INET;
   ClientAddr.sin_port :=Htons(9527);
   ClientAddr.sin_addr.S_addr:=inet_addr(Pchar(ServiceIP));

   if Connect(SendAndRecSock,ClientAddr,Sizeof(TSockAddr))=SOCKET_ERROR then
       Raise Exception.Create('Connect Fails!');
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  ToNoticeOutLine;
  CloseClientSock;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
    initWSA;
    Randomize;
    Label2.Caption:=Names[Random(6)];
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   ClearWSA;
end;

procedure TForm1.initWSA;
var
   WasDt:TWSAData;
begin
  if WSAStartup($0202,WasDt)<>0 then
     Raise Exception.Create('Start winsock fail!');
end;

function TForm1.SendMsg(S: TSocket; Msg: String;MsgType:String;ToWhos:String): Integer;
var
    Msgt:TMsgStruct;
begin
    strpCopy(Msgt.MsgHead,MsgType);
    strPcopy(Msgt.MsgText,Msg);
    strPcopy(Msgt.SendFromUser,Label2.Caption);
    strPcopy(Msgt.RecvToUser,ToWhos);
    Result:=Send(S,Msgt,SizeOf(TMsgStruct),0);
end;

procedure TForm1.ToNoticeOutLine;
begin
   if SendAndRecSock<>INVALID_SOCKET then
      SendMsg(SendAndRecSock,'',CLIENTOUTLINE);

   //please attention to wait Cpu to Completed.
   sleep(200);
end;

procedure TForm1.ReadServiceInfo(S:TSocket);
var
   Msg:String;
   Mt:String;
   Msgt:TMsgStruct;
   iRet:Integer;
begin
     FillChar(Msgt,SizeOf(TMsgStruct),0);
     iRet:= Recv(S,Msgt,Sizeof(Msgt),0);
     if iRet=0 then Exit;
     if SOCKET_ERROR<>iRet then
     begin
      Msg:=Msgt.MsgText;
      Mt:=Msgt.MsgHead;
      if Mt=CONNECTSUCCESS then
      begin
         SendMsg(S,Label2.Caption,LOGIN);
         Memo1.Lines.Add(Msg);
         //Connect Success Disable.
         Button1.Enabled:=False;
      end
      else  if Mt=SERVOUT then
      begin
          Memo1.Lines.Add(Msg);
          CloseClientSock;
          ListBox1.Items.Clear;
          Button1.Enabled:=True;
      end
      else if ADDUSER=mt then
      begin
          ListBox1.Items.Add(Msg);
          Memo1.Lines.Add(DateTimeToStr(Now)+' 【'+Msg+'】上线了');
      end
      else if LOGINSUCCESS=Mt then
      begin
         Memo1.Lines.Add(Msg);
         SendMsg(S,'',GETUSERLIST);
      end
      else if REFRESHUSER=Mt then
      begin
         ListBox1.Items.Clear;
         ListBox1.Items.CommaText:=Msg;

         //To Delete Self
         iRet:= ListBox1.Items.IndexOf(Label2.Caption);
         if iRet<>-1 then
            ListBox1.Items.Delete(iRet);
      end
      else if CLIENTOUTLINE=Mt then
      begin
         iRet:= ListBox1.Items.IndexOf(Msg);
         if iRet<>-1 then
         begin
            ListBox1.Items.Delete(iRet);
            Memo1.Lines.Add(DateTimeToStr(Now)+' 【'+Msg+'】下线了');
         end;
      end
      else
         Memo1.Lines.Add(Msg);
    end;
end;

{ TReadInfo }

constructor TReadInfo.Create(afrm: TForm1; aClientScok: TSocket);
begin
    frm:=afrm;
    sk:=aClientScok;
    inherited Create(False);
end;

procedure TReadInfo.Execute;
begin
     while not Terminated do
        frm.ReadServiceInfo(sk);
end;

end.

 

 

Server:

 

unit Unit1;
{
     Server.Exe

     Use winsock api to write inter communicate .

     it is not use anyone component.

     if you thing to study Socket. i want to this demo very good.

     But there are a lot of bugs. And not use asynchronism I/O.

     Default use selected I/O.

     Anthor:Fengsh998
     QQ:19985430
}

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, winsock, StdCtrls,uCommon;

type

  TForm1=Class;

  TChkConncet=Class(TThread)
     private
       frm: TForm1;
     protected
       procedure Execute;override;
     public
       Constructor Create(afrm:TForm1);
  end;

  TReadInfo=Class(TThread)
     Private
       frm: TForm1;
       sk:TSocket;
     protected
       procedure Execute;override;
     public
       Constructor Create(afrm:TForm1;aClientScok:TSocket);
  end;

  TClientSockTable=Packed Record
      iSocket:integer;
      iIp:String[20];
      ReadInfoTdPointer:Pointer;
      UserName:Array[0..255] of Char; //please userId ,you can sure same name exsist .
  end;

  TCSTables=Array of TClientSockTable;

  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    ListBox1: TListBox;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    rbOne: TRadioButton;
    rbAll: TRadioButton;
    Button4: TButton;
    CheckBox1: TCheckBox;
    procedure Button4Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    ListSock:TSocket;
    ClientSock:TSocket;
    Ckc:TChkConncet;
    RI:TReadInfo;
    Cstbs:TCSTables;
    procedure initWSA;
    procedure ClearWSA;

    procedure StartListen;
    procedure StartChkConn;
    function StratReadInfo(S:TSocket):Pointer;
    procedure CloseListenSocket;
    procedure ChkClientConn;
    procedure ReadClientInfo(S:TSocket);

    function SendMsg(S:TSocket;Msg:String;MsgType:String=UAUSLLYMSG):Integer;

    procedure BroadCastToOtherClient(OutSock:TSocket;Msgtext:String;BcEvent:String);

    function IndexOfSocket(Sock:TSocket):Integer;
    procedure DeleteSocket(index:integer);
    function GetSocket(UserName:String):TSocket;
    procedure CleanSockAndTd;

    procedure beforeDestroy;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TForm1 }

//to tell other client
procedure TForm1.beforeDestroy;
begin
   try
     //here ,it is has problem ,wher more users .
     BroadCastToOtherClient(0,'Service Manager Send:  '+DateTimeToStr(Now)+#$D#$A+'Serice had OutLine !',SERVOUT);
     sleep(200);
     CleanSockAndTd;
     sleep(200);
     CloseListenSocket;
   Except
      ;
   end;
end;

procedure TForm1.BroadCastToOtherClient(OutSock:TSocket;Msgtext:String;BcEvent:String);
var
   i:integer;
begin
   if OutSock>0 then
   begin
      for i := Low(Cstbs) to High(Cstbs) do
         if Cstbs[i].iSocket<>OutSock then
            SendMsg(Cstbs[i].iSocket,Msgtext,BcEvent);
   end
   else
   begin
      for i := Low(Cstbs) to High(Cstbs) do
        SendMsg(Cstbs[i].iSocket,Msgtext,BcEvent);
   end;
end;

procedure TForm1.ReadClientInfo(S:TSocket);
var
   idx:Integer;
   Msg:String;
   Mt:String;
   Msgt:TMsgStruct;
   iRet:Integer;
   revUsr,tmp:String;
begin
      FillChar(Msgt,SizeOf(TMsgStruct),0);
      iRet:=Recv(S,Msgt,Sizeof(Msgt),0);

      if iRet=0 then Exit;

      if SOCKET_ERROR<>iRet then
      begin
         Msg:=Msgt.MsgText;
         Mt:=Msgt.MsgHead;

         if Mt=CLIENTOUTLINE then
         begin
            idx:=IndexOfSocket(S);
            if idx<>-1 then
            begin
               BroadCastToOtherClient(S,Cstbs[idx].UserName,CLIENTOUTLINE);
               ListBox1.Items.Delete(ListBox1.Items.IndexOf(Cstbs[idx].UserName));
               Memo1.Lines.Add(DateTimeToStr(Now)+' 【'+Cstbs[idx].UserName+'】下线了');

               //To Stop thread .
               TReadInfo(Cstbs[idx].ReadInfoTdPointer).Terminate;
               //del from array .
               DeleteSocket(idx);
            end;
         end
         else if Mt=LOGIN then //Login
          begin
             idx:=IndexOfSocket(S);
             if idx<>-1 then
             begin
                strPcopy(Cstbs[idx].UserName,Msg);
                ListBox1.Items.Add(Msg);
                Memo1.Lines.Add(DateTimeToStr(Now)+' 【'+Msg+'】上线了');
             end;
             SendMsg(S,'Service Manager Send:  '+DateTimeToStr(Now)+#$D#$A+'You has Connected to Service !',LOGINSUCCESS);

             //to notice All user
             BroadCastToOtherClient(S,Msg,ADDUSER);
          end
          else if mt=GETUSERLIST then
          begin
             if ListBox1.Items.Count>0 then
                SendMsg(S,ListBox1.Items.CommaText,REFRESHUSER);
          end
          else if Mt=NEEDTRANSTOSPCUSER then //Transation to espaceially user.
          begin
              revUsr :=Msgt.RecvToUser;
              //Get Recevie user socket
              idx:=GetSocket(revUsr);
              if idx<>-1 then
              begin
                 tmp:=String(Msgt.SendFromUser)+':  '+DateTimeToStr(Now)+#$D#$A+ Msg;
                 SendMsg(idx,tmp);
                 if CheckBox1.Checked then
                    Memo1.Lines.Add(String(Msgt.SendFromUser)+' 对 '+revUsr+' 说：'+DateTimeToStr(Now)+#$D#$A+ Msg);
              end;
          end
          else
            begin
               idx:=IndexOfSocket(S);
               if idx<>-1 then
                  Memo1.Lines.Add(String(Cstbs[idx].UserName)+':  '+DateTimeToStr(Now));

               Memo1.Lines.Add(Msg);
            end;
     end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
   StartListen;
   StartChkConn;
   Button1.Enabled:=False;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
   idx:integer;
begin
   if rbOne.Checked then
   begin
     idx:=ListBox1.ItemIndex;
     if idx<>-1 then
     begin
        idx:=GetSocket(trim(ListBox1.Items[idx]));
        if idx<>-1 then
           SendMsg(idx,'Service Manager Send:  '+DateTimeToStr(Now)+#$D#$A+Trim(Edit1.Text));
     end;
   end
   else
      BroadCastToOtherClient(0,'Service Manager Send:  '+DateTimeToStr(Now)+#$D#$A+Trim(Edit1.Text),UAUSLLYMSG);

   Edit1.Clear;
end;

procedure TForm1.ChkClientConn;
var
   iLen:Integer;
   ClientAddr:TSockAddr;
   iSize:Integer;
begin
   //To do Waiting for a client connection.
     iLen := SizeOf(TSockAddr);

     ClientSock :=Accept(ListSock,@ClientAddr,@iLen);

     if ClientSock<>INVALID_SOCKET then
     begin
         iSize:=Length(Cstbs);
         SetLength(Cstbs,iSize+1);
         Cstbs[iSize].iSocket:= ClientSock;
         Cstbs[iSize].iIp:=inet_ntoa(ClientAddr.sin_addr);

         //Create one thread to recevie client information
         Cstbs[iSize].ReadInfoTdPointer:=StratReadInfo(ClientSock);
         //to Tell Client Connect success
         SendMsg(ClientSock,EmptyStr,CONNECTSUCCESS);
     end;
end;

procedure TForm1.CleanSockAndTd;
var
   i:integer;
begin
    for i := Low(Cstbs) to High(Cstbs) do
        TReadInfo(Cstbs[i].ReadInfoTdPointer).Terminate;
    SetLength(Cstbs,0);
end;

procedure TForm1.ClearWSA;
begin
  if WSACleanup<>0 then
     Raise Exception.Create('Clean winsock fail!');
end;

procedure TForm1.CloseListenSocket;
begin
   if Assigned(Ckc) then
      Ckc.Terminate;

   if ListSock<>INVALID_SOCKET then
      CloseSocket(ListSock);
end;

procedure TForm1.DeleteSocket(index: integer);
var
   i:integer;
begin
   for i := index to High(Cstbs)-1 do
       Cstbs[i]:=Cstbs[i+1];

   SetLength(Cstbs,Length(Cstbs)-1);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
   initWSA;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
   beforeDestroy;
   sleep(200);
   ClearWSA;
end;

function TForm1.GetSocket(UserName: String): TSocket;
var
   i:integer;
begin
    Result:=-1;
    for i := Low(Cstbs) to High(Cstbs) do
      if Cstbs[i].UserName=UserName then
      begin
         Result:=Cstbs[i].iSocket;
         break;
      end;
end;

function TForm1.IndexOfSocket(Sock: TSocket): Integer;
var
   i:integer;
begin
   Result:=-1;
   for i := Low(Cstbs) to High(Cstbs) do
       if Cstbs[i].iSocket=Sock then
       begin
          Result:=i;
          Break;
       end;
end;

procedure TForm1.initWSA;
var
   WasDt:TWSAData;
begin
  if WSAStartup($0202,WasDt)<>0 then
     Raise Exception.Create('Start winsock fail!');
end;

function TForm1.SendMsg(S: TSocket; Msg: String;MsgType:String): Integer;
var
   Msgt:TMsgStruct;
begin
    strpCopy(Msgt.MsgHead,MsgType);
    strPcopy(Msgt.MsgText,Msg);
    Result:=Send(S,Msgt,SizeOf(TMsgStruct),0);
end;

procedure TForm1.StartChkConn;
begin
   Ckc:=TChkConncet.Create(self);
   Ckc.FreeOnTerminate:=True;
end;

procedure TForm1.StartListen;
var
   ServiceAddr:TSockAddr;
begin
   //Create Listen Socket
   ListSock :=Socket(AF_INET,SOCK_STREAM,IPPROTO_TCP);

   if ListSock=INVALID_SOCKET then
      Raise Exception.Create('Create Listen Socket Fails!');

   //Set Service Address
   ServiceAddr.sin_family :=AF_INET;
   ServiceAddr.sin_port := Htons(9527);
   ServiceAddr.sin_addr.S_addr := INADDR_ANY;//every one net address

   //Bind Listen Socket
   if Bind(ListSock,ServiceAddr,SizeOf(TSockAddr))=SOCKET_ERROR then
      Raise Exception.Create('Bind Listen Socket Fails!');

   //To do listening....
   if Listen(ListSock,5)=SOCKET_ERROR then
      Raise Exception.Create('Listen Socket Fails!');
end;

function TForm1.StratReadInfo(S:TSocket):Pointer;
begin
   RI:=TReadInfo.Create(self,S);
   RI.FreeOnTerminate:=True;
   Result:=RI;
end;

{ TChkConncet }

constructor TChkConncet.Create(afrm: TForm1);
begin
    frm:=afrm;
    inherited Create(False);
end;

procedure TChkConncet.Execute;
begin
    while not Terminated do
       frm.ChkClientConn;
end;

{ TReadInfo }

constructor TReadInfo.Create(afrm: TForm1;aClientScok:TSocket);
begin
    frm:=afrm;
    sk:=aClientScok;
    inherited Create(False);
end;

procedure TReadInfo.Execute;
begin
   while not Terminated do
      frm.ReadClientInfo(sk);
end;

end.