unit KBS;
interface
uses
Winapi.Windows,
Winapi.Messages, System.SysUtils, System.Variants,
System.Classes,
Vcl.Graphics,
Vcl.Controls,
Vcl.Forms,
Vcl.Dialogs, IdBaseComponent, IdComponent, idsync,
IdTCPConnection, IdTCPClient,
Vcl.StdCtrls,
Vcl.ExtCtrls, IdGlobal;
type
TForm1 =
class(TForm)
MemoReceive: TMemo;
Button1: TButton;
ClientReceive: TIdTCPClient;
Button2: TButton;
ClientSend: TIdTCPClient;
Button3: TButton;
MemoSend: TMemo;
Edit1: TEdit;
Label1: TLabel;
Button4: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ClientReceiveConnected(Sender: TObject);
procedure ClientReceiveDisconnected(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure ClientSendConnected(Sender: TObject);
procedure ClientSendDisconnected(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
TReadingThread =
class(TThread)
protected
FConn: TIdTCPConnection;
procedure Execute;
override;
procedure DoTerminate;
override;
public
constructor Create(AConn: TIdTCPConnection);
reintroduce;
end;
TWritingThread =
class(TThread)
protected
FConn: TIdTCPConnection;
procedure Execute;
override;
procedure DoTerminate;
override;
public
constructor Create(AConn: TIdTCPConnection);
reintroduce;
end;
TLogReceive =
class(TidSync)
protected
FMsg:
String;
procedure DoSynchronize;
override;
public
constructor Create(
const AMsg:
String);
class procedure AddMsg(
const AMsg:
String);
end;
TLogSend =
class(TidSync)
protected
FMsg:
String;
procedure DoSynchronize;
override;
public
constructor Create(
const AMsg:
String);
class procedure AddMsg(
const AMsg:
String);
end;
var
KBSForm: TForm1;
rt: TReadingThread =
nil;
wt: TWritingThread =
nil;
(*
WelchesLicht: Name Lichtes, in WinKomm Basis heißt es "Adresse"
ObenFarbe: 'rot', 'gruen', 'blau', 'gelb', 'cyan', 'magenta', 'weiß'
Obenlicht: 0 ist aus, 1 ist an, 2 ist blinken und 3 ist blinken in der gegengesezten Phase zu 2
UntenFarbe und UntenLicht genau wie Oben*
Rückgabe: Fehlertext oder leer
*)
function LichtSteuern(WelchesLicht:
string; ObenFarbe:
string;
ObenLicht: Integer; UntenFarbe:
string; UntenLicht: Integer):
string;
implementation
uses
t_zeiten, System.IniFiles;
var
TelegramNr:
string = '
00';
LVdelay: Cardinal;
sendCounter: Integer = 1;
CommissionNumber: Integer = 1;
SendeString:
string = '
';
{$R *.dfm}
constructor TReadingThread.Create(AConn: TIdTCPConnection);
begin
TLogReceive.AddMsg('
DEBUG: TReadingThread.Create');
FConn := AConn;
inherited Create(False);
end;
constructor TWritingThread.Create(AConn: TIdTCPConnection);
begin
TLogSend.AddMsg('
DEBUG: TWritingThread.Create');
FConn := AConn;
inherited Create(False);
end;
procedure TReadingThread.Execute;
var
cmd, tcpStringSend:
string;
begin
TLogReceive.AddMsg('
DEBUG: TReadingThread.Execute');
while not Terminated
do
begin
cmd := FConn.IOHandler.ReadLn(#3, IndyTextEncoding_ASCII);
cmd := trim(cmd);
TLogReceive.AddMsg('
Rcv: ' + cmd);
TelegramNr := copy(cmd, 1, 2);
tcpStringSend := #2 + TelegramNr + '
001050QU' + #3;
FConn.IOHandler.WriteLn(tcpStringSend, IndyTextEncoding_ASCII);
TLogReceive.AddMsg('
Send: ' + trim(tcpStringSend));
end;
end;
procedure TWritingThread.Execute;
var
cmd, tcpStringSend, CommissionNumberS, SendCounterS:
string;
begin
TLogSend.AddMsg('
DEBUG: TWritingThread.Execute');
while not Terminated
do
begin
tcpStringSend := '
';
SendCounterS := '
';
CommissionNumberS := '
';
if elapsedtime(LVdelay) > 10
then
begin
if sendCounter > 99
then
sendCounter := 1;
SendCounterS := IntToStr(sendCounter);
if length(SendCounterS) < 2
then
SendCounterS := '
0' + SendCounterS;
tcpStringSend := #2 + SendCounterS + '
001050LV' + #3;
FConn.IOHandler.WriteLn(tcpStringSend, IndyTextEncoding_ASCII);
TLogSend.AddMsg('
Send: ' + trim(tcpStringSend));
inc(sendCounter);
marktime(LVdelay);
cmd := FConn.IOHandler.ReadLn(#3, IndyTextEncoding_ASCII);
cmd := trim(cmd);
TLogSend.AddMsg('
Rcv: ' + cmd);
end;
if SendeString <> '
'
then
begin
if sendCounter > 99
then
sendCounter := 1;
SendCounterS := IntToStr(sendCounter);
if length(SendCounterS) < 2
then
SendCounterS := '
0' + SendCounterS;
if CommissionNumber > 9990
then
CommissionNumber := 1;
CommissionNumberS := IntToStr(CommissionNumber);
while length(CommissionNumberS) < 4
do
CommissionNumberS := '
0' + CommissionNumberS;
tcpStringSend := #2 + SendCounterS + '
001050DILampe1 ' +
CommissionNumberS + #27 + SendeString + #3;
SendeString := '
';
FConn.IOHandler.WriteLn(tcpStringSend, IndyTextEncoding_ASCII);
TLogSend.AddMsg('
Send: ' + trim(tcpStringSend));
inc(sendCounter);
inc(CommissionNumber);
cmd := FConn.IOHandler.ReadLn(#3, IndyTextEncoding_ASCII);
cmd := trim(cmd);
TLogSend.AddMsg('
Rcv: ' + cmd);
end;
end;
end;
procedure TReadingThread.DoTerminate;
begin
TLogReceive.AddMsg('
DEBUG: TReadingThread.DoTerminate');
inherited;
end;
procedure TWritingThread.DoTerminate;
begin
TLogSend.AddMsg('
DEBUG: TWritingThread.DoTerminate');
inherited;
end;
constructor TLogReceive.Create(
const AMsg:
string);
begin
inherited Create;
FMsg := AMsg;
end;
constructor TLogSend.Create(
const AMsg:
string);
begin
inherited Create;
FMsg := AMsg;
end;
procedure TLogReceive.DoSynchronize;
begin
KBSForm.MemoReceive.Lines.Add(FMsg);
end;
procedure TLogSend.DoSynchronize;
begin
KBSForm.MemoSend.Lines.Add(FMsg);
end;
class procedure TLogReceive.AddMsg(
const AMsg:
string);
begin
with Create(AMsg)
do
try
Synchronize;
finally
Free;
end;
end;
class procedure TLogSend.AddMsg(
const AMsg:
string);
begin
with Create(AMsg)
do
try
Synchronize;
finally
Free;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
try
ClientReceive.Connect;
except
on E:
Exception do
TLogReceive.AddMsg('
Error: ' + E.
Message);
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
ClientReceive.IOHandler.InputBuffer.Clear;
ClientSend.IOHandler.InputBuffer.Clear;
// xx TEST
try
ClientReceive.Disconnect;
ClientSend.Disconnect;
except
on E:
Exception do
TLogReceive.AddMsg('
Error: ' + E.
Message);
end;
end;
procedure TForm1.Button3Click(Sender: TObject);
begin
if ClientSend.Connected
then
begin
ClientSend.Disconnect;
end
else
begin
try
ClientSend.Connect;
except
on E:
Exception do
begin
MemoSend.Lines.Add(E.
Message);
end;
end;
end;
end;
procedure TForm1.Button4Click(Sender: TObject);
begin
SendeString := Edit1.Text;
end;
procedure TForm1.ClientReceiveConnected(Sender: TObject);
begin
TLogReceive.AddMsg('
DEBUG: TForm1.clientConnected');
rt := TReadingThread.Create(ClientReceive);
end;
procedure TForm1.ClientReceiveDisconnected(Sender: TObject);
begin
TLogReceive.AddMsg('
DEBUG: TForm1.clientDisconnected');
if rt <>
nil then
begin
rt.Terminate;
rt.WaitFor;
FreeAndNil(rt);
end;
end;
procedure TForm1.ClientSendConnected(Sender: TObject);
begin
TLogSend.AddMsg('
DEBUG: TForm1.clientConnected');
wt := TWritingThread.Create(ClientSend);
end;
procedure TForm1.ClientSendDisconnected(Sender: TObject);
begin
TLogSend.AddMsg('
DEBUG: TForm1.clientDisconnected');
if wt <>
nil then
begin
wt.Terminate;
wt.WaitFor;
FreeAndNil(wt);
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
ini: TIniFile;
filename:
string;
begin
MemoReceive.Clear;
marktime(LVdelay);
filename := ExtractFilePath(ParamStr(0)) + '
KBS.ini';
ini := TIniFile.Create(filename);
try
finally
ini.Free;
end;
end;
function LichtSteuern(WelchesLicht:
string; ObenFarbe:
string;
ObenLicht: Integer; UntenFarbe:
string; UntenLicht: Integer):
string;
begin
end;
end.