|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#25
|
||||
|
||||
ябашь
вот код клиента Код:
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 лет назад.... |