/ Forside / Teknologi / Udvikling / Delphi/Pascal / Nyhedsindlæg
Login
Glemt dit kodeord?
Brugernavn

Kodeord


Reklame
Top 10 brugere
Delphi/Pascal
#NavnPoint
oldwiking 603
jrossing 525
rpje 520
EXTERMINA.. 500
gandalf 460
gubi 270
DJ_Puden 250
PARKENSS 230
technet 210
10  jdjespers.. 200
Freepascal / Lazarus på WinCE og serial-po~
Fra : Hauge


Dato : 31-05-09 21:06

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 (16-06-2009)
Kommentar
Fra : Carsten


Dato : 16-06-09 15:12

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 ComOpen(na:comPort_typ; br:LongInt):boolean;
begin
ComOpen:=false;
comPort:=na; {Navn pÕ COM device}
boadRate:=br; {Boad Rate}
overlapped.offset:=0; {Overlapped data}
overlapped.OffsetHigh:=0; {Overlapped data}
overlapped.hEvent:=0; {Overlapped data}
comConfig.Dwsize:=sizeOf(tCommConfig); {St°relse pÕ array}
comConfig.wVersion:=1; {Driver version for
Win95}
comConfig.dcb.dcbLength:=sizeOf(tDcb); {St°relse pÕ DCB felt}
if not createFile_ then {Er det lovligt navn}
exit; {Nej - EXIT}
ComOpen:=true;
openComBool:=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 (16-06-2009)
Kommentar
Fra : Hauge


Dato : 16-06-09 15:26

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

Jeg takker.

Mvh Hauge



Søg
Reklame
Statistik
Spørgsmål : 177552
Tips : 31968
Nyheder : 719565
Indlæg : 6408849
Brugere : 218887

Månedens bedste
Årets bedste
Sidste års bedste