unit1.pas

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

{IMT Chatting Program (Client)
1999 IMT Software House
Deniel
[e-mail]}
unit Unit1;

interface

uses
  Windows, Messages, SysUtils,
  Classes, Graphics, Controls,
  Forms, Dialogs,   Buttons, Menus,
  ExtCtrls, StdCtrls, Mask, ScktComp,
   ComCtrls, ImgList, NMFtp,
  Psock, NMSTRM, ExtDlgs,
registry,
   ShellAPI;
   const
  WM_BARICON=WM_USER+200;
type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Connect1: TMenuItem;
    Disconnect1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    Option1: TMenuItem;
    Nickname1: TMenuItem;
    P1: TMenuItem;
    ClientSocket1: TClientSocket;
    StatusBar1: TStatusBar;
    Label2: TLabel;
    Panel1: TPanel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SaveDialog1: TSaveDialog;
    N2: TMenuItem;
    SaveChat1: TMenuItem;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton9: TSpeedButton;
    WhoIs1: TMenuItem;
    Edit2: TMenuItem;
    Cut1: TMenuItem;
    Copy1: TMenuItem;
    Paste1: TMenuItem;
    PopupMenu1: TPopupMenu;
    Cut2: TMenuItem;
    Copy2: TMenuItem;
    Paste2: TMenuItem;
    ImageList1: TImageList;
    ImageList2: TImageList;
    SpeedButton10: TSpeedButton;
    SpeedButton11: TSpeedButton;
    label4: TLabel;
    Se1: TMenuItem;
    SaveDialog2: TSaveDialog;
    NMStrm1: TNMStrm;
    NMStrmServ1: TNMStrmServ;
    OpenDialog1: TOpenDialog;
    SpeedButton12: TSpeedButton;
    Image2: TImage;
    PopupMenu2: TPopupMenu;
    WhoIs2: TMenuItem;
    PrivateMessage1: TMenuItem;
    Kick1: TMenuItem;
    SendFile1: TMenuItem;
    Label5: TLabel;
    GroupBox1: TGroupBox;
    ListBox1: TListBox;
    GroupBox2: TGroupBox;
    RichEdit1: TRichEdit;
    GroupBox3: TGroupBox;
    edit1: TMemo;
    Button1: TButton;
    Button2: TButton;
    PopupMenu3: TPopupMenu;
    N3: TMenuItem;
    N4: TMenuItem;
    t: TTimer;
    procedure Connect1Click(Sender: TObject);
    procedure Disconnect1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure Nickname1Click(Sender: TObject);
    procedure P1Click(Sender: TObject);
    procedure Game1Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
    procedure ClientSocket1Connect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure ClientSocket1Disconnect(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SaveChat1Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure Cut1Click(Sender: TObject);
    procedure Copy1Click(Sender: TObject);
    procedure Paste1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure WhoIs1Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure RichEdit1Change(Sender: TObject);
    procedure Modmenu1Click(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure ModeratorMenu1Click(Sender: TObject);
    procedure Cut2Click(Sender: TObject);
    procedure Copy2Click(Sender: TObject);
    procedure Paste2Click(Sender: TObject);
    procedure ListBox1DblClick(Sender: TObject);
    procedure Se1Click(Sender: TObject);
    procedure NMStrmServ1ClientContact(Sender: TObject);
    procedure NMStrm1Connect(Sender: TObject);
    procedure NMStrm1ConnectionFailed(Sender: TObject);
    procedure NMStrmServ1MSG(Sender: TComponent; const sFrom: String;
      strm: TStream);
    procedure NMStrm1MessageSent(Sender: TObject);
    procedure NMStrm1PacketSent(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure WhoIs2Click(Sender: TObject);
    procedure PrivateMessage1Click(Sender: TObject);
    procedure SendFile1Click(Sender: TObject);
    procedure Kick1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure RichEdit1KeyPress(Sender: TObject; var Key: Char);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure tTimer(Sender: TObject);

  private
    procedure WMSysCommand(var Message: TMessage); message WM_SYSCOMMAND;
   procedure WMBarIcon(var Message:TMessage);message WM_BARICON;

    { Private declarations }
  public
      { Public declarations }
  end;

var
  Form1   : TForm1;
  urut, g, ack, ak, index, score: byte;
  pass, filename, path, nf, ext, gjawab: string;
  mode    : boolean;
  nick    : array[0..99] of string;
  modon   : boolean;
implementation
uses Unit2, Unit3, Unit4, Unit5, Unit6, Unit7, Unit8, Unit9, Unit10, Unit11,
  Unit12, Unit13, Unit14;
{function RegisterServiceProcess (dwProcessID, dwType: DWord) : DWord;
  stdcall; external 'KERNEL32.DLL';}

{$R *.DFM}

procedure TForm1.Connect1Click(Sender: TObject);
begin
  form2.show;
end;

procedure TForm1.Disconnect1Click(Sender: TObject);
begin
  form3.show;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
  form4.show;
end;

procedure TForm1.Nickname1Click(Sender: TObject);
begin
  form5.show;
end;

procedure TForm1.P1Click(Sender: TObject);
begin
  form6.show;
end;

procedure TForm1.Game1Click(Sender: TObject);
begin
  form7.show;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  if SpeedButton1.down <> false then
    begin
      form2.show;
      speedbutton1.down := false;
    end
  else
    exit;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
  if speedbutton2.down <> false then
    begin
      form3.show;
      speedbutton2.down := false
    end
  else
    exit;
end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  form5.show;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
var
  s, wnama, wlh, pnama, ppesan, add, port, snick, sadd, sport, gname, gacak, ghint: string;
  i, d, x, b, c, f, m, n, a, e, h, j, k, anick, anama, bnick, putus, na, ab, ac, ad, ae, af, ag: byte;
  bc, bd, be, bg: byte;
  mystream: TStream;
label
  go1;
label
  go2;
label
  go3;
begin
  s := ClientSocket1.Socket.ReceiveText;
  d := 0;
  i := 2;
  n := 2;
  repeat
    inc(c);
  until copy(s, c, 1) = '