Comport Component For Wince 5.0

[Barutali]

Hi dear guests;
Lazarus comport component necessary for one would like to thank you for your help

P.S : For WinCE 5.0

I'm sorry for my english...

[felipemdc]

You need a component that executes serial communication, is that it?

[Zaher]

MiniComm in http://sourceforge.net/projects/minilib

[picstart]

MiniComm in http://sourceforge.net/projects/minilib gets sqlite with no communications such as minicomm

[Zaher]

Hi picstart, i am not understand you?

MiniComm connect to COM ports in win32/wince
MiniConnection connect to SQLite

[picstart]

I don't see any code for MiniComm at the address http://sourceforge.net/projects/minilib
it only has code for the sqllite.

[Zaher]

Ah, there is a tools in the front of sf page for sqlite
But the whale library source has many pascal files browse for it
http://minilib.svn.sourceforge.net/viewvc/minilib/trunk/
download it
http://minilib.svn.sourceforge.net/viewvc/minilib/trunk/?view=tar

not all source are stable i still work on it.

[kares1970]

unit Win32CESerialCom;
interface
uses
  Windows, Classes, SysUtils, LResources, ExtCtrls;
 

type
  TComBuf=array[0..255] of byte;
  TWin32CESerialCom = class(TObject)
  private
    hComm: THandle;
  public
    Connected:Boolean;
    function  OpenPort(ComPort:String;BaudRate,ByteSize,Parity,StopBits:integer):String;
    procedure SendString(str:String);
    procedure SendChar(chr:char);
    function  SendData(buf:TComBuf;Bytes:Integer):integer;
    function  ReceiveString:String;
    function  ReadMax(var buf:TComBuf):integer;
    function  WaitForBytes(Count, Ms: cardinal): boolean;
    function  InQue:Integer;
    function  OutQue:Integer;
    procedure PurgeOut;
    procedure PurgeIn;
    procedure ClosePort;
  end;


implementation

procedure TWin32CESerialCom.PurgeIn;
begin
if not PurgeComm(hComm, PURGE_RXABORT or PURGE_RXCLEAR) then
raise Exception.Create('Unable to purge com: ');
end;

procedure TWin32CESerialCom.PurgeOut;
begin
if not PurgeComm(hComm, PURGE_TXABORT or PURGE_TXCLEAR) then
raise Exception.Create('Unable to purge com: ');
end;

function TWin32CESerialCom.InQue: Integer;
var Errors: DWORD;
ComStat: TComStat;
begin
if not ClearCommError(hComm, Errors, @ComStat) then
raise Exception.Create('Unable to read com status: ');
Result := ComStat.cbInQue;
end;

function TWin32CESerialCom.OutQue: Integer;
var Errors: DWORD;
ComStat: TComStat;
begin
if not ClearCommError(hComm, Errors, @ComStat) then
raise Exception.Create('Unable to read com status: ');
Result := ComStat.cbOutQue;
end;

function TWin32CESerialCom.WaitForBytes(Count, Ms: cardinal): boolean;
var
  iq:integer;

begin
  Result:=False;
  if hComm=INVALID_HANDLE_VALUE then exit;
  Ms:=Ms+GetTickCount();
  while (ms>=GetTickCount())and(hComm<>INVALID_HANDLE_VALUE) do begin
    try
    iq:=InQue;
    except
    Exit;
    end;
    if iq>=Count then begin;Result:=True;Break;end;
    sleep(1);
  end;
end;

function TWin32CESerialCom.OpenPort(ComPort:String;BaudRate,ByteSize,Parity,StopBits:integer):String;
var
  cc:TCOMMCONFIG;
{$IFDEF Win32}
  SAnsi:AnsiString;
  Port:LPCSTR;
{$ENDIF}
{$IFDEF WinCE}
  SWide:WideString;
  Port:LPCWSTR;
{$ENDIF}

begin
{$IFDEF Win32}
  SAnsi:=ComPort;
  port:=PChar(SAnsi);
{$ENDIF}
{$IFDEF WinCE}
  SWide:=ComPort;
  port:=PWideChar(SWide);
{$ENDIF}
  result:='';
if not Connected then begin
  Connected:=False;
  hComm:=CreateFile(Port, GENERIC_READ or GENERIC_WRITE,0, nil, OPEN_EXISTING, 0, 0);
  if (hComm = INVALID_HANDLE_VALUE) then begin
    result:='CreateFile Error!';
    exit;
  end;

  GetCommState(hComm,cc.dcb);
  cc.dcb.BaudRate:=BaudRate;
  cc.dcb.ByteSize:=ByteSize;
  cc.dcb.Parity:=Parity;
  cc.dcb.StopBits:=StopBits;
 
  if not SetCommState(hComm, cc.dcb) then begin
    result:='SetCommState Error!';
    CloseHandle(hComm);
    exit;
  end;
  Connected:=True;
end;
end;

procedure TWin32CESerialCom.SendString(str:String);
var
  lrc:LongWord;
begin
  if (hComm=0) then exit;
  try
  PurgeOut;
  except
  Exit;
  end;
  WriteFile(hComm,str,Length(str), lrc, nil);
end;

procedure TWin32CESerialCom.SendChar(chr:char);
var
  lrc:LongWord;
begin
  if (hComm=0) then exit;
  try
  PurgeOut;
  except
  Exit;
  end;
  WriteFile(hComm,chr,1, lrc, nil);
end;

function TWin32CESerialCom.SendData(buf:TComBuf;Bytes:Integer):integer;
var
  lrc:LongWord;
begin
  result:=0;
  if (hComm=0) then exit;
  try
  PurgeOut;
  except
  Exit;
  end;
  WriteFile(hComm,buf,Bytes, lrc, nil);
  result:=lrc;
end;

Function TWin32CESerialCom.ReceiveString:String;
var
  inbuff: array[0..2047] of Char;
  nBytesRead, dwError:LongWORD ;
  cs:TCOMSTAT;
begin
   ClearCommError(hComm,dwError,@CS);
      if cs.cbInQue > sizeof(inbuff) then begin
     PurgeComm(hComm, PURGE_RXCLEAR);
     exit;
   end;
   ReadFile(hComm, inbuff,cs.cbInQue,nBytesRead,nil);
   result:=Copy(inbuff,1,cs.cbInQue);
end;                             

function TWin32CESerialCom.ReadMax(var buf:TComBuf):integer;
var
  nBytesRead, dwError:LongWORD ;
  cs:TCOMSTAT;
begin
   result:=0;DwError:=0;nBytesRead:=0;
   if hComm=INVALID_HANDLE_VALUE then exit;
   ClearCommError(hComm,dwError,@CS);
   ReadFile(hComm, buf,cs.cbInQue,nBytesRead,nil);
   result:=nBytesRead;
end;

procedure TWin32CESerialCom.ClosePort;
begin
   if Connected then begin
    SetCommMask(hcomm,$0);
    CloseHandle(hComm);
   end;
   Connected:=False;
end;

end.