📄 os2com.pas
字号:
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte);
type TBpsRec = Record
Rate : Longint;
Frac : Byte;
end; { record }
var TempRec : Array[1..3] of Byte;
BpsRec : TBpsRec;
RetLength : Longint;
Temp_Parity : Byte;
Temp_StopBits: Byte;
begin
if NOT (DataBits in [5,7,8]) then DataBits := 8;
if NOT (Parity in ['O', 'E', 'N', 'M', 'S']) then Parity := 'N';
if NOT (StopBits in [0..2]) then StopBits := 1;
Temp_Parity := 00;
Case Parity of
'N' : Temp_Parity := 00;
'O' : Temp_Parity := 01;
'E' : Temp_Parity := 02;
'M' : Temp_Parity := 03;
'S' : Temp_Parity := 04;
end; { case }
Temp_Stopbits := 00;
Case StopBits of
1 : StopBits := 0;
2 : StopBits := 2;
end; { case }
Fillchar(TempRec, SizeOf(TempRec), 00);
TempRec[01] := DataBits;
TempRec[02] := Temp_Parity;
TempRec[03] := Temp_StopBits;
{------------------------- Set line parameters ----------------------------}
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_SetLineCtrl, { Function }
@TempRec, { Params }
SizeOf(TempRec), { Max param length }
@RetLength, { Param Length }
@TempRec, { Returned data }
SizeOf(TempRec), { Max data length }
@RetLength); { Data length }
{------------------------- Set speed parameters ---------------------------}
BpsRec.Rate := BpsRate;
BpsRec.Frac := 00;
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_ExtSetBaudRate, { Function }
@BpsRec, { Params }
SizeOf(BpsRec), { Max param length }
@RetLength, { Param Length }
@BpsRec, { Returned data }
SizeOf(BpsRec), { Max data length }
@RetLength); { Data length }
end; { proc. TOs2Obj.Com_SetLine }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_Close;
begin
if DontClose then EXIT;
if ClientHandle <> -1 then
begin
Com_StopThread;
DosClose(ClientHandle);
ClientHandle := -1;
end; { if }
end; { func. TOs2Obj.Com_CloseCom }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_SendChar(C: Char): Boolean;
var Written: Longint;
begin
Com_SendBlock(C, SizeOf(C), Written);
Com_SendChar := (Written = SizeOf(c));
end; { proc. TOs2Obj.Com_SendChar }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_GetChar: Char;
var Reads: Longint;
begin
Com_ReadBlock(Result, SizeOf(Result), Reads);
end; { func. TOs2Obj.Com_GetChar }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint);
begin
{$IFDEF WITH_DEBUG}
DebugLog(logAsync, 'Com_SendBlock (BEGIN) = ' + fStr(BlockLen));
DebugLog(logAsync, 'Com_SendBlock (01) = ' + fStr(OutBuffer^.BufRoom));
{$ENDIF}
if OutBuffer^.BufRoom < BlockLen then
repeat
{$IFDEF OS2}
DosSleep(1);
{$ENDIF}
until (OutBuffer^.BufRoom >= BlockLen) OR (NOT Com_Carrier);
{$IFDEF WITH_DEBUG}
DebugLog(logAsync, 'Com_SendBlock (02) = ' + fStr(OutBuffer^.BufRoom));
{$ENDIF}
CriticalTx.EnterExclusive;
Written := OutBuffer^.Put(Block, BlockLen);
CriticalTx.LeaveExclusive;
DoTxEvent.SignalEvent;
{$IFDEF WITH_DEBUG}
DebugLog(logAsync, 'Com_SendBlock ( END ) = ' + fStr(OutBuffer^.BufRoom));
{$ENDIF}
end; { proc. TOs2Obj.Com_SendBlock }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint);
begin
{$IFDEF WITH_DEBUG}
DebugLog(logAsync, 'Com_ReadBlock (BEGIN) = ' + fStr(InBuffer^.BufUsed));
DebugLog(logAsync, 'Com_ReadBlock (01) = ' + fStr(BlockLen));
{$ENDIF}
if InBuffer^.BufUsed < BlockLen then
begin
repeat
if Com_CharAvail then
DoRxEvent.SignalEvent;
DosSleep(1);
until (InBuffer^.BufUsed >= BlockLen) OR (NOT Com_Carrier);
end; { if }
CriticalRx.EnterExclusive;
Reads := InBuffer^.Get(Block, BlockLen, true);
CriticalRx.LeaveExclusive;
{$IFDEF WITH_DEBUG}
DebugLog(logAsync, 'Com_ReadBlock ( END ) = ' + fStr(Reads));
{$ENDIF}
end; { proc. TOs2Obj.Com_ReadBlock }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_CharAvail: Boolean;
Type TBuffRec = Record
BytesIn : SmallWord; { Number of bytes in the buffer }
MaxSize : SmallWord; { Full size of the buffer }
end; { TBuffRec }
var ReturnCode: Longint;
BufferRec : TBuffRec;
begin
if InBuffer^.BufUsed < 1 then
begin
ReturnCode := 0;
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_GetInQueCount, { Function }
nil, { Params }
ReturnCode, { Max param length }
@ReturnCode, { Param Length }
@BufferRec, { Returned data }
SizeOf(TBuffRec), { Max data length }
@ReturnCode); { Data length }
if (BufferRec.BytesIn > 0) then
DoRxEvent.SignalEvent;
end; { if }
Result := (InBuffer^.BufUsed > 0);
end; { func. TOs2Obj.Com_CharAvail }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_Carrier: Boolean;
var Status : Byte;
RetLength : Longint;
begin
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_GetModemInput, { Function }
nil, { Params }
00, { Max param length }
@RetLength, { Param Length }
@Status, { Returned data }
SizeOf(Status), { Max data length }
@RetLength); { Data length }
Com_Carrier := Status AND 128 <> 00;
end; { func. TOs2Obj.Com_Carrier }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_GetModemStatus(var LineStatus, ModemStatus: Byte);
begin
LineStatus := 00;
ModemStatus := 08;
if Com_Carrier then ModemStatus := ModemStatus OR (1 SHL 7);
end; { proc. TOs2Obj.Com_GetModemStatus }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_SetDtr(State: Boolean);
type
TRtsDtrRec = record
Onmask,
Offmask : Byte;
end; { record }
var MaskRec : TRtsDtrRec;
RetLength : Longint;
begin
if State then
begin
MaskRec.OnMask := $01;
MaskRec.OffMask := $FF;
end
else begin
MaskRec.OnMask := $00;
MaskRec.OffMask := $FE;
end; { if }
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_SetModemCtrl, { Function }
@MaskRec, { Params }
SizeOf(MaskRec), { Max param length }
@RetLength, { Param Length }
@MaskRec, { Returned data }
SizeOf(MaskRec), { Max data length }
@RetLength); { Data length }
end; { proc. TOs2Obj.Com_SetDtr }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_GetBpsRate: Longint;
type
TBpsRec = record
CurBaud : Longint; { Current BaudRate }
CurFrac : Byte; { Current Fraction }
MinBaud : Longint; { Minimum BaudRate }
MinFrac : Byte; { Minimum Fraction }
MaxBaud : Longint; { Maximum BaudRate }
MaxFrac : Byte; { Maximum Fraction }
end; { TBpsRec }
var BpsRec : TBpsRec;
Status : Byte;
RetLength: Longint;
begin
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_ExtGetBaudRate, { Function }
nil, { Params }
00, { Max param length }
@RetLength, { Param Length }
@BpsRec, { Returned data }
SizeOf(BpsRec), { Max data length }
@RetLength); { Data length }
Com_GetBpsRate := BpsRec.CurBaud;
end; { func. TOs2Obj.Com_GetBpsRate }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint);
begin
DoRxEvent.SignalEvent;
DoTxEvent.SignalEvent;
InFree := InBuffer^.BufRoom;
OutFree := OutBuffer^.BufRoom;
InUsed := InBuffer^.BufUsed;
OutUsed := OutBuffer^.BufUsed;
end; { proc. TOs2Obj.Com_GetBufferStatus }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_PurgeInBuffer;
begin
CriticalRx.EnterExclusive;
InBuffer^.Clear;
CriticalRx.LeaveExclusive;
end; { proc. TOs2Obj.Com_PurgeInBuffer }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_PurgeOutBuffer;
begin
CriticalTx.EnterExclusive;
OutBuffer^.Clear;
CriticalTx.LeaveExclusive;
end; { proc. TOs2Obj.Com_PurgeInBuffer }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_FlushOutBuffer(Slice: SliceProc);
begin
DosResetBuffer(ClientHandle);
inherited Com_FlushOutBuffer(Slice);
end; { proc. Com_FlushOutBuffer }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_ReadyToSend(BlockLen: Longint): Boolean;
begin
Result := OutBuffer^.BufRoom >= BlockLen;
{$IFDEF WITH_DEBUG}
DebugLog(logAsync, 'Com_ReadyToSend (BlockLen='+FStr(BlockLen)+ ') / (BufRoom='+fStr(OutBuffer^.BufRoom) + ')');
{$ENDIF}
end; { func. ReadyToSend }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_PauseCom(CloseCom: Boolean);
begin
if CloseCom then Com_Close
else Com_StopThread;
end; { proc. Com_PauseCom }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_ResumeCom(OpenCom: Boolean);
begin
if OpenCom then Com_OpenKeep(0)
else Com_StartThread;
end; { proc. Com_ResumeCom }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_SetFlow(SoftTX, SoftRX, Hard: Boolean);
var Dcb : DCBINFO;
RetLength: Longint;
begin
FillChar(Dcb, SizeOF(Dcb), 0);
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_GetDcbInfo, { Function }
nil, { Params }
00, { Max param length }
@RetLength, { Param Length }
@Dcb, { Returned data }
SizeOf(DcbInfo), { Max data length }
@RetLength); { Data length }
if (SoftTX) or (SoftRX) then
begin
dcb.fbFlowReplace := dcb.fbFlowReplace + MODE_AUTO_RECEIVE + MODE_AUTO_TRANSMIT;
end
else begin
dcb.fbFlowReplace := MODE_RTS_HANDSHAKE;
dcb.fbCtlHndShake := dcb.fbCtlHndShake + MODE_CTS_HANDSHAKE;
end; { if }
dcb.fbTimeout := MODE_NO_WRITE_TIMEOUT + MODE_WAIT_READ_TIMEOUT;
dcb.bXONChar := $11;
dcb.bXOFFChar := $13;
RetLength := SizeOf(DcbInfo);
DosDevIoCtl(ClientHandle, { File-handle }
ioctl_Async, { Category }
async_SetDcbInfo, { Function }
@Dcb, { Params }
SizeOf(DcbInfo), { Max param length }
@RetLength, { Param Length }
nil, { Returned data }
RetLength, { Max data length }
@RetLength); { Data length }
end; { proc. Com_SetFlow }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_SetDataProc(ReadPtr, WritePtr: Pointer);
begin
ReadProcPtr := ReadPtr;
WriteProcPtr := WritePtr;
end; { proc. Com_SetDataProc }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
end. { unit OS2COM }
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -