|
Registriert seit: 5. Aug 2011 188 Beiträge |
#9
Client Source:
Code:
unit Unit1;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ScktComp, inifiles, ComCtrls, Character, unit2; type TForm1 = class(TForm) PageControl1: TPageControl; TabSheet1: TTabSheet; Client: TClientSocket; Button4: TButton; Button2: TButton; Button1: TButton; GroupBox2: TGroupBox; Memo2: TMemo; GroupBox1: TGroupBox; TabSheet2: TTabSheet; ColorDialoguser: TColorDialog; Button3: TButton; GroupBox3: TGroupBox; labelUsername: TLabel; Labelhost: TLabel; Labelport: TLabel; Labelcolor: TLabel; Editusername: TEdit; Edithost: TEdit; Editport: TEdit; ButtonColor: TButton; Buttonconnect: TButton; Edit1: TEdit; TrackBar1: TTrackBar; Label1: TLabel; Label2: TLabel; RichEdit1: TRichEdit; procedure ClientConnect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure ClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure Button1Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure TabSheet2ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); procedure ButtonconnectClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ButtonColorClick(Sender: TObject); procedure Button3Click(Sender: TObject); procedure TrackBar1Change(Sender: TObject); procedure Button2Click(Sender: TObject); private { Private-Deklarationen } inifileuser: Tinifile; public { Public-Deklarationen } end; var Form1: TForm1; implementation {$R *.dfm} procedure TForm1.Button1Click(Sender: TObject); var c: Integer; var Farbstring: String; begin with richedit1.selattributes do begin c := colordialoguser.color; Farbstring := Format('%.2x%.2x%.2x', [GetBValue(c), GetGValue(c), GetRValue(c)]); if strtoint(memo2.Text) <> 0 then richedit1.SelAttributes.Style := [fsBold]; client.socket.SendText(inttostr(c) + editusername.text + ' -> ' + memo2.text); memo2.Clear; end; end; procedure TForm1.Button2Click(Sender: TObject); begin end; procedure TForm1.Button3Click(Sender: TObject); begin application.Terminate end; procedure TForm1.Button4Click(Sender: TObject); begin memo2.Clear; memo2.lines.Add('Client 1.0 - Lyan'); end; procedure TForm1.ButtonColorClick(Sender: TObject); var c: Integer; var Farbstring: String; begin c := colordialoguser.color; Farbstring := Format('%.2x%.2x%.2x', [GetBValue(c), GetGValue(c), GetRValue(c)]); if colordialoguser.Execute then begin inifileuser.WriteString('Userinfo','Farbe',IntToStr(c)); Edit1.Color := c; end; end; procedure TForm1.ButtonconnectClick(Sender: TObject); var iLength: Integer; begin Inifileuser.WriteString('Userinfo', 'Username', Editusername.text ); Inifileuser.WriteString('Userinfo', 'Host', Edithost.text ); Inifileuser.WriteString('Userinfo', 'Port', Editport.text ); Inifileuser.WriteString('Userinfo', 'Chatfarbe', IntToStr(ColorDialoguser.Color)); if (editusername.Text <> '') AND (editport.Text <> '') AND (edithost.Text <> '') then begin iLength := Length(editusername.Text); if (iLength > 3) then begin try client.Host := edithost.text; client.Port := strtoint(editport.text); client.Active := True; pagecontrol1.ActivePage := tabsheet1; unit2.Form2.Show; except ShowMessage('Connection failed! Please check your Host or Port number!'); end; end; end else begin Showmessage('Entweder haben sie vergessen ein Feld auszufüllen, oder ihr Username ist zu kurz!'); end; end; procedure TForm1.ClientConnect(Sender: TObject; Socket: TCustomWinSocket); begin richedit1.Lines.Add('Status: verbunden mit ' + socket.RemoteAddress); end; procedure TForm1.ClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin richedit1.Lines.Add('Status: getrennt mit ' + socket.RemoteAddress); end; procedure TForm1.ClientRead(Sender: TObject; Socket: TCustomWinSocket); begin richedit1.Lines.Add(Socket.ReceiveText); end; procedure TForm1.FormCreate(Sender: TObject); var suserpath: String; sFarbe: String; begin PageControl1.ActivePage := TabSheet2; suserpath := ExtractFilePath(ParamStr(0)); if not DirectoryExists('Usersettings') then CreateDir('Usersettings'); inifileuser:=Tinifile.Create(suserpath + ('\Usersettings\Usersettings.ini')); editusername.Text:=inifileuser.ReadString('Userinfo', 'Username', ''); editHost.Text:=inifileuser.ReadString('Userinfo', 'Host', ''); editPort.Text:=inifileuser.ReadString('Userinfo', 'Port', ''); sFarbe := inifileuser.ReadString('Userinfo', 'Farbe', InttoStr(clBlack)); sFarbe := inifileuser.ReadString('Userinfo', 'Chatfarbe', InttoStr(clBlack)); try Color := StrToInt(sFarbe); except Color := clBlack; end; end; procedure TForm1.FormDestroy(Sender: TObject); begin try inifileuser.free except end; end; procedure TForm1.TabSheet2ContextPopup(Sender: TObject; MousePos: TPoint; var Handled: Boolean); var sFarbe: String; suserpath: String; begin suserpath := ExtractFilePath(ParamStr(0)); if not DirectoryExists('Usersettings') then CreateDir('Usersettings'); inifileuser:=Tinifile.Create(suserpath + ('\Usersettings\Usersettings.ini')); editusername.Text:=inifileuser.ReadString('Userinfo', 'Username', ''); editHost.Text:=inifileuser.ReadString('Userinfo', 'Host', ''); editPort.Text:=inifileuser.ReadString('Userinfo', 'Port', ''); sFarbe := inifileuser.ReadString('Userinfo', 'Farbe', InttoStr(clBlack)); sFarbe := inifileuser.ReadString('Userinfo', 'Chatfarbe', InttoStr(clBlack)); try Color := StrToInt(sFarbe); except Color := clBlack; end; end; procedure TForm1.TrackBar1Change(Sender: TObject); begin label1.Caption := inttostr(trackbar1.Position); form1.AlphaBlendValue := strtoint(label1.Caption); end; end. Client:
Code:
unit UnitServer;
interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Inifiles, ScktComp, ComCtrls, Menus; type TForm1 = class(TForm) EditPort: TEdit; Label1: TLabel; GroupBoxProtokoll: TGroupBox; ButtonStarten: TButton; ButtonAnhalten: TButton; ButtonClear: TButton; ButtonSenden: TButton; ButtonBeenden: TButton; EditSenden: TEdit; LabelUser: TLabel; Server: TServerSocket; ListBoxUser: TListBox; RichEditMaster: TRichEdit; procedure ButtonStartenClick(Sender: TObject); procedure ButtonAnhaltenClick(Sender: TObject); procedure ButtonClearClick(Sender: TObject); procedure ButtonBeendenClick(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket); procedure ServerClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); procedure ServerClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); procedure ServerClientRead(Sender: TObject; Socket: TCustomWinSocket); procedure ButtonSendenClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure EditPortExit(Sender: TObject); private { Private-Deklarationen } inifilemain: TIniFile; public { Public-Deklarationen } end; var {Variablen} Form1: TForm1; Userzahl:Integer; i:Integer; implementation {$R *.dfm} procedure TForm1.ButtonStartenClick(Sender: TObject); begin {Server Verbindung (Port) wird aus Edit1 gelesen on button1.click} Server.Port:= strtoint(EditPort.Text); Server.Active:=True; Buttonstarten.Enabled:=False; Buttonanhalten.Enabled:=True; RicheditMaster.Lines.Add('Status: Server gestartet.'); end; procedure TForm1.ButtonAnhaltenClick(Sender: TObject); begin {Server.Active wird auf false gesetzt wenn der Server angehalten wird} Server.Port:= strtoint(Editport.Text); Server.Active:=False; Buttonstarten.Enabled:=True; Buttonanhalten.Enabled:=False; RicheditMaster.Lines.Add('Status: Server angehalten.'); end; procedure TForm1.ButtonClearClick(Sender: TObject); begin {Protokoll wird "gelöscht"} RicheditMaster.Lines.Clear; RicheditMaster.Lines.Add('Server 1.0'); end; procedure TForm1.ButtonSendenClick(Sender: TObject); var i:integer; begin {Server schickt eine Nachricht an alle User} for i := 0 to server.Socket.ActiveConnections - 1 do server.Socket.Connections[i].SendText('Nachricht von Server: ' + editsenden.Text); RicheditMaster.Lines.Add('Nachricht von Server: ' + editsenden.Text); end; procedure TForm1.ButtonBeendenClick(Sender: TObject); begin {Anwendung schließen} server.Active:=false; application.Terminate; end; procedure TForm1.EditPortExit(Sender: TObject); begin InifileMain.WriteString('Port', 'Portvalue', editport.Text); end; procedure TForm1.FormCreate(Sender: TObject); var Inifilepath: String; begin inifilepath:=extractfilepath(ParamStr(0)); InifileMain:=TIniFile.Create(inifilepath + ('startup.ini')); Editport.Text:=InifileMain.ReadString('Port', 'portvalue', ''); end; procedure TForm1.FormDestroy(Sender: TObject); var sExeVerzeichnis: string; begin server.Active:=false; sExeVerzeichnis := ExtractFilePath(ParamStr(0)); if not DirectoryExists(sExeVerzeichnis+'VerlaufProtokoll') then CreateDir(sExeVerzeichnis+'VerlaufProtokoll') else begin RicheditMaster.lines.SaveToFile(sExeVerzeichnis+'\VerlaufProtokoll\TEst1337.txt'); end; try InifileMain.free; except end; end; procedure TForm1.ServerClientConnect(Sender: TObject; Socket: TCustomWinSocket); begin RicheditMaster.Lines.Add('Status: Client ' + Socket.RemoteAddress + ' verbunden.'); Userzahl:=Userzahl +1; labeluser.caption:='User: ' + inttostr(Userzahl); ListBoxUser.Items.Add(Socket.RemoteAddress ); end; procedure TForm1.ServerClientDisconnect(Sender: TObject; Socket: TCustomWinSocket); begin RicheditMaster.Lines.Add('Status: Client ' + Socket.RemoteAddress + ' getrennt.'); Userzahl:=Userzahl -1; labeluser.caption:='User: ' + inttostr(Userzahl); end; procedure TForm1.ServerClientError(Sender: TObject; Socket: TCustomWinSocket; ErrorEvent: TErrorEvent; var ErrorCode: Integer); begin RicheditMaster.Lines.Add('Status: Client ' + socket.RemoteAddress + 'hat den Fehler' + inttostr(Errorcode)); Userzahl:=Userzahl -1; labeluser.caption:='User: ' + inttostr(Userzahl); end; procedure TForm1.ServerClientRead(Sender: TObject; Socket: TCustomWinSocket); var i:integer; Nachricht: AnsiString; Color: TColor; c: string; begin Nachricht:= Socket.ReceiveText; c := copy(Nachricht, 1,6); delete(Nachricht, 1,6); Color:=StrToInt(('$' + c)); for i := 0 to server.Socket.ActiveConnections - 1 do server.socket.Connections[i].SendText(Nachricht); end; end. Versuch es bitte ![]() |
![]() |
Ansicht |
![]() |
![]() |
![]() |
ForumregelnEs ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.
BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus. Trackbacks are an
Pingbacks are an
Refbacks are aus
|
|
Nützliche Links |
Heutige Beiträge |
Sitemap |
Suchen |
Code-Library |
Wer ist online |
Alle Foren als gelesen markieren |
Gehe zu... |
LinkBack |
![]() |
![]() |