Hab das Programm mal wie folgt abgeändertMAC hat geschrieben:Das sieht ziemlich richtig aus.
Das die Prozedure nicht aufgerufen wird scheint wohl daran zu liegen, das es zwar ein Server gibt, allerdings kein Client der darauf zugreift.
Oder gibt es auch noch eine Client-Komponente auf dem Formular (Server und Client ist technisch das gleiche, schmeis einfach noch ne 2te Komponente drauf die du dann mit den Server verbinden lässt...
Quelltext:
Code: Alles auswählen
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
ExtCtrls, lNetComponents, lNet;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
Button5: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Client: TLTCPComponent;
IP: TLabeledEdit;
Memo1: TMemo;
Server: TLTCPComponent;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure ClientConnect(aSocket: TLSocket);
procedure ClientDisconnect(aSocket: TLSocket);
procedure ClientError(const msg: string; aSocket: TLSocket);
procedure ClientReceive(aSocket: TLSocket);
procedure ServerAccept(aSocket: TLSocket);
procedure ServerDisconnect(aSocket: TLSocket);
procedure ServerError(const msg: string; aSocket: TLSocket);
procedure ServerReceive(aSocket: TLSocket);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var Port: Integer;
ServerIP: String;
Verbindungsaufbau: Boolean;
begin
Port := StrToInt(Edit1.Text);
Verbindungsaufbau := Server.Listen(Port);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Server.Disconnect(True);
Memo1.Append('Server wurde Deaktiviert');
end;
procedure TForm1.Button3Click(Sender: TObject);
var sendetext : String;
begin
sendetext := Edit1.text;
if (sendetext <> ' ') then
Server.SendMessage(sendetext);
end;
procedure TForm1.Button4Click(Sender: TObject);
var Port : integer;
ServerIP : String;
Verbindungsaufbau : boolean;
begin
Port := StrToInt(Edit1.Text);
ServerIP := IP.Text;
Verbindungsaufbau := Client.Connect(ServerIP,Port);
if Verbindungsaufbau then
Memo1.Append('Die Verbindung wird aufgebaut . . .');
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
client.Disconnect(true);
end;
procedure TForm1.ClientConnect(aSocket: TLSocket);
begin
Memo1.append ('Verbindung zum Server mit der IP ' + aSocket.LocalAddress +' wurde hergestellt');
end;
procedure TForm1.ClientDisconnect(aSocket: TLSocket);
begin
Memo1.append ('Verbindung zum Server wurde getrennt');
end;
procedure TForm1.ClientError(const msg: string; aSocket: TLSocket);
begin
Memo1.Append('Fehlermeldung: ' + msg);
end;
procedure TForm1.ClientReceive(aSocket: TLSocket);
var Eingangstext : String;
begin
aSocket.GetMessage(Eingangstext);
Memo1.append ('Eingehende Nachricht: ' + Eingangstext);
end;
procedure TForm1.ServerAccept(aSocket: TLSocket);
begin
Label1.Caption:= aSocket.LocalAddress;
Memo1.Append('Verbindung Zum Client mit der IP: ' + aSocket.LocalAddress + ' wurde hergestellt');
end;
procedure TForm1.ServerDisconnect(aSocket: TLSocket);
begin
Memo1.Append('Verbindung zum Client wurde getrennt.');
end;
procedure TForm1.ServerError(const msg: string; aSocket: TLSocket);
begin
Memo1.Append('Fehlermeldung: ' + msg);
end;
procedure TForm1.ServerReceive(aSocket: TLSocket);
var Eingangstext: String;
begin
aSocket.GetMessage(Eingangstext);
Memo1.Append('Eingehende Nachricht: ' + Eingangstext);
end;
end.Code: Alles auswählen
object Form1: TForm1
Left = 445
Height = 297
Top = 225
Width = 304
Caption = 'Form1'
ClientHeight = 297
ClientWidth = 304
LCLVersion = '0.9.31'
object Label1: TLabel
Left = 10
Height = 18
Top = 10
Width = 27
Caption = 'Port'
ParentColor = False
end
object Edit1: TEdit
Left = 10
Height = 27
Top = 32
Width = 126
TabOrder = 0
Text = '5000'
end
object Button1: TButton
Left = 10
Height = 29
Hint = 'Auch Client verbinden'
Top = 96
Width = 124
AutoSize = True
Caption = 'Server &aktivieren'
OnClick = Button1Click
ParentShowHint = False
ShowHint = True
TabOrder = 1
end
object Button2: TButton
Left = 148
Height = 29
Top = 96
Width = 140
AutoSize = True
Caption = 'Server &deaktivieren'
OnClick = Button2Click
TabOrder = 2
end
object Memo1: TMemo
Left = 10
Height = 120
Top = 128
Width = 278
ScrollBars = ssAutoBoth
TabOrder = 3
end
object Edit2: TEdit
Left = 10
Height = 27
Top = 256
Width = 179
TabOrder = 4
Text = 'Edit2'
end
object Button3: TButton
Left = 229
Height = 29
Top = 256
Width = 59
AutoSize = True
Caption = '&senden'
OnClick = Button3Click
TabOrder = 5
end
object IP: TLabeledEdit
Left = 148
Height = 27
Top = 32
Width = 140
EditLabel.AnchorSideLeft.Control = IP
EditLabel.AnchorSideRight.Control = IP
EditLabel.AnchorSideRight.Side = asrBottom
EditLabel.AnchorSideBottom.Control = IP
EditLabel.Left = 148
EditLabel.Height = 18
EditLabel.Top = 11
EditLabel.Width = 140
EditLabel.Caption = 'IP'
EditLabel.ParentColor = False
TabOrder = 6
end
object Button4: TButton
Left = 10
Height = 29
Top = 64
Width = 77
AutoSize = True
Caption = '&Verbinden'
OnClick = Button4Click
TabOrder = 7
end
object Button5: TButton
Left = 148
Height = 29
Top = 64
Width = 63
AutoSize = True
Caption = '&Trennen'
OnClick = Button5Click
TabOrder = 8
end
object Server: TLTCPComponent
Port = 0
OnReceive = ServerReceive
OnError = ServerError
OnDisconnect = ServerDisconnect
OnAccept = ServerAccept
Timeout = 0
ReuseAddress = True
left = 176
top = 160
end
object Client: TLTCPComponent
Port = 0
OnReceive = ClientReceive
OnError = ClientError
OnDisconnect = ClientDisconnect
OnConnect = ClientConnect
Timeout = 0
ReuseAddress = False
left = 136
top = 160
end
endCode: Alles auswählen
Die Verbindung wird aufgebaut . . .
Verbindung zum Server mit der IP 192.168.178.22 wurde hergestellt
Fehlermeldung: Error on bind [13]: Permission deniedWerd ich wohl noch mal etwas rumbasteln müßen, da ich die Fehlermeldung mal so verstehe, das mein Leppi (IP: 192.168.178.22) nicht als Server laufen will.
und der Kreis Segeberg meine 
Verein
Links
Suche