unit dtest05unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, ScktComp, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Server1: TServerSocket;
StatusBar1: TStatusBar;
Label1: TLabel;
ListBox1: TListBox;
ListBox2: TListBox;
Button1: TButton;
SaveBox2: TButton;
Timer2: TTimer;
Label2: TLabel;
procedure Server1Listen(Sender: TObject;
Socket: TCustomWinSocket);
procedure Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure Server1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Server1ClientRead(Sender: TObject; Socket: TCustomWinSocket);
procedure Server1ClientError(Sender: TObject; Socket: TCustomWinSocket;
ErrorEvent: TErrorEvent; var ErrorCode: Integer);
procedure Timer1Timer(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure SaveBox2Click(Sender: TObject);
procedure Timer2Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
end;
var
Form1: TForm1;
Const
Clients: Integer = -1; //typisierte Variable Zahl der Clients
Zahl: Byte=0;
implementation
{$R *.DFM}
procedure TForm1.Server1Listen(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.Panels [0].Text :='Listen';
end;
procedure TForm1.Server1ClientConnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.Panels [0].Text :='Connected';
StatusBar1.Panels [1].Text :='';
Inc(Clients);
end;
procedure TForm1.Server1ClientDisconnect(Sender: TObject;
Socket: TCustomWinSocket);
begin
StatusBar1.Panels [0].Text :='Disconnected';
Dec(Clients);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Server1.Active := True;
Label2.Caption:='';
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Server1.Active := False ;
end;
procedure TForm1.Server1ClientRead(Sender: TObject;
Socket: TCustomWinSocket);
var
i:Integer;
s:String;
begin
// Label1.Caption := Server1.Socket.Connections [0].ReceiveText;
for i:= 0 to Clients Do begin
Application.ProcessMessages;
Try
Begin
s:=Server1.Socket.Connections [i].ReceiveText;
if s<>'' then begin
ListBox2.Items.Add(s);
ListBox1.Items.Add(Server1.Socket.Connections[i].RemoteAddress);
End
End;
Except
Break;
End;
end;
end;
procedure TForm1.Server1ClientError(Sender: TObject;
Socket: TCustomWinSocket; ErrorEvent: TErrorEvent;
var ErrorCode: Integer);
begin
StatusBar1.Panels [0].Text :='Error:'+IntToStr(ErrorCode);
ErrorCode:=0;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
var
i:Integer;
begin
// send text to client
for i:= 0 to Clients Do begin
Server1.Socket.Connections [i].SendText(IntToStr(Zahl));
end;
// Form1.Caption:=IntToStr(Zahl);
// Inc(Zahl);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ListBox1.Clear;
ListBox2.Clear;
end;
procedure TForm1.SaveBox2Click(Sender: TObject);
var
f : TextFile;
i : Word;
begin
AssignFile (f,'testdata.htm');
Rewrite (f);
Writeln(f,' uC Messdaten ');
Writeln(f,'Messdaten vom Atmel Controller');
end;
Writeln(f,'');
CloseFile (f);
end;
procedure TForm1.Timer2Timer(Sender: TObject);
var
f : TextFile;
i : Word;
begin
AssignFile (f,'testdata.htm');
{$I-}
Rewrite (f);
{$I+}
If IoResult <> 0 Then Begin
ShowMessage ('Fehler beim Schreiben der Datei!');
End;
Writeln(f,' uC Messdaten ');
Writeln(f,'Messdaten vom Atmel Controller');
end;
end;
Writeln(f,'');
CloseFile (f);
end;
end.