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.
|