Hi JohnvdWaeter,
{******************************************************************************
* This is a JohnvdWaeter example to have 32 sockets based on LNet component.
* Almindor is also involved trying to help
*------------------------------------------------------------------------------
* Forum Topic: http://www.lazarus.freepascal.org/index.php/topic,9751.15.html
*------------------------------------------------------------------------------
* Date: 2010/07/11
* Project: My home Air Conditioner control
* Test Fase: Adquire temperature of one sensor
* Future: Adquire temperature of 32 sensors with ON/OFF control
* Comms: Network TCP/IP based
*
* Cliente Software:
* IDE: Lazarus 0.9.26
* Compiler: FPC 2.2.2
* O.S. XP / Vista
******************************************************************************}
unit main;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
StdCtrls, lNetComponents, lNet, ExtCtrls, ComCtrls;
type
TfrmMain = class(TForm)
btnConnect: TButton;
btnDisconnect: TButton;
btnGetTemp: TButton;
btnExit: TButton;
btnSendACK: TButton;
ebxIP: TEdit;
ebxPort: TEdit;
gbxServer: TGroupBox;
gbxCommands: TGroupBox;
lblDebugList: TLabel;
lblIP: TLabel;
lblPort: TLabel;
lbxLog: TListBox;
StatusBar1: TStatusBar;
Timer1: TTimer;
procedure btnConnectClick(Sender: TObject);
procedure btnDisconnectClick(Sender: TObject);
procedure btnExitClick(Sender: TObject);
procedure btnGetPointersClick(Sender: TObject);
procedure btnGetTempClick(Sender: TObject);
procedure btnSendACKClick(Sender: TObject);
procedure MyConnect(aSocket: TLSocket);
procedure MyDisconnect(aSocket: TLSocket);
procedure MyReceive(aSocket: TLSocket);
procedure Timer1Timer(Sender: TObject);
private
public
Constructor Create(TheOwner: TComponent); override;
procedure FormKill(Sender: TObject);
end;
var
frmMain: TfrmMain;
MyTCP : array[1..32] of TLTCPComponent;
NewMsg, OldMsg: string;
constates: integer;
const
CR = #13;
LF = #10;
CRLF = CR + LF;
ACK = '00';
GET_TEMP = 'AE';
implementation
{******************************************************************************
* Init
******************************************************************************}
Constructor TfrmMain.Create(TheOwner: TComponent);
var
x: integer;
s: string;
begin
inherited Create(TheOwner);
OnDestroy := @FormKill;
for x := 1 to 32 do begin
MyTCP[x] := TLTCPComponent.create(nil);
MyTCP[x].OnReceive := @MyReceive;
MyTCP[x].OnConnect := @MyConnect;
MyTCP[x].OnDisconnect:= @MyDisconnect;
end;
NewMsg := '';
ebxIP.Text := '192.168.2.100';
ebxPort.Text := '1001';
btnConnect.Enabled := True;
btnDisconnect.Enabled := False;
ebxIP.Color := clScrollBar;
ebxPort.Color := clScrollBar;
constates := 0;
end;
{******************************************************************************
* Form Close
******************************************************************************}
procedure TfrmMain.FormKill(Sender : TObject);
begin
end;
{******************************************************************************
* Close by Button
******************************************************************************}
procedure TfrmMain.btnExitClick(Sender: TObject);
begin
Close;
end;
{******************************************************************************
* Open Connection by button
******************************************************************************}
procedure TfrmMain.btnConnectClick(Sender: TObject);
begin
constates := 1;
end;
{******************************************************************************
* Disconnect button
******************************************************************************}
procedure TfrmMain.btnDisconnectClick(Sender: TObject);
begin
if MyTCP[1].Connected then begin
MyTCP[1].Disconnect;
btnConnect.Enabled := True;
btnDisconnect.Enabled := False;
ebxIP.Color := clScrollBar;
ebxPort.Color := clScrollBar;
StatusBar1.Panels[1].Text := 'Disconnected';
end;
end;
{******************************************************************************
* Get Temperature button
*------------------------------------------------------------------------------
* Server Module should answer: 'E0XX'+#13#10, where XX teperature in ASCII Hex
******************************************************************************}
procedure TfrmMain.btnGetTempClick(Sender: TObject);
begin
MyTCP[1].SendMessage(GET_TEMP + CRLF);
end;
{******************************************************************************
* Send Acknowlodge: Server also reply ACK
******************************************************************************}
procedure TfrmMain.btnSendACKClick(Sender: TObject);
begin
MyTCP[1].SendMessage(ACK + CRLF);
end;
{******************************************************************************
* OnReceive event
******************************************************************************}
procedure TfrmMain.MyReceive(aSocket: TLSocket);
var s: String;
begin
MyTCP[1].GetMessage(s);
if Length(s) > 3 then begin
lbxLog.Items.Add(copy(s,1, Length(s)-2));
s:='';
end;
end;
{******************************************************************************
* OnConnect event
******************************************************************************}
procedure TfrmMain.MyConnect(aSocket: TLSocket);
begin
btnConnect.Enabled := False;
btnDisconnect.Enabled := True;
StatusBar1.Panels[1].Text:='Connected to: '+ ebxIP.Text+ ':'+ ebxPort.Text;
end;
{******************************************************************************
* OnDisconnect event
******************************************************************************}
procedure TfrmMain.MyDisconnect(aSocket: TLSocket);
begin
btnConnect.Enabled := True;
btnDisconnect.Enabled := False;
StatusBar1.Panels[1].Text:='Disconnected from: '+ ebxIP.Text+ ':'+ ebxPort.Text;
end;
{******************************************************************************
* Try to Connect state machine
*------------------------------------------------------------------------------
* This state machine is needed because server sometimes hangup and reset it self
* during powerup. This is working well on the 1 socket program version
*------------------------------------------------------------------------------
* Right now number of tries are infinite and just work with MyTCP[1].
* In the future we have finite number of tries for each one connection
******************************************************************************}
procedure TfrmMain.Timer1Timer(Sender: TObject);
var s: string;
begin
case constates of
0: begin
end;
1: begin
MyTCP[1].Connect( ebxIP.Text, StrToInt(ebxPort.Text));
constates := 2;
end;
2: begin
MyTCP[1].SendMessage('00'+ CRLF);
ebxIP.Color := clAqua;
ebxPort.Color := clAqua;
constates := 3;
end;
3: if MyTCP[1].Connected then begin
ebxIP.Color := clLime;
ebxPort.Color := clLime;
gbxCommands.Enabled := True;
constates := 0; // Connected. Stop state machine
end
else begin
ebxIP.Color := clScrollBar;
ebxPort.Color := clScrollBar;
constates := 1; // Try again
end;
end;
end;
initialization
{$I main.lrs}
end.
Also i can send all files needed to compile, but i don't see how can do it.
Regards,
Jo