Freepascal / Lazarus på WinCE og serial-port

Hauge

unread,

May 31, 2009, 4:05:52 PM5/31/09

to

Hejsa

Jeg er p� udkik efter et lib til at f� fat i serialporten p� en lille
maskine der k�rer WinCE p� en ARM cpu.

Jeg skal bruge det til Lazarus, og har gennemgnavet nettet de sidste par
dage, og kan intet finde der kan bruges.

H�ber der er en der kan lede mig lidt p� vej.

Mvh Hauge

Carsten

unread,

Jun 16, 2009, 10:12:03 AM6/16/09

to

Hauge wrote:
> Hejsa
>
> Jeg er p� udkik efter et lib til at f� fat i serialporten p� en lille
> maskine der k�rer WinCE p� en ARM cpu.

Jeg kunne forstille mig at metoden er den samme som under Windows.
Her er noget kode som er skrevet til Delphi 2. Jeg ved det virker til
Windows, men jeg blev aldrig f�rdig, da jeg ikke fik brug for det.
Det er ikke s�rligt k�nt, men det kan m�ske lede dig p� rette spor.

Carsten

-------------------------

Library comlib;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, DBCtrls;

type
comPort_typ=array[0..5] of char;
TComInit = class(TForm)
Label1: TLabel;
Button1: TButton;
ComboBox1: TComboBox;
Label2: TLabel;
Label3: TLabel;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure ComboBox1Change(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

function ComOpen(na:comPort_typ; br:LongInt):boolean;
function ComSetUp:boolean;
function ComClose:boolean;
function sendStr(s:ShortString):integer;
function reciveStr(var s:shortString):integer;

var
ComInit: TComInit;
comConfig:TCommConfig;
ComHandle:Integer;
comPort:comPort_typ;
boadRate:longInt;

implementation

uses Unit1;

const
comInitCaption_t= 'Comport valg og ops�tning';
AvanceretIndstillinger_t= 'Avanceret indstillinger';
ValgAfComPort_t= 'Valg af COM port';
FileFlag= file_flag_overlapped;
BoadRate_t= 'Boad rate:';
openComBool:boolean=false;

var
comFile:textFile;
comSecurity:psecurityAttributes;
comTimeOuts:tCommtimeOuts;
overlapped:tOverlapped;
{$R *.DFM}

function createFile_:boolean;
begin
createFile_:=false;
Comhandle:=CreateFile(comPort,generic_read+generic_write,0,nil,open_existing,FileFlag,0);
if Comhandle<0 then begin

messageDlg('CreateFile:'+SysErrorMessage(getLastError),mtWarning,[mbOK],0);
exit;
end;
if not GetCommTimeOuts(Comhandle,comTimeOuts) then begin
messageDlg('Get Comm
TimeOut:'+SysErrorMessage(getLastError),mtWarning,[mbOK],0);
exit;
end;
ComTimeOuts.ReadIntervalTimeOut:=100;
ComTimeOuts.ReadTotalTimeOutMultiplier:=20;
ComTimeOuts.ReadTotalTimeOutConstant:=100;
ComTimeOuts.WriteTotalTimeOutMultiplier:=20;
ComTimeOuts.WriteTotalTimeOutConstant:=100;
if not setCommTimeOuts(Comhandle,comTimeOuts) then begin
messageDlg('Set Comm
TimeOut:'+SysErrorMessage(getLastError),mtWarning,[mbOK],0);
exit;
end;
if not GetCommConfig(comHandle,comConfig,comConfig.DwSize) then begin
messageDlg('Get Comm
Comfig:'+SysErrorMessage(getLastError),mtWarning,[mbOK],0);
exit;
end;
comConfig.dcb.BaudRate:=boadRate;
if not setCommConfig(comHandle,comConfig,sizeOf(comConfig)) then begin
messageDlg('Set Comm
Comfig:'+SysErrorMessage(getLastError),mtWarning,[mbOK],0);
exit;
end;
createFile_:=true;
end;

function ComSetup:boolean;
var ci:comport_typ;
m,h:integer;
begin
comInit.comboBox1.text:=comPort;
ComSetup:=false;
if openComBool then
CloseHandle(comHandle);
ci:='COM?';
for m:=$31 to $38 do begin
ci[3]:=chr(m);

h:=CreateFile(ci,generic_read+generic_write,0,nil,open_existing,FileFlag,0);
if h>=0 then begin
comInit.comboBox1.items.add(ci);
CloseHandle(h);
end;
end;
if openComBool then
if not createFile_ then {Er det lovligt navn}
exit; {Nej - EXIT}
comInit.showModal;
end;

function comClose:boolean;
begin
if openComBool then
CloseHandle(comHandle)
else messageDlg('Com Close: File not open',mtWarning,[mbOK],0);
end;

function sendStr(s:ShortString):integer;
var
m1:integer;
begin
writeFile(ComHandle,s[1],ord(s[0]),m1,@overlapped);
sendStr:=m1;
end;

function reciveStr(var s:shortString):integer;
var
m1:integer;
begin
readFile(ComHandle,s[1],5,m1,@overlapped);
reciveStr:=m1;
s[0]:=chr(m1);
end;

procedure TComInit.FormCreate(Sender: TObject);
begin
comInit.caption:=comInitCaption_t;
Button1.caption:=AvanceretIndstillinger_t;
label1.caption:=ValgAfComPort_t;
end;

procedure TComInit.Button1Click(Sender: TObject);
begin
if CommConfigDialog(comPort,form1.handle,comConfig) and openComBool then
begin
if not setCommConfig(comHandle,comConfig,sizeOf(comConfig)) then
messageDlg('Set Comm
Comfig:'+SysErrorMessage(getLastError),mtWarning,[mbOK],0);
label3.caption:=intToStr(comConfig.dcb.baudRate); {Skriv Boad Rate
til SCR}
boadRate:=comConfig.dcb.BaudRate; {Set ny boad rate}
end;
end;

procedure TComInit.ComboBox1Change(Sender: TObject);
begin
StrPCopy(comPort,ComboBox1.Items[ComboBox1.ItemIndex]);
if openComBool then
CloseHandle(comHandle); {Luk Gl. handle}
createFile_; {Er det lovligt navn}
end;

procedure TComInit.FormShow(Sender: TObject);
begin
label2.caption:=BoadRate_t;
label3.caption:=intToStr(comConfig.dcb.baudRate);
end;

procedure TComInit.Button2Click(Sender: TObject);
begin
Close;
end;

end.

Hauge

unread,

Jun 16, 2009, 10:25:41 AM6/16/09

to

Hej

Carsten wrote:
> Jeg kunne forstille mig at metoden er den samme som under Windows.

Det er det jeg ikke helt kan finde ud af, men det er ret muligt..

> Her er noget kode som er skrevet til Delphi 2. Jeg ved det virker til
> Windows, men jeg blev aldrig f�rdig, da jeg ikke fik brug for det.
> Det er ikke s�rligt k�nt, men det kan m�ske lede dig p� rette spor.

N�ja, bare det virker "lidt", s� er det jo ogs� ligegyldigt ;o)

Jeg takker.

Mvh Hauge