1: 2: 3: 4: 5: 6: 7: 8: 9: 10: 11: 12: 13: 14: 15: 16: 17: 18: 19: 20: 21: 22: 23: 24: 25: 26: 27: 28: 29: 30: 31: 32: 33: 34: 35: 36: 37: 38: 39: 40: 41: 42: 43: 44: 45: 46: 47: 48: 49: 50: 51: 52: 53: 54: 55: 56: 57: 58: 59: 60: 61: 62: 63: 64: 65: 66: 67: 68: 69: 70: 71: 72: 73: 74: 75: 76: 77: 78: 79: 80: 81: 82: 83: 84: 85: 86: 87: 88: 89: 90: 91: 92: 93: 94: 95: 96: 97: 98: 99: 100: 101: 102: 103: 104: 105: 106: 107: 108: 109: 110: 111: 112: 113: 114: 115: 116: 117: 118: 119: 120: 121: 122: 123: 124: 125: 126: 127: 128: 129: 130: 131: 132: 133: 134: 135: 136: 137: 138: 139: 140: 141: 142: 143: 144: 145: 146: 147: 148: 149: 150: 151: 152: 153: 154: 155: 156: 157: 158: 159: 160: 161: 162: 163: 164: 165: 166: 167: 168: 169: 170: 171: 172: 173: 174: 175: 176: 177: 178: 179: 180: 181: 182: 183: 184: 185: 186: 187: 188: 189: 190: 191: 192: 193: 194: 195: 196: 197: 198: 199: 200: 201: 202: 203: 204: 205: 206: 207: 208: 209: 210: 211: 212: 213: 214: 215: 216: 217: 218: 219: 220: 221: 222: 223: 224: 225: 226: 227: 228: 229: 230: 231: 232: 233: 234: 235: 236: 237: 238: 239: 240: 241: 242: 243: 244: 245: 246: 247: 248: 249: 250: 251: 252: 253: 254: 255: 256: 257: 258: 259: 260: 261: 262: 263: 264: 265: 266: 267: 268: 269: 270: 271: 272: 273: 274: 275: 276: 277: 278: 279:
| unit RMain;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Menus, ScktComp, mmsystem, shellapi, ComCtrls;
type TForm1 = class(TForm) Memo2: TMemo; Edit1: TEdit; Button1: TButton; MainMenu1: TMainMenu; Verbindung1: TMenuItem; Verbinden1: TMenuItem; Unterbrechen1: TMenuItem; N1: TMenuItem; Beenden1: TMenuItem; ClientSocket1: TClientSocket; ServerSocket1: TServerSocket; ChatLog1: TMenuItem; DieseSessionaufzeichnen1: TMenuItem; N2: TMenuItem; DiesenPCalsServerbenutzen1: TMenuItem; Optionen1: TMenuItem; Schrift1: TMenuItem; FontDialog1: TFontDialog; RichEdit1: TRichEdit; procedure Memo2KeyPress(Sender: TObject; var Key: Char); procedure ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket); procedure ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); procedure Verbinden1Click(Sender: TObject); procedure Beenden1Click(Sender: TObject); procedure Button1Click(Sender: TObject); procedure Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); procedure Unterbrechen1Click(Sender: TObject); procedure DieseSessionaufzeichnen1Click(Sender: TObject); procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); procedure DiesenPCalsServerbenutzen1Click(Sender: TObject); procedure ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket); procedure FormShow(Sender: TObject); procedure FormCreate(Sender: TObject); procedure ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure Schrift1Click(Sender: TObject); procedure RichEdit1KeyPress(Sender: TObject; var Key: Char); private public protected isserver:boolean; end;
var Form1: TForm1; Server, Nick: String; recordS: boolean; i: integer;
implementation
{$R *.dfm} {$R sounds.res}
procedure HighLightNames(zeile: integer; farbe: TColor; edit: TRichEdit); var Start, Ende, OldSelStart:integer; begin zeile:= zeile-1; OldSelStart:= edit.SelStart; Start:= Pos(edit.Lines[zeile],edit.text) -1; Ende:= pos(':', edit.lines[zeile]); edit.SelStart:= Start; edit.SelLength:=Ende; edit.SelAttributes.Color:= farbe; edit.SelLength:=0; edit.SelStart:= OldSelStart; edit.SetFocus; end;
procedure TForm1.Memo2KeyPress(Sender: TObject; var Key: Char); begin key:= #0; end;
procedure TForm1.ServerSocket1Accept(Sender: TObject; Socket: TCustomWinSocket); begin IsServer := True; end;
procedure TForm1.ServerSocket1ClientRead(Sender: TObject; Socket: TCustomWinSocket); var rtext: string; begin rtext:= socket.ReceiveText; richedit1.lines.add(''); richedit1.Lines.Add(RText); for i:= 0 to ServerSocket1.Socket.ActiveConnections - 1 do ServerSocket1.Socket.Connections[i].SendText(RText); PlaySound('newmessage',HInstance, snd_ASync or snd_Memory or snd_Resource); HighLightNames(richedit1.lines.count, clred, richedit1); end;
procedure TForm1.ClientSocket1Connect(Sender: TObject; Socket: TCustomWinSocket); begin ClientSocket1.Socket.SendText(#13 + '*** ' + nick + ' ist auf dem Server ! ***'); memo2.text := 'Verbunden mit: ' + Socket.RemoteHost; end;
procedure TForm1.ClientSocket1Disconnect(Sender: TObject; Socket: TCustomWinSocket); begin memo2.text := 'Verbindung getrennt!'; end;
procedure TForm1.ClientSocket1Error(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin Memo2.text := 'Fehler beim Verbinden mit: ' + Server; ErrorCode := 0; end;
procedure TForm1.ClientSocket1Read(Sender: TObject; Socket: TCustomWinSocket); var RText: string; begin RText:= socket.ReceiveText; richedit1.lines.add(''); richedit1.Lines.Add(RText); PlaySound('newmessage',HInstance, snd_ASync or snd_Memory or snd_Resource); HighLightNames(richedit1.lines.count, clred, richedit1); end;
procedure TForm1.Verbinden1Click(Sender: TObject); begin if ClientSocket1.Active then ClientSocket1.Active := False; if InputQuery('Verbinden', 'Server-Addresse:', Server) then if InputQuery('Benutzer', 'Benutzer-Name:', Nick) then if Length(Server) > 0 then if length(nick) <= 0 then nick := 'Gast'; with ClientSocket1 do begin Host := Server; Active := True; end; end;
procedure TForm1.Beenden1Click(Sender: TObject); begin if recordS = true then richedit1.lines.SaveToFile('Chat.txt'); ServerSocket1.Close; ClientSocket1.Close; Close; end;
procedure TForm1.Button1Click(Sender: TObject); begin if length(nick) <= 0 then nick := 'Gast'; if edit1.Text <> '' then begin if IsServer then begin for i:= 0 to ServerSocket1.Socket.ActiveConnections - 1 do ServerSocket1.Socket.Connections[i].SendText(nick + ': ' + edit1.text); richedit1.Lines.add(''); richedit1.lines.add(nick + ': ' + edit1.text); HighLightNames(richedit1.lines.count, clred, richedit1); end else ClientSocket1.Socket.SendText(nick + ': ' + edit1.text); edit1.text:= ''; edit1.SetFocus; end; end;
procedure TForm1.Edit1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState); begin if length(nick) <= 0 then nick := 'Gast'; if Key = VK_Return then begin if edit1.Text <> '' then begin if IsServer then begin for i:= 0 to ServerSocket1.Socket.ActiveConnections - 1 do ServerSocket1.Socket.Connections[i].SendText(nick + ': ' + edit1.text); richedit1.Lines.add(''); richedit1.lines.add(nick + ': ' + edit1.text); HighLightNames(richedit1.lines.count, clred, richedit1); end else ClientSocket1.Socket.SendText(nick + ': ' + edit1.text); edit1.text:= ''; edit1.SetFocus; end; end; end;
procedure TForm1.Unterbrechen1Click(Sender: TObject); begin ClientSocket1.Active := False; ServerSocket1.Active := false; memo2.text := 'Verbindung getrennt!'; end;
procedure TForm1.DieseSessionaufzeichnen1Click(Sender: TObject); begin DieseSessionaufzeichnen1.checked:= not DieseSessionaufzeichnen1.checked; if DieseSessionaufzeichnen1.checked = true then recordS:= true else recordS:= false; end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean); begin recordS:= MessageDlg('Möchten Sie die letzte Session speichern?', mtConfirmation, [mbYes,mbNo], 0) = mrYes; if recordS = true then if recordS = true then richedit1.lines.SaveToFile('LastChat.txt'); end;
procedure TForm1.DiesenPCalsServerbenutzen1Click(Sender: TObject); begin DiesenPCalsServerbenutzen1.checked:= not DiesenPCalsServerbenutzen1.checked; if DiesenPCalsServerbenutzen1.checked = true then begin if length(nick) <= 0 then if InputQuery('Benutzer', 'Benutzer-Name:', Nick) then if length(nick) <= 0 then nick := 'Gast'; isserver:= true; serversocket1.active:= true; memo2.text := 'Server erfolgreich erstellt!'; end else begin isserver:= false; serversocket1.active:= false; memo2.text := 'Server heruntergefahren!'; end; end;
procedure TForm1.ServerSocket1ClientConnect(Sender: TObject; Socket: TCustomWinSocket); begin ServerSocket1.Socket.Connections[ServerSocket1.Socket.ActiveConnections - 1].SendText('*** Willkommen auf dem Chat42 Server von ' + nick + ' ! ***'); memo2.text := 'Verbunden mit: ' + Socket.RemoteAddress; end;
procedure TForm1.FormShow(Sender: TObject); begin edit1.SetFocus; end;
procedure TForm1.FormCreate(Sender: TObject); begin SetBounds((Screen.Width - Width) div 2, (Screen.Height - Height) div 2, Width, Height); RichEdit1.MaxLength:=MaxInt; end;
procedure TForm1.ServerSocket1ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin memo2.text := 'Verbindung getrennt!'; end;
procedure TForm1.Schrift1Click(Sender: TObject); begin if fontdialog1.Execute then richedit1.Font:= fontdialog1.Font; end;
procedure TForm1.RichEdit1KeyPress(Sender: TObject; var Key: Char); begin key:= #0; end;
end. |