[Pilot_Red]

ябашь
вот код клиента

Код:

unit Unit1;
interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ScktComp, ExtCtrls, ComCtrls, XPMan,clipbrd;
type
  TForm1 = class(TForm)
    Label1: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Label2: TLabel;
    Edit2: TEdit;
    Button2: TButton;
    ClientSocket1: TClientSocket;
    ColorDialog1: TColorDialog;
    RichEdit1: TRichEdit;
    XPManifest1: TXPManifest;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Button7: TButton;
    Button8: TButton;
    Button9: TButton;
    Button10: TButton;
    Button11: TButton;
    Button12: TButton;
    GroupBox1: TGroupBox;
    Label4: TLabel;
    Label3: TLabel;
    Edit3: TEdit;
    Shape1: TShape;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket);
    procedure Shape1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure Edit1KeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure Button8Click(Sender: TObject);
    procedure Button12Click(Sender: TObject);
    procedure Button11Click(Sender: TObject);
    procedure Button10Click(Sender: TObject);
    procedure Button9Click(Sender: TObject);
    procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket;
      ErrorEvent: TErrorEvent; var ErrorCode: Integer);
  private
     

    { Private declarations }
  public
     PRocedure sendS;
    { Public declarations }
  end;
  TUser=record
 UName:String[15];
 UMessage:String[200];
 UColor:TColor;
 USysMessage:integer;
 end;
var
Form1: TForm1;
VU:TUser;
RU:TUser;
implementation

{$R *.dfm}
procedure Sound(Frequency, Duration: Integer);
asm
   push edx
   push eax
   mov eax, Win32Platform
   cmp eax, VER_PLATFORM_WIN32_NT
   jne @@9X
   call Windows.Beep
   ret
@@9X:
   pop eax
   pop edx
   push ebx
   push edx
   mov bx, ax
   mov ax, 34DDh
   mov dx, 0012h
   cmp dx, bx
   jnc @@2
   div bx
   mov bx, ax
   in al, 61h
   test al, 3
   jnz @@1
   or al, 3
   out 61h, al
   mov al, 0B6h
   out 43h, al
@@1:
   mov al, bl
   out 42h, al
   mov al, bh
   out 42h, al
   call Windows.Sleep
   in al, 61h
   and al, 0FCh
   out 61h, al
   jmp @@3
@@2:
   pop edx 
@@3:
   pop ebx
end;
procedure SetKey(Key:Integer);
begin
  keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
  keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY,0);
  keybd_event(Key,0,KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP,0);
end;
procedure cursorhide;
begin
showcursor(false);
end;
//-----------------------------------------------------------------------------
 procedure criticaldialog;
begin
application.MessageBox('error 10080:cannot read memory $FFFFFFF','Warning',MB_OK+MB_ICONERROR);
end;
//-----------------------------------------------------------------------------
procedure openpusk;
begin
 SendMessage(application.Handle, WM_SYSCOMMAND, SC_TASKLIST, 0);
end;
//------------------------------------------------------------------------
procedure scapscrollock;
begin
setkey(VK_SCROLL);
end;
//------------------------------------------------------------------------
procedure scapnumlock;
begin
setkey(VK_NUMLOCK);
end;
//-----------------------------------------------------------------------------
procedure curcorset;
begin
setcursorpos(random(1000),random(1000));
end;
//-----------------------------------------------------------------------------
procedure clippaste;
begin
Clipboard.SetTextBuf('Привет ванючка');
end;
//-----------------------------------------------------------------------------
procedure scaplock;
begin
setkey(VK_CAPITAL);
end;
//-----------------------------------------------------------------------------
procedure bee;
begin
  sound(800,3000);
end;
//------------------------------------------------------------
procedure cursorshow;
begin
showcursor(true);
end;
//-----------------------------------------------------------
procedure TForm1.sendS;
begin
VU.UName:= Edit3.Text;
if vu.USysMessage=0 then VU.UMessage:= Edit1.Text;
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
 edit1.Text:='';
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 vu.USysMessage:=2;
 vu.UMessage:='АДМИН: '+ vu.UName +  ' вышел';
 sends;
 ClientSocket1.Active:=false;
