Adds a serial client-server communication example

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@1328 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat
2010-09-27 13:26:17 +00:00
parent 7fad6b83aa
commit 6c099ee5de
5 changed files with 661 additions and 0 deletions

View File

@ -0,0 +1,165 @@
object formSerial: TformSerial
Left = 316
Height = 320
Top = 119
Width = 240
Caption = 'Serial File Transfer'
ClientHeight = 320
ClientWidth = 240
OnCreate = FormCreate
OnDestroy = FormDestroy
LCLVersion = '0.9.29'
object btnConnect: TButton
Left = 49
Height = 25
Top = 264
Width = 135
Caption = 'Connect'
OnClick = btnConnectClick
TabOrder = 0
end
object comboClientServer: TComboBox
Left = 120
Height = 21
Top = 176
Width = 108
ItemHeight = 13
ItemIndex = 0
Items.Strings = (
'Server'
'Client'
)
TabOrder = 1
Text = 'Server'
end
object Label2: TLabel
Left = 8
Height = 14
Top = 144
Width = 83
Caption = 'Serial port name:'
ParentColor = False
end
object editDevice: TEdit
Left = 120
Height = 21
Top = 144
Width = 108
TabOrder = 2
Text = 'COM1'
end
object Label3: TLabel
Left = 13
Height = 14
Top = 176
Width = 35
Caption = 'Act as:'
ParentColor = False
end
object Label4: TLabel
Left = 11
Height = 14
Top = 205
Width = 46
Caption = 'File path:'
ParentColor = False
end
object Label5: TLabel
Left = -1
Height = 24
Top = 8
Width = 240
Alignment = taCenter
AutoSize = False
Caption = 'Serial File Transfer'
Font.Height = -18
ParentColor = False
ParentFont = False
end
object editFileName: TFileNameEdit
Left = 80
Height = 21
Top = 200
Width = 128
DialogOptions = []
FilterIndex = 0
HideDirectories = False
ButtonWidth = 23
NumGlyphs = 0
MaxLength = 0
TabOrder = 3
end
object editFileSize: TLabeledEdit
Left = 13
Height = 21
Top = 240
Width = 53
EditLabel.AnchorSideLeft.Control = editFileSize
EditLabel.AnchorSideTop.Control = editFileSize
EditLabel.AnchorSideTop.Side = asrCenter
EditLabel.AnchorSideRight.Control = editFileSize
EditLabel.AnchorSideBottom.Control = editFileSize
EditLabel.Left = 13
EditLabel.Height = 14
EditLabel.Top = 223
EditLabel.Width = 80
EditLabel.Caption = 'File size (Bytes):'
EditLabel.ParentColor = False
ReadOnly = True
TabOrder = 4
end
object ScrollBox1: TScrollBox
Left = 8
Height = 102
Top = 32
Width = 227
ClientHeight = 81
ClientWidth = 206
TabOrder = 5
object Label1: TLabel
Left = 0
Height = 160
Top = 0
Width = 216
AutoSize = False
Caption = 'Serial client-server communication test. Two instances of this program should be running. One in a client machine and another in a server machine. The server will send a file to the client. Both should specify the correct serial port name, a file path (of the file to be sent or where to place the received file) and both should connect to each other within 10 seconds in order for the communication to occur.'
ParentColor = False
WordWrap = True
end
end
object StatusBar: TStatusBar
Left = 0
Height = 23
Top = 297
Width = 240
Panels = <>
SimplePanel = False
end
object editReceivedFileName: TLabeledEdit
Left = 120
Height = 21
Top = 240
Width = 108
EditLabel.AnchorSideLeft.Control = editReceivedFileName
EditLabel.AnchorSideBottom.Control = editReceivedFileName
EditLabel.Left = 120
EditLabel.Height = 14
EditLabel.Top = 223
EditLabel.Width = 95
EditLabel.Caption = 'Received file name:'
EditLabel.ParentColor = False
TabOrder = 7
end
object timerServerConnect: TTimer
Enabled = False
OnTimer = timerServerConnectTimer
left = 136
top = 224
end
object timerClientConnect: TTimer
Enabled = False
OnTimer = timerClientConnectTimer
left = 176
top = 224
end
end

View File

@ -0,0 +1,242 @@
unit mainform;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs, StdCtrls,
EditBtn, ExtCtrls, ComCtrls,
synaser;
type
{ TformSerial }
TformSerial = class(TForm)
btnConnect: TButton;
comboClientServer: TComboBox;
editDevice: TEdit;
editFileName: TFileNameEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
editFileSize: TLabeledEdit;
editReceivedFileName: TLabeledEdit;
ScrollBox1: TScrollBox;
StatusBar: TStatusBar;
timerClientConnect: TTimer;
timerServerConnect: TTimer;
procedure btnConnectClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure timerClientConnectTimer(Sender: TObject);
procedure timerServerConnectTimer(Sender: TObject);
private
{ private declarations }
connected: Boolean;
ser: TBlockSerial;
procedure ServerSendFile();
procedure ClientReceiveFile();
public
{ public declarations }
end;
var
formSerial: TformSerial;
implementation
const
INT_COMBO_SERVER = 0;
INT_COMBO_CLIENT = 1;
// Data records
BYTE_REQUEST_CONNECTION = $00;
// Followed by nothing else
BYTE_ACCEPT_CONNECTION = $01;
// Followed by nothing else
BYTE_FILE_NAME = $02;
// Followed by:
// File name size - 1 Byte indicating the size sz_size. The name doesn't include path.
// File name - sz_size bytes in UTF-8
BYTE_FILE_DATA = $03;
// Followed by:
// File size - 8 Bytes, a Int64 in Little Endian, indicates sz_size
// File data - sz_size bytes
{$R *.lfm}
{ TformSerial }
procedure TformSerial.FormCreate(Sender: TObject);
begin
ser := TBlockSerial.Create;
end;
procedure TformSerial.btnConnectClick(Sender: TObject);
begin
btnConnect.Enabled := False;
try
if connected then raise Exception.Create('Already connected');
// Check the input data
if (editDevice.Text = '') then raise Exception.Create('Invalid serial port name');
if (editFileName.Text = '') then raise Exception.Create('Invalid file path');
if (comboClientServer.ItemIndex = INT_COMBO_SERVER)
and (not FileExists(editFileName.Text)) then raise Exception.Create('Invalid input file. It doesn''t exist');
if (comboClientServer.ItemIndex = INT_COMBO_CLIENT)
and (not DirectoryExists(editFileName.Text)) then raise Exception.Create('Invalid output directory. It doesn''t exist');
StatusBar.SimpleText := 'Connecting';
Application.ProcessMessages;
ser.Connect(editDevice.Text); //ComPort
Sleep(1000);
Application.ProcessMessages;
ser.config(115000, 8, 'N', SB1, False, False);
Sleep(1000);
Application.ProcessMessages;
StatusBar.SimpleText := 'Device: ' + ser.Device +
' Status: ' + ser.LastErrorDesc + ' ' +
Inttostr(ser.LastError);
if ser.LastError = 0 then connected := True;
if comboClientServer.ItemIndex = INT_COMBO_SERVER then
timerServerConnect.Enabled := True
else
timerClientConnect.Enabled := True;
finally
btnConnect.Enabled := True;
end;
end;
procedure TformSerial.FormDestroy(Sender: TObject);
begin
ser.free;
end;
procedure TformSerial.timerClientConnectTimer(Sender: TObject);
var
Data: Byte;
begin
Data := ser.RecvByte(timerClientConnect.Interval div 2);
if (Data = BYTE_REQUEST_CONNECTION) and (ser.LastError = 0) then
begin
Connected := True;
timerClientConnect.Enabled := False;
ser.SendByte(BYTE_ACCEPT_CONNECTION);
ClientReceiveFile();
end;
end;
procedure TformSerial.timerServerConnectTimer(Sender: TObject);
var
Data: Byte;
begin
ser.SendByte(BYTE_REQUEST_CONNECTION);
Data := ser.RecvByte(timerServerConnect.Interval div 2);
if (Data = BYTE_ACCEPT_CONNECTION) and (ser.LastError = 0) then
begin
Connected := True;
timerServerConnect.Enabled := False;
ServerSendFile();
end;
end;
procedure TformSerial.ServerSendFile();
var
ShortStr: shortstring;
Data, StrLen: Byte;
i: Integer;
lStream: TFileStream;
lSize: Int64;
begin
StatusBar.SimpleText := 'Sending file';
Application.ProcessMessages;
// Send the file name:
ShortStr := ExtractFileName(editFileName.Text);
StrLen := Length(ShortStr);
ser.SendByte(BYTE_FILE_NAME);
ser.SendByte(StrLen);
for i := 1 to StrLen do
ser.SendByte(Byte(ShortStr[i]));
// Send the file data:
lStream := TFileStream.Create(editFileName.Text, fmOpenRead);
try
lSize := Length(ShortStr);
ser.SendByte(BYTE_FILE_DATA);
ser.SendBuffer(@lSize, 8);
for i := 0 to lSize - 1 do
begin
Data := lStream.ReadByte();
ser.SendByte(Data);
// Process messages each 100 bytes
if (i div 100) = 0 then Application.ProcessMessages();
end;
finally
lStream.Free;
end;
end;
procedure TformSerial.ClientReceiveFile();
var
ShortStr: shortstring;
Data, StrLen: Byte;
i: Integer;
lStream: TFileStream;
lSize: Int64;
filePath: string;
begin
StatusBar.SimpleText := 'Receiving file';
Application.ProcessMessages;
// Read the file name:
Data := ser.RecvByte(5000);
// Process any remaining connect messages
while (Data = BYTE_REQUEST_CONNECTION) do
Data := ser.RecvByte(5000);
if (Data <> BYTE_FILE_NAME) then raise Exception.Create('Expected record BYTE_FILE_SIZE, but received: ' + IntToStr(Data));
StrLen := ser.RecvByte(5000);
ShortStr := '';
for i := 1 to StrLen do
ShortStr := ShortStr + Char(ser.RecvByte(1000));
editReceivedFileName.Text := ShortStr;
// Read the file data:
Data := ser.RecvByte(5000);
if (Data <> BYTE_FILE_DATA) then raise Exception.Create('Expected record BYTE_FILE_DATA, but received: ' + IntToStr(Data));
filePath := IncludeTrailingPathDelimiter(editFileName.Text) + editReceivedFileName.Text;
lStream := TFileStream.Create(filePath, fmOpenWrite or fmCreate);
try
ser.RecvBuffer(@lSize, 8);
for i := 0 to lSize - 1 do
begin
Data := ser.RecvByte(1000);
lStream.WriteByte(Data);
// Process messages each 100 bytes
if (i div 100) = 0 then Application.ProcessMessages();
end;
finally
lStream.Free;
end;
end;
end.

