Win CE de serial port iletişimi

[barutali]

Lazarus ile Win CE 5.0 işletim sistemli cihazıma program yazıyorum. Serial Port ile iletişim için hangi bileşeni önerirsiniz ?

[barutali]

2 Haftalık bir araştırmanın sonucudur ...

Lazarus ile WinCE 5.0 ortamında (ARM tipi işlemci..) comport ile iletişim sağlayan örnek koddur..

Kod: Tümünü seç

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_existin g,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.


ALINTIDIR : http://groups.google.com/group/dk.edb.p ... a7240506f3