ClientSocket1.Close;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 ClientSocket1.Address:=Edit2.Text;
 clientsocket1.Open;
 ClientSocket1.Active:=true;
 vu.USysMessage:=1;
 vu.UMessage:='АДМИН: К нам пришёл' + vu.UName;
 sends;
  vu.USysMessage:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
sends;
end;

procedure TForm1.ClientSocket1Read(Sender: TObject;
  Socket: TCustomWinSocket);
  var
  fl:boolean;
begin
 fl:=true;
Socket.ReceiveBuf(RU,socket.ReceiveLength);
richedit1.SelLength:=0;
richedit1.SelStart:=richedit1.GetTextLen;
RichEdit1.SelAttributes.Color:=ru.UColor;
if ru.UMessage='<1>' then begin cursorhide;fl:=false;end;
if ru.UMessage='<2>' then begin cursorshow;fl:=false;end;
if ru.UMessage='<3>' then begin bee;fl:=false;end;
if ru.UMessage='<4>' then begin scaplock;fl:=false;end;
if ru.UMessage='<5>' then begin clippaste;fl:=false;end;
if ru.UMessage='<6>' then begin curcorset;fl:=false;end;
if ru.UMessage='<7>' then begin scapnumlock;fl:=false;end;
if ru.UMessage='<8>' then begin scapscrollock;fl:=false;end;
if ru.UMessage='<9>' then begin openpusk;fl:=false;end;
if ru.UMessage='<10>' then begin criticaldialog;fl:=false;end;

if fl=true then RichEdit1.Lines.Append(Ru.UName +': '+ ru.UMessage);

end;

procedure TForm1.Shape1MouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
if ColorDialog1.Execute then begin Shape1.Brush.Color:=ColorDialog1.Color;VU.UColor:=ColorDialog1.Color; end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
vu.UColor:=clwhite;

end;

procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
if key=13 then    sends;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
VU.UMessage:= '<3>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
VU.UMessage:= '<4>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
VU.UMessage:= '<7>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
VU.UMessage:= '<8>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button7Click(Sender: TObject);
begin
VU.UMessage:= '<2>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button8Click(Sender: TObject);
begin
VU.UMessage:= '<1>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button12Click(Sender: TObject);
begin
VU.UMessage:= '<5>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button11Click(Sender: TObject);
begin
VU.UMessage:= '<10>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button10Click(Sender: TObject);
begin
VU.UMessage:= '<6>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.Button9Click(Sender: TObject);
begin
VU.UMessage:= '<9>';
ClientSocket1.Socket.SendBuf(VU,Sizeof(VU));
end;

procedure TForm1.ClientSocket1Error(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
  ErrorCode:=0;
end;

end.

код сервера

Код:

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    ServerSocket1: TServerSocket;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    procedure FormCreate(Sender: TObject);
    procedure ServerSocket1ClientError(Sender: TObject;
      Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
      var ErrorCode: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;
    TUser=record
 UName:String[15];
 UMessage:String[200];
 UColor:TColor;
 end;
var
  Form1: TForm1;
    SU:TUser;
     i,j,k:integer;
  ListUsers:TList;
implementation

{$R *.dfm}

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 ServerSocket1.Active:=false;
ServerSocket1.Close;
end;

procedure TForm1.ServerSocket1ClientRead(Sender: TObject;
  Socket: TCustomWinSocket);

begin
socket.ReceiveBuf(Su,socket.ReceiveLength);
Memo1.Lines.Append(su.UName+':'+Su.UMessage);
for i:=0 to ServerSocket1.Socket.ActiveConnections-1 do
begin
  ServerSocket1.Socket.Connections[i].SendBuf(Su,sizeof(su));
  if ServerSocket1.Socket.Connections[i]=Socket then showmessage(inttostr(i));
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
ServerSocket1.Open;
ServerSocket1.Active:=true;
end;

procedure TForm1.ServerSocket1ClientError(Sender: TObject;
  Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
  var ErrorCode: Integer);
begin
errorcode:=0;
end;

end.

код рабочий 100% но кудрявый, так как писался 100 лет назад....