別人 delphi socket TServerSocket

unit   Unit_Server;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,  
      ComCtrls,   StdCtrls,   ScktComp,Winsock,   ExtCtrls;  
   
  type  
      TForm1   =   class(TForm)  
          Server:   TServerSocket;  
          m1:   TMemo;  
          S1:   TStatusBar;  
          btnSend:   TButton;  
          edtSend:   TEdit;  
          Label1:   TLabel;  
          Label2:   TLabel;  
          btnOneSend:   TButton;  
          Label3:   TLabel;  
          Label4:   TLabel;  
          Bevel1:   TBevel;  
          cbxID:   TComboBox;  
          procedure   ServerClientConnect(Sender:   TObject;  
              Socket:   TCustomWinSocket);  
          procedure   ServerClientRead(Sender:   TObject;   Socket:   TCustomWinSocket);  
          procedure   FormCreate(Sender:   TObject);  
          procedure   ServerAccept(Sender:   TObject;   Socket:   TCustomWinSocket);  
          procedure   ServerClientError(Sender:   TObject;   Socket:   TCustomWinSocket;  
              ErrorEvent:   TErrorEvent;   var   ErrorCode:   Integer);  
          procedure   btnSendClick(Sender:   TObject);  
          procedure   ServerClientDisconnect(Sender:   TObject;  
              Socket:   TCustomWinSocket);  
          procedure   btnOneSendClick(Sender:   TObject);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
  Type   UsrRec=Record  
                              SocketID:Integer;  
                              UsrName:string;  
                              Passwd:string;  
                              IP:string;  
                              ReceivingData:string;  
                              End;  
   
  var  
      Form1:   TForm1;  
      buf:string;  
      bEUserName,bEPasswd:Boolean;  
      Usr:^UsrRec;  
   
  implementation  
   
  {$R   *.DFM}  
   
  procedure   TForm1.ServerClientConnect(Sender:   TObject;  
      Socket:   TCustomWinSocket);  
  Var  
      strIp,strHost:string;  
      Count:Integer;  
  begin  
      strIp:=Socket.RemoteAddress;  
      strHost:=Socket.RemoteHost;  
      M1.Lines.Add('SomeOne   Login   From');  
      M1.Lines.add(#9'SocketID:'+Inttostr(Socket.SocketHandle));  
      cbxID.Items.Add(Inttostr(Socket.SocketHandle));  
      M1.lines.add(#9'IP:'+strIp);  
      M1.Lines.Add(#9'Host:'+strHost);  
      Count:=Server.Socket.ActiveConnections;  
      S1.Panels.Items[1].Text:='OnLine   user:   '+IntToStr(Count);  
  end;  
   
  procedure   TForm1.ServerClientRead(Sender:   TObject;  
      Socket:   TCustomWinSocket);  
  var  
      p:pchar;  
      length:longint;  
      Count,i:Integer;  
  begin  
          p:=nil;  
          while   socket.ReceiveLength>0   do   begin  
                  length:=socket.receivelength;  
                  Getmem(p,length);  
                  TRY  
                          socket.ReceiveBuf(p^,socket.receivelength);  
                          Count:=Server.Socket.ActiveConnections;  
                          for   i:=0   to   Count-1   do  
                                  Server.Socket.Connections[i].SendBuf(p^,length);  
                  FINALLY  
                          FreeMem(p);  
                  END;  
          end;  
  end;  
   
  procedure   TForm1.FormCreate(Sender:   TObject);  
  begin  
          //start   server   when   application   run  
          Server.Active:=true;  
          S1.Panels.Items[0].Text:='Server   Starts.   Host:'+Server.Socket.LocalHost+'     Port:'+inttostr(Server.Port);  
          self.Caption:=S1.Panels.Items[0].Text;  
          Application.Title:=S1.Panels.Items[0].Text;  
          S1.Panels.Items[1].Text:='OnLine   user   Count:   '+IntToStr(Server.Socket.ActiveConnections);  
  end;  
   
  procedure   TForm1.ServerAccept(Sender:   TObject;   Socket:   TCustomWinSocket);  
  var  
      Tempstr:pchar;  
  begin  
          TempStr:=pchar('Welcome   To   Chat   Test   Server         '#13#10);  
          socket.SendText(TempStr);  
          TempStr:=pchar('#######################################'#13#10);  
          socket.SendText(TempStr);  
          TempStr:=pchar('All   your   words   will   be   sent   to   all   online   people'#13#10);  
          socket.SendText(TempStr);  
  end;  
   
  procedure   TForm1.ServerClientError(Sender:   TObject;  
      Socket:   TCustomWinSocket;   ErrorEvent:   TErrorEvent;  
      var   ErrorCode:   Integer);  
  begin  
  //Error   Conditions  
  Case   ErrorCode   Of  
      10054:M1.lines.add('one   connection   is   reset   by   remote   side.');  
      Else  
          M1.Lines.Add('Error   Happen,   Error   Code:'+InttoStr(errorCode));  
  End;  
  ErrorCode:=0;  
  end;  
   
  procedure   TForm1.btnSendClick(Sender:   TObject);  
  var  
      i:integer;  
      Count:Integer;  
  begin  
          Count:=Server.Socket.ActiveConnections;  
          for   i:=0   to   Count-1   do  
              Server.Socket.Connections[i].SendText(edtSend.text);  
  end;  
   
  procedure   TForm1.ServerClientDisconnect(Sender:   TObject;  
      Socket:   TCustomWinSocket);  
  Var  
          Count:Integer;  
          IDIndex:Integer;  
  begin  
          M1.Lines.add('Usr   Offline');  
          M1.Lines.add('             SocketID:'+Inttostr(Socket.SocketHandle));  
          IDIndex:=cbxID.Items.IndexOf(   Inttostr(Socket.SocketHandle));  
          cbxID.Items.Delete(IDIndex);  
          //this   event   happens   before   user   leave  
          Count:=Server.Socket.ActiveConnections-1;  
          S1.Panels.Items[1].Text:='OnLine   user:'+Inttostr(Count);  
  end;  
   
  procedure   TForm1.btnOneSendClick(Sender:   TObject);  
  var  
      ID:Integer;  
      Socket:TCustomWinSocket;  
  begin  
      if   cbxID.Text=''   then  
          exit;      
      ID:=strtoint(cbxID.text);  
      //Create   a   socket   with   exist   socket   handle  
      Socket:=TCustomWinSocket.Create(ID);  
      Socket.SendText(EdtSend.text);  
  end;  
   
  end.Top

2 樓cz3w（三王）回覆於 2002-03-28 14:03:15 得分 0

unit   Unit_client;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Classes,   Graphics,   Controls,   Forms,   Dialogs,  
      ScktComp,   StdCtrls,   ComCtrls,   ExtCtrls;  
   
  type  
      TForm1   =   class(TForm)  
          S1:   TStatusBar;  
          M1:   TMemo;  
          Client:   TClientSocket;  
          Edit1:   TEdit;  
          Button1:   TButton;  
          Bevel1:   TBevel;  
          Label1:   TLabel;  
          edtHost:   TEdit;  
          Label2:   TLabel;  
          edtPort:   TEdit;  
          btnConnect:   TButton;  
          bntDisConnect:   TButton;  
          procedure   ClientConnect(Sender:   TObject;  
              Socket:   TCustomWinSocket);  
          procedure   ClientRead(Sender:   TObject;   Socket:   TCustomWinSocket);  
          procedure   ClientDisconnect(Sender:   TObject;   Socket:   TCustomWinSocket);  
          procedure   FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
          procedure   M1Click(Sender:   TObject);  
          procedure   Button1Click(Sender:   TObject);  
          procedure   btnConnectClick(Sender:   TObject);  
          procedure   Edit1KeyPress(Sender:   TObject;   var   Key:   Char);  
          procedure   FormCreate(Sender:   TObject);  
          procedure   bntDisConnectClick(Sender:   TObject);  
      private  
          {   Private   declarations   }  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
      TotalLen:Integer;  
   
  implementation  
  uses     ShellAPI;  
  {$R   *.DFM}  
   
  procedure   TForm1.ClientConnect(Sender:   TObject;  
      Socket:   TCustomWinSocket);  
  begin  
  S1.Panels.Items[0].Text:='Connect   Received';  
  S1.Panels.items[1].text:='';  
  end;  
   
  procedure   TForm1.ClientRead(Sender:   TObject;   Socket:   TCustomWinSocket);  
  var  
      re:pchar;  
      sbuf:string;  
      relong:integer;  
  begin  
          re:=nil;  
          while   socket.ReceiveLength>0   do  
              begin  
                  //申請內存  
                  re:=AllocMem(socket.receivelength);  
              TRY  
                  relong:=socket.ReceiveLength;  
                  Socket.ReceiveBuf(re^,Socket.receivelength);  
                  sBuf:=strpas(re);  
                  Setlength(sbuf,relong);  
   
                  //count   lenght  
                  TotalLen:=TotalLen+   relong;  
                  S1.Panels.Items[1].Text:='Total   Received   (Byte):   '   +   IntToStr(TotalLen);  
                  S1.Update();  
              FINALLY  
                  freemem(re);  
              END;  
          M1.Lines.Add(sbuf);  
      end;  
  end;  
   
  procedure   TForm1.ClientDisconnect(Sender:   TObject;  
      Socket:   TCustomWinSocket);  
  begin  
      S1.Panels.Items[0].Text:='Close   Connect   With   Host';  
      S1.Panels.Items[0].Text:='';  
      M1.Lines.Clear;  
      edit1.Text:='';  
  end;  
   
  procedure   TForm1.FormClose(Sender:   TObject;   var   Action:   TCloseAction);  
  begin  
      if   Client.Active   then  
          Client.Close;  
  end;  
   
  procedure   TForm1.M1Click(Sender:   TObject);  
  begin  
  Edit1.SetFocus;  
  end;  
   
  procedure   TForm1.Button1Click(Sender:   TObject);  
  begin  
          ShellExecute(self.handle,nil,Pchar(Application.EXEname),nil,nil,SW_Normal);  
  end;  
   
  procedure   TForm1.btnConnectClick(Sender:   TObject);  
  begin  
          Client.Address:=edtHost.Text;  
          Client.Port:=strtoint(edtPort.Text);  
          Client.Active:=true;  
  end;  
   
  procedure   TForm1.Edit1KeyPress(Sender:   TObject;   var   Key:   Char);  
  begin  
  if   key=#13   then  
      begin  
          if   not   Client.Active   then  
                  btnConnectClick(Sender);  
          Client.Socket.SendText(Edit1.Text);  
          edit1.SelectAll;  
          key:=#0;  
      end;  
  end;  
   
  procedure   TForm1.FormCreate(Sender:   TObject);  
  begin  
          edtHost.Text:='10.14.61.70';  
          edtPort.Text:='7';  
          TotalLen:=0;  
  end;  
   
  procedure   TForm1.bntDisConnectClick(Sender:   TObject);  
  begin  
          Client.Active:=False;  
  end;  
   
  end.