unit1.pas

很好的聊天工具可以实现视频聊天 编程简练,很简易但是很实用

unit Unit1;  {a}

interface

uses
  Windows, Messages, SysUtils,
   Classes, Graphics, Controls, Forms,
    Dialogs,  StdCtrls, ScktComp,registry, ExtCtrls,
   ShellAPI,  Buttons, Menus;
   const
  WM_BARICON=WM_USER+200;
type
  TForm1 = class(TForm)
    ServerSocket1: TServerSocket;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    GroupBox2: TGroupBox;
    ListBox1: TListBox;
    GroupBox3: TGroupBox;
    ListBox2: TListBox;
    GroupBox4: TGroupBox;
    ListBox3: TListBox;
    t: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
    procedure Button3Click(Sender: TObject);
    procedure ServerSocket1ClientConnect(Sender: TObject;
      Socket: TCustomWinSocket);

    procedure ServerSocket1ClientDisconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    
    procedure Label5DblClick(Sender: TObject);

    procedure Label4DblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure tTimer(Sender: TObject);
    procedure FormShow(Sender: TObject);
 


  private
    { Private declarations }
  public
    { Public declarations }
  end;
  var
   Form1: TForm1;
   pass: string;
  implementation

uses Unit2, Unit3;

{$R *.DFM}

  var
  a,ak,putus: byte;
  y:integer;
  nama: array [0..99] of string;
  nick: array [0..99] of string ;
  lh: array[0..99] of string;
  con: integer;
   allnick: string;
   gon: boolean;
procedure TForm1.Button1Click(Sender: TObject);
begin
ServerSocket1.Port := 200;
serversocket1.active:= true;
edit1.text:=serversocket1.Socket.localhost;
gon:=false;
y:=0;
a:=0;
pass:='deniel';
con:=0;

end;

procedure TForm1.Button2Click(Sender: TObject);
var i: byte;
begin
serversocket1.active:= false;
edit1.text:= '';
listbox1.items.clear;
listbox2.items.clear;
label3.caption:='';
listbox3.items.clear;
ak:=0;
for i:=0 to 2 do
begin
nick[i]:='';
nama[i]:='';
lh[i]:='';
end;
gon:=false;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);
 var i,z,c,d,e,f,g,h,j,k,l,m,n,o,q,r,t,u,v,ab,ac,ad,ki,id : byte;
      ae,af,ag,ah,al,am,ao,ap,aq,ar,au,at,av,aw,ay,ba,bi:byte;
     x,b,an:integer;
     sama:boolean;
     found:boolean;
     nape,knama,kpesan,akal,s,pnama,ppesan,naki,nato,nakil,fnick,snick: string;
     snick2,fnick2,fadd,fport: string;
     label start1;
     label label2;
     label label3 ;
     label label4;
     label label5;
     label label6;
     label label7 ;
     label label8;
 begin
sama:= false;
t:=1;
b:=-1;
h:=1;
g:=1;
c:=0;
f:=0;
x:=-1;
an:=-1;
s:= socket.receivetext;

repeat
inc(id);
until copy(s,id,1) ='