|
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. |
|
|
來(lái)自： ZLM_圖書(shū)館 > 《Lazarus》
