Results 1 to 1 of 1
Thread: Comport ? SRC
Hybrid View
-
18th October 2007 09:44 #1Registered User
Join Date: Oct:2007
Location:
Posts: 33
Comport ? SRC
.
Com . ComDrve32 . . . ( 30990 , !) 31000 .
- . , . .
. Timer 500 GetComStat "" . . 0.
:
134 0.00000643 IOCTL_SERIAL_GET_COMMSTATUS Serial0 SUCCESS
135 0.02180026 IRP_MJ_WRITE Serial0 SUCCESS Length 259: 00 01 0A 89 04 04 E6 86 AE 07 A5 5A A5 A5 F2 F5 1C FF D1 90 E6 F3 14 00 F6 F3 22 FF A5 5A A5 A5 CC 00 E6 F3 00 50 F3 F8 1C FF E6 01 07 00 D1 80 E7 1F AA 00 7E B9 9A B9 FE 70 8A BA 3B 70 F3 F2 40 F0 7E B9 9A B9 FE 70 8A BA 34 70 F3 F3 40 F0 7E B9 E6 F2 00 30 9A B9 FE 70 8A BA 2B 70 A4 03 40 F0 08 31 53 F8 40 F0 7E B9 28 21 3D 10 48 50 3D 08 E6 F3 00 40 E6 F2 00 40 E6 01 08 00 E0 15 0D 06 E6 F3 00 40 E6 F2 00 40 E6 01 09 00 28 11 3D E2 9A B9 FE 70 8A BA 0D 70 53 F8 40 F0 3D 0A D1 80 E6 1F 01 00 7E B9 E0 0C E0 0D E0 0E E0 0F FA 01 00 D0 D1 80 E6 1F FF 00 0D FF 17 46 FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF FF 00
136 0.00000447 IOCTL_SERIAL_GET_COMMSTATUS Serial0 SUCCESS
260 .
30990 6 ~3000 .
SRC .
.
// .
// - .
//Business application is forbidden.
//Punishment - unavoidable crack and propagation on everything inet.
unit ComPort;
interface
uses Windows,SysUtils;
var
iComNum : integer = 2; // COM
iOldComOpen : integer = 0;
iComBaud : integer = 115200; // COM
iOldComBaud : integer = 0;
toread : longint;
towrite : longint;
hCom : THandle=INVALID_HANDLE_VALUE;
ComTimeouts : TCommTimeouts;
txLen, rxLen : Dword;
FlgOvrlp : boolean = True;
COMwr : OVERLAPPED;
COMrd : OVERLAPPED;
COMst : COMSTAT;
DCB : TDCB;
{ DCB :
0 DWORD fBinary: 1; // binary mode, no EOF check
1 DWORD fParity: 1; // enable parity checking
2 DWORD fOutxCtsFlow:1; // CTS output flow control
3 DWORD fOutxDsrFlow:1; // DSR output flow control
4..5 DWORD fDtrControl:2; // DTR flow control type
6 DWORD fDsrSensitivity:1; // DSR sensitivity
7 DWORD fTXContinueOnXoff:1; // XOFF continues Tx
8 DWORD fOutX: 1; // XON/XOFF out flow control
9 DWORD fInX: 1; // XON/XOFF in flow control
10 DWORD fErrorChar: 1; // enable error replacement
11 DWORD fNull: 1; // enable null stripping
12..13 DWORD fRtsControl:2; // RTS flow control
14 DWORD fAbortOnError:1; // abort reads/writes on error
15..31 DWORD fDummy2:17; // reserved}
function OpenCom(Mode:boolean) : boolean;
procedure CloseCom;
function GetComDCB : boolean;
function SetComDCB : boolean;
function GetComTimeouts : boolean;
function SetComTimeouts : boolean;
function SetComRxTimeouts(NewIntervalTimeout,NewT imeoutMultiplier,NewTimeoutConstant:dwor d) : boolean;
function ReadCom(Buf:Pointer; BufLen
word) : boolean;
function WriteCom(Buf:Pointer; BufLen
word) : boolean;
function EscapeComFunction(dwFunc
word) : boolean;
function GetComModemStatus(lpModemStat: Pointer):boolean;
function GetComStat : boolean;
function PurgeCom(mode
word): boolean; // PURGE_TXCLEAR or PURGE_RXCLEAR
function WriteComStr(S: String): boolean;
function ChangeComSpeed(Baud:integer) : boolean;
implementation
function OpenCom(Mode:boolean) : boolean;
var
dw : dword;
begin
result:=FALSE;
if hCom <> INVALID_HANDLE_VALUE then
CloseCom;
if FlgOvrlp then
dw := FILE_FLAG_OVERLAPPED
else
dw := FILE_ATTRIBUTE_NORMAL;
hCom := CreateFile (PChar('\\?\COM'+IntToStr(iComNum)),GENE RIC_READ or GENERIC_WRITE,0,nil,OPEN_EXISTING,dw,0);
if hCom <> INVALID_HANDLE_VALUE then
begin
SetupComm(hCom,$20000,$20000); //8192, 8192); // Rd , Wr
if GetComDCB then
begin
if Mode then
DCB.Flags := (DCB.Flags and $ffff8000) or $0001
else
DCB.Flags := (DCB.Flags and $ffff8000) or $0011; //$1011;
DCB.ByteSize := 8;
DCB.Parity := 0;
DCB.StopBits := 0;
DCB.BaudRate := iComBaud;
if SetComDCB then
begin
ComTimeouts.ReadIntervalTimeout:=20; //0
ComTimeouts.ReadTotalTimeoutMultiplier:= 1; //0
ComTimeouts.ReadTotalTimeoutConstant:=20 0; //200
ComTimeouts.WriteTotalTimeoutMultiplier: =0;//MAXDWORD;
ComTimeouts.WriteTotalTimeoutConstant:=0 ;//MAXDWORD;
if SetComTimeouts then
begin
iOldComOpen := iComNum;
iOldComBaud := iComBaud;
if Mode then
begin
sleep(75);
EscapeComFunction(SETRTS);
sleep(25);
EscapeComFunction(SETDTR);
end
else
begin
// sleep(75);
EscapeComFunction(SETDTR);
EscapeComFunction(SETRTS);
// sleep(25);
end;
// sleep(300);
// PurgeCom(PURGE_TXCLEAR or PURGE_RXCLEAR);
result := TRUE;
end;
end;
end;
end;
end;
procedure CloseCom;
var
x: THandle;
begin
if hCom <> INVALID_HANDLE_VALUE then
begin
x := hCom;
hCom := INVALID_HANDLE_VALUE;
CloseHandle(x);
end;
// hCom:=INVALID_HANDLE_VALUE;
iOldComOpen:=0;
end;
function GetComDCB : boolean;
begin
result := FALSE;
if hCom<>INVALID_HANDLE_VALUE then
result := GetCommState(hCom,DCB);
end;
function SetComDCB : boolean;
begin
result:=FALSE;
if hCom<>INVALID_HANDLE_VALUE then
result := SetCommState(hCom,DCB);
end;
function ChangeComSpeed(Baud:integer) : boolean;
var
save_baud : integer;
begin
result:=FALSE;
save_baud:=dcb.BaudRate;
if hCom<>INVALID_HANDLE_VALUE then begin
// dcb.BaudRate:=Baud;
if GetComDCB then begin
if dcb.BaudRate<>Dword(Baud) then begin
dcb.BaudRate:=Baud;
result := SetCommState(hCom,DCB);
EscapeComFunction(SETRTS);
EscapeComFunction(SETDTR);
if not result then begin
dcb.BaudRate:=save_baud;
SetCommState(hCom,DCB);
EscapeComFunction(SETRTS);
EscapeComFunction(SETDTR);
end;
end;
end;
end;
end;
function GetComTimeouts : boolean;
begin
result:=FALSE;
if hCom<>INVALID_HANDLE_VALUE then
result := GetCommTimeouts(hCom,ComTimeouts);
end;
function SetComTimeouts : boolean;
begin
result:=FALSE;
if hCom<>INVALID_HANDLE_VALUE then
if SetCommTimeouts(hCom,ComTimeouts) then result:=TRUE;
end;
function SetComRxTimeouts(NewIntervalTimeout,NewT imeoutMultiplier,NewTimeoutConstant:dwor d) : boolean;
begin
result:=FALSE;
if (ComTimeouts.ReadIntervalTimeout<>NewInt ervalTimeout)
or (ComTimeouts.ReadTotalTimeoutMultiplier< >NewTimeoutMultiplier)
or (ComTimeouts.ReadTotalTimeoutConstant<>N ewTimeoutConstant)
then begin
ComTimeouts.ReadIntervalTimeout:=NewInte rvalTimeout;
ComTimeouts.ReadTotalTimeoutMultiplier:= NewTimeoutMultiplier;
ComTimeouts.ReadTotalTimeoutConstant:=Ne wTimeoutConstant;
if hCom<>INVALID_HANDLE_VALUE then
if SetCommTimeouts(hCom,ComTimeouts) then result:=TRUE;
end
else result:=TRUE;
end;
function GetComStat : boolean;
var
dErr : DWORD;
begin
result := FALSE;
dErr := 0;
// rxLen := 0;
// if hCom <> INVALID_HANDLE_VALUE then
begin
if ClearCommError(hCom,dErr,@COMst) then
begin
// size Rx buff := COMst.cbInQue;
toread := COMst.cbInQue;
towrite := COMst.cbOutQue;
Result := True;
end;
end;
end;
function ReadCom(Buf:Pointer; BufLen
word) : boolean;
var
dErr: Dword;
begin
result := False;
if (hCom<>INVALID_HANDLE_VALUE) and (Buf<>Nil) and (BufLen<>0) then
begin
rxlen := 0;
if FlgOvrlp then
begin
COMrd.hEvent := CreateEvent(Nil,TRUE,FALSE,Nil);
if not ReadFile(hCom,Buf^,BufLen,rxLen,@COMrd) then
begin
if not GetOverlappedResult(hCom,COMrd,rxLen,Tru e) then
begin
end;
end;
// ResetEvent(COMrd.hEvent);
CloseHandle(COMrd.hEvent);
end
else
begin
if not ReadFile(hCom,Buf^,BufLen,rxLen,Nil) then
begin
// ClearCommError(hCom,dErr,Nil);
// exit;
end;
end;
if rxLen = BufLen then
result := True
else
ClearCommError(hCom,dErr,Nil);
end;
end;
function WriteCom(Buf:Pointer; BufLen
word) : boolean;
Var
dErr: Dword;
begin
result:=FALSE;
if (hCom<>INVALID_HANDLE_VALUE)and(Buf<>Nil )and(BufLen<>0) then begin
txLen:=0;
if FlgOvrlp then begin
COMwr.hEvent:=CreateEvent(Nil,TRUE,FALSE ,Nil);
if not WriteFile(hCom,Buf^,BufLen,txLen,@COMwr) then begin
if not GetOverlappedResult(hCom,COMwr,txLen,Tru e) then begin
end;
// ClearCommError(hCom,dErr,Nil);
end;
// ResetEvent(COMwr.hEvent);
CloseHandle(COMwr.hEvent);
end
else begin
if not WriteFile(hCom,Buf^,BufLen,txLen,Nil) then begin
// ClearCommError(hCom,dErr,Nil);
// exit;
end;
end;
if txLen = BufLen then result:=TRUE
else ClearCommError(hCom,dErr,Nil);
end;
end;
function WriteComStr(S: String): boolean;
begin
Result:=WriteCom(@S[1],Length(S));
end;
function PurgeCom(mode
word): boolean; //function
begin
result := PurgeComm(hCom,mode); //
end;
function EscapeComFunction(dwFunc
word):boolean;
begin
result:=FALSE;
if hCom<>INVALID_HANDLE_VALUE then
result := EscapeCommFunction(hCom,dwFunc);
end;
function GetComModemStatus(lpModemStat:Pointer):b oolean;
begin
result:=FALSE;
if hCom<>INVALID_HANDLE_VALUE then
result := GetCommModemStatus(hCom,LpDword(lpModemS tat)^);
end;
end.




Reply With Quote
Lenovo ThinkPad 15 IdeaPad 15
5th May 2023, 22:16 in