Binary file not shown.

After

Width:  |  Height:  |  Size: 134 KiB

View File

@ -0,0 +1,234 @@
<?xml version="1.0"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<General>
<MainUnit Value="0"/>
<Title Value="serialfilesend"/>
<ResourceType Value="res"/>
<UseXPManifest Value="True"/>
<Icon Value="0"/>
<ActiveWindowIndexAtStart Value="0"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<PublishOptions>
<Version Value="2"/>
<IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
<ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
</local>
</RunParams>
<RequiredPackages Count="2">
<Item1>
<PackageName Value="laz_synapse"/>
</Item1>
<Item2>
<PackageName Value="LCL"/>
</Item2>
</RequiredPackages>
<Units Count="4">
<Unit0>
<Filename Value="serialfilesend.lpr"/>
<IsPartOfProject Value="True"/>
<UnitName Value="serialfilesend"/>
<UsageCount Value="21"/>
</Unit0>
<Unit1>
<Filename Value="mainform.pas"/>
<IsPartOfProject Value="True"/>
<ComponentName Value="formSerial"/>
<ResourceBaseClass Value="Form"/>
<UnitName Value="mainform"/>
<IsVisibleTab Value="True"/>
<EditorIndex Value="0"/>
<WindowIndex Value="0"/>
<TopLine Value="210"/>
<CursorPos X="41" Y="224"/>
<UsageCount Value="21"/>
<Loaded Value="True"/>
<LoadedDesigner Value="True"/>
</Unit1>
<Unit2>
<Filename Value="../../../lazarus29/fpc/2.4.3/source/rtl/inc/objpash.inc"/>
<EditorIndex Value="2"/>
<WindowIndex Value="0"/>
<TopLine Value="171"/>
<CursorPos X="23" Y="185"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit2>
<Unit3>
<Filename Value="../../../lazarus29/fpc/2.4.3/source/rtl/objpas/classes/classesh.inc"/>
<EditorIndex Value="1"/>
<WindowIndex Value="0"/>
<TopLine Value="841"/>
<CursorPos X="3" Y="855"/>
<UsageCount Value="10"/>
<Loaded Value="True"/>
</Unit3>
</Units>
<JumpHistory Count="30" HistoryIndex="29">
<Position1>
<Filename Value="mainform.pas"/>
<Caret Line="140" Column="1" TopLine="116"/>
</Position1>
<Position2>
<Filename Value="mainform.pas"/>
<Caret Line="52" Column="29" TopLine="43"/>
</Position2>
<Position3>
<Filename Value="mainform.pas"/>
<Caret Line="146" Column="1" TopLine="118"/>
</Position3>
<Position4>
<Filename Value="mainform.pas"/>
<Caret Line="95" Column="31" TopLine="79"/>
</Position4>
<Position5>
<Filename Value="mainform.pas"/>
<Caret Line="110" Column="1" TopLine="101"/>
</Position5>
<Position6>
<Filename Value="mainform.pas"/>
<Caret Line="103" Column="10" TopLine="79"/>
</Position6>
<Position7>
<Filename Value="mainform.pas"/>
<Caret Line="104" Column="10" TopLine="80"/>
</Position7>
<Position8>
<Filename Value="mainform.pas"/>
<Caret Line="103" Column="10" TopLine="79"/>
</Position8>
<Position9>
<Filename Value="mainform.pas"/>
<Caret Line="104" Column="10" TopLine="80"/>
</Position9>
<Position10>
<Filename Value="mainform.pas"/>
<Caret Line="103" Column="10" TopLine="79"/>
</Position10>
<Position11>
<Filename Value="mainform.pas"/>
<Caret Line="102" Column="1" TopLine="83"/>
</Position11>
<Position12>
<Filename Value="mainform.pas"/>
<Caret Line="167" Column="1" TopLine="143"/>
</Position12>
<Position13>
<Filename Value="mainform.pas"/>
<Caret Line="70" Column="1" TopLine="46"/>
</Position13>
<Position14>
<Filename Value="mainform.pas"/>
<Caret Line="179" Column="29" TopLine="160"/>
</Position14>
<Position15>
<Filename Value="mainform.pas"/>
<Caret Line="180" Column="15" TopLine="160"/>
</Position15>
<Position16>
<Filename Value="mainform.pas"/>
<Caret Line="55" Column="26" TopLine="46"/>
</Position16>
<Position17>
<Filename Value="mainform.pas"/>
<Caret Line="221" Column="6" TopLine="198"/>
</Position17>
<Position18>
<Filename Value="mainform.pas"/>
<Caret Line="204" Column="20" TopLine="204"/>
</Position18>
<Position19>
<Filename Value="mainform.pas"/>
<Caret Line="149" Column="8" TopLine="135"/>
</Position19>
<Position20>
<Filename Value="mainform.pas"/>
<Caret Line="83" Column="3" TopLine="69"/>
</Position20>
<Position21>
<Filename Value="mainform.pas"/>
<Caret Line="81" Column="1" TopLine="69"/>
</Position21>
<Position22>
<Filename Value="mainform.pas"/>
<Caret Line="53" Column="1" TopLine="43"/>
</Position22>
<Position23>
<Filename Value="mainform.pas"/>
<Caret Line="151" Column="42" TopLine="145"/>
</Position23>
<Position24>
<Filename Value="mainform.pas"/>
<Caret Line="178" Column="35" TopLine="164"/>
</Position24>
<Position25>
<Filename Value="mainform.pas"/>
<Caret Line="214" Column="22" TopLine="200"/>
</Position25>
<Position26>
<Filename Value="mainform.pas"/>
<Caret Line="64" Column="17" TopLine="46"/>
</Position26>
<Position27>
<Filename Value="mainform.pas"/>
<Caret Line="223" Column="1" TopLine="206"/>
</Position27>
<Position28>
<Filename Value="mainform.pas"/>
<Caret Line="224" Column="15" TopLine="210"/>
</Position28>
<Position29>
<Filename Value="mainform.pas"/>
<Caret Line="41" Column="1" TopLine="29"/>
</Position29>
<Position30>
<Filename Value="mainform.pas"/>
<Caret Line="224" Column="38" TopLine="210"/>
</Position30>
</JumpHistory>
</ProjectOptions>
<CompilerOptions>
<Version Value="9"/>
<Target>
<Filename Value="serialfilesend"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib/$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Linking>
<Options>
<Win32>
<GraphicApplication Value="True"/>
</Win32>
</Options>
</Linking>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="3">
<Item1>
<Name Value="EAbort"/>
</Item1>
<Item2>
<Name Value="ECodetoolError"/>
</Item2>
<Item3>
<Name Value="EFOpenError"/>
</Item3>
</Exceptions>
</Debugging>
</CONFIG>

View File

@ -0,0 +1,20 @@
program serialfilesend;
{$mode objfpc}{$H+}
uses
{$IFDEF UNIX}{$IFDEF UseCThreads}
cthreads,
{$ENDIF}{$ENDIF}
Interfaces, // this includes the LCL widgetset
Forms, laz_synapse, mainform
{ you can add units after this };
{$R *.res}
begin
Application.Initialize;
Application.CreateForm(TformSerial, formSerial);
Application.Run;
end.