📄 os2com.pas
字号:
unit OS2COM;
{.$DEFINE WITH_DEBUG}
(*
**
** Serial and TCP/IP communication routines for DOS, OS/2 and Win9x/NT.
** Tested with: TurboPascal v7.0, (DOS)
** VirtualPascal v2.1, (OS/2, Win32)
** FreePascal v0.99.12 (DOS, Win32)
** Delphi v4.0. (Win32)
**
** Version : 1.01
** Created : 21-May-1998
** Last update : 12-May-1999
**
** Note: (c) 1998-1999 by Maarten Bekers
**
*)
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
INTERFACE
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
uses Combase, BufUnit, Threads, Debug_U, LongStr
{$IFDEF OS2}
,Os2Base
{$ENDIF}
{$IFDEF VirtualPascal}
,Use32
{$ENDIF};
Const WriteTimeout = 20000; { Wait max. 20 secs }
ReadTimeOut = 20000; { General event, 20 secs max }
InBufSize = 1024 * 32;
OutBufSize = 1024 * 32;
type TOs2Obj = Object(TCommObj)
ReadProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
WriteProcPtr: Pointer; { Pointer to TX/RX handler (thread) }
ThreadsInitted: Boolean; { Are the thread(s) up and running? }
ClientHandle : Longint;
InBuffer : ^BufArrayObj; { Buffer system internally used }
OutBuffer : ^BufArrayObj;
DoTxEvent : PSysEventObj; { Event manually set when we have to transmit }
DoRxEvent : PSysEventObj; { Event manually set when we need data }
TxClosedEvent : PSysEventObj; { Event set when the Tx thread is closed }
RxClosedEvent : PSysEventObj; { Event set when the Rx thread is closed }
CriticalTx : PExclusiveObj; { Critical sections }
CriticalRx : PExclusiveObj;
TxThread : PThreadsObj; { The Transmit and Receive threads }
RxThread : PThreadsObj;
EndThreads : Boolean; { Set to true when we have to end the threads }
constructor Init;
destructor Done;
function Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
Parity: Char; StopBits: Byte): Boolean; virtual;
function Com_OpenKeep(Comport: Byte): Boolean; virtual;
function Com_GetChar: Char; virtual;
function Com_CharAvail: Boolean; virtual;
function Com_Carrier: Boolean; virtual;
function Com_SendChar(C: Char): Boolean; virtual;
function Com_ReadyToSend(BlockLen: Longint): Boolean; virtual;
function Com_GetBPSrate: Longint; virtual;
function Com_GetHandle: Longint; virtual;
procedure Com_OpenQuick(Handle: Longint); virtual;
procedure Com_Close; virtual;
procedure Com_SendBlock(var Block; BlockLen: Longint; var Written: Longint); virtual;
procedure Com_ReadBlock(var Block; BlockLen: Longint; var Reads: Longint); virtual;
procedure Com_GetBufferStatus(var InFree, OutFree, InUsed, OutUsed: Longint); virtual;
procedure Com_SetDtr(State: Boolean); virtual;
procedure Com_GetModemStatus(var LineStatus, ModemStatus: Byte); virtual;
procedure Com_SetLine(BpsRate: longint; Parity: Char; DataBits, Stopbits: Byte); virtual;
procedure Com_PurgeInBuffer; virtual;
procedure Com_PurgeOutBuffer; virtual;
procedure Com_FlushOutBuffer(Slice: SliceProc); virtual;
procedure Com_PauseCom(CloseCom: Boolean); virtual;
procedure Com_ResumeCom(OpenCom: Boolean); virtual;
procedure Com_SetFlow(SoftTX, SoftRX, Hard: Boolean); virtual;
procedure Com_SetDataProc(ReadPtr, WritePtr: Pointer); virtual;
procedure Com_ReadProc(var TempPtr: Pointer);
procedure Com_WriteProc(var TempPtr: Pointer);
function Com_StartThread: Boolean;
procedure Com_InitVars;
procedure Com_StopThread;
end; { object TOs2Obj }
Type POs2Obj = ^TOs2Obj;
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
IMPLEMENTATION
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
uses SysUtils;
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
constructor TOs2Obj.Init;
begin
inherited Init;
Com_InitVars;
ThreadsInitted := FALSE;
end; { constructor Init }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
destructor TOs2Obj.Done;
begin
inherited done;
end; { destructor Done }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_ReadProc(var TempPtr: Pointer);
Type TBuffRec = Record
BytesIn : SmallWord; { Number of bytes in the buffer }
MaxSize : SmallWord; { Full size of the buffer }
end; { TBuffRec }
var Available : Boolean;
BytesRead : Longint;
BlockLen : Longint;
ReturnCode: Longint;
BufferRec : TBuffRec;
begin
repeat
if DoRxEvent.WaitForEvent(ReadTimeOut) then
if NOT EndThreads then
begin
CriticalRx.EnterExclusive;
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 }
Available := (BufferRec.BytesIn > 00);
DoRxEvent.ResetEvent;
if Available then
begin
{----------- Start reading the gathered date -------------------}
if InBuffer^.BufRoom > 0 then
begin
BlockLen := BufferRec.BytesIn;
if BlockLen > InBuffer^.BufRoom then
BlockLen := InBuffer^.BufRoom;
if BlockLen > 1024 then
BlockLen := 1024;
if BlockLen > 00 then
begin
DosRead(ClientHandle,
InBuffer^.TmpBuf^,
BlockLen,
BytesRead);
InBuffer^.Put(InBuffer^.TmpBuf^, BytesRead);
end; { if }
end; { if }
end; { if available }
CriticalRx.LeaveExclusive;
end; { if RxEvent }
until EndThreads;
RxClosedEvent.SignalEvent;
ExitThisThread;
end; { proc. ComReadProc }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_WriteProc(var TempPtr: Pointer);
var BlockLen : Longint;
Written : Longint;
ReturnCode : Longint;
TempBuf : ^CharBufType;
begin
New(TempBuf);
repeat
if DoTxEvent.WaitForEvent(WriteTimeOut) then
if NOT EndThreads then
begin
CriticalTx.EnterExclusive;
DoTxEvent.ResetEvent;
if OutBuffer^.BufUsed > 00 then
begin
Written := 00;
BlockLen := OutBuffer^.Get(OutBuffer^.TmpBuf^, OutBuffer^.BufUsed, false);
DosWrite(ClientHandle,
OutBuffer^.TmpBuf^,
BlockLen,
Written);
ReturnCode := OutBuffer^.Get(OutBuffer^.TmpBuf^, Written, true);
if Written <> BlockLen then
DoTxEvent.SignalEvent;
end; { if }
CriticalTx.LeaveExclusive;
end; { if }
until EndThreads;
Dispose(TempBuf);
TxClosedEvent.SignalEvent;
ExitThisThread;
end; { proc. ComWriteProc }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_StartThread: Boolean;
begin
Result := false;
EndThreads := false;
if ThreadsInitted then EXIT;
ThreadsInitted := true;
{----------------------- Create all the events ----------------------------}
New(DoTxEvent, Init);
if NOT DoTxEvent.CreateEvent(false) then EXIT;
New(DoRxEvent, Init);
if NOT DoRxEvent.CreateEvent(false) then EXIT;
New(RxClosedEvent, Init);
if NOT RxClosedEvent.CreateEvent(false) then EXIT;
New(TxClosedEvent, Init);
if NOT TxClosedEvent.CreateEvent(false) then EXIT;
{-------------- Startup the buffers and overlapped events -----------------}
New(InBuffer, Init(InBufSize));
New(OutBuffer, Init(OutBufSize));
if (InBuffer^.TxtArr=nil) OR (InBuffer^.TmpBuf=nil) then EXIT;
if (OutBuffer^.TxtArr=nil) OR (OutBuffer^.TmpBuf=nil) then EXIT;
{-------------------- Startup a seperate write thread ---------------------}
New(CriticalTx, Init);
CriticalTx.CreateExclusive;
New(TxThread, Init);
if NOT TxThread.CreateThread(16384, { Stack size }
WriteProcPtr, { Actual procedure }
nil, { Parameters }
0) { Creation flags }
then EXIT;
{-------------------- Startup a seperate read thread ----------------------}
New(CriticalRx, Init);
CriticalRx.CreateExclusive;
New(RxThread, Init);
if NOT RxThread.CreateThread(16384, { Stack size }
ReadProcPtr, { Actual procedure }
nil, { Parameters }
0) { Creation flags }
then EXIT;
Result := true;
end; { proc. Com_StartThread }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_InitVars;
begin
DoTxEvent := nil;
DoRxEvent := nil;
RxClosedEvent := nil;
TxClosedEvent := nil;
TxThread := nil;
RxThread := nil;
InBuffer := nil;
OutBuffer := nil;
CriticalRx := nil;
CriticalTx := nil;
end; { proc. Com_InitVars }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_StopThread;
begin
EndThreads := true;
ThreadsInitted := false;
if DoTxEvent <> nil then DoTxEvent.SignalEvent;
if DoTxEvent <> nil then DoRxEvent.SignalEvent;
if TxThread <> nil then TxThread.CloseThread;
if RxThread <> nil then RxThread.CloseThread;
if TxClosedEvent <> nil then
if NOT TxClosedEvent^.WaitForEvent(1000) then
TxThread.TerminateThread(0);
if RxClosedEvent <> nil then
if NOT RxClosedEvent^.WaitForEvent(1000) then
RxThread.TerminateThread(0);
if TxThread <> nil then TxThread.Done;
if RxThread <> nil then RxThread.Done;
if DoTxEvent <> nil then Dispose(DoTxEvent, Done);
if DoRxEvent <> nil then Dispose(DoRxEvent, Done);
if RxClosedEvent <> nil then Dispose(RxClosedEvent, Done);
if TxClosedEvent <> nil then Dispose(TxClosedEvent, Done);
if CriticalTx <> nil then Dispose(CriticalTx, Done);
if CriticalRx <> nil then Dispose(CriticalRx, Done);
if InBuffer <> nil then Dispose(InBuffer, Done);
if OutBuffer <> nil then Dispose(OutBuffer, Done);
Com_InitVars;
end; { proc. Com_StopThread }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_GetHandle: Longint;
begin
Result := ClientHandle;
end; { func. Com_GetHandle }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
procedure TOs2Obj.Com_OpenQuick(Handle: Longint);
begin
ClientHandle := Handle;
InitFailed := NOT Com_StartThread;
end; { proc. TOs2Obj.Com_OpenQuick }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_OpenKeep(Comport: Byte): Boolean;
var ReturnCode: Longint;
OpenAction: Longint;
Temp : Array[0..15] of Char;
begin
InitFailed := NOT Com_StartThread;
if NOT InitFailed then
begin
OpenAction := file_Open;
StrpCopy(Temp, 'COM' + IntToStr(ComPort));
ReturnCode :=
DosOpen(Temp, { Filename, eg: COM2 }
ClientHandle,
OpenAction,
0, { Filesize }
0, { Attributes }
FILE_OPEN or OPEN_ACTION_OPEN_IF_EXISTS, { Open flags }
OPEN_ACCESS_READWRITE or OPEN_SHARE_DENYNONE or { OpenMode }
OPEN_FLAGS_FAIL_ON_ERROR,
nil); { Extended attributes }
InitFailed := (ReturnCode <> 0);
end; { if }
Com_OpenKeep := NOT InitFailed;
end; { func. Com_OpenKeep }
(*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-+-*-*)
function TOs2Obj.Com_Open(Comport: Byte; BaudRate: Longint; DataBits: Byte;
Parity: Char; StopBits: Byte): Boolean;
begin
InitFailed := true;
if Com_OpenKeep(Comport) then
begin
Com_SetLine(BaudRate, Parity, DataBits, StopBits);
InitFailed := false;
end; { if }
Com_Open := NOT InitFailed;
end; { func. TOs2Obj.Com_OpenCom }
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -