?? awwin32.pas
字號:
{*********************************************************}
{* AWWIN32.PAS 4.04 *}
{* Copyright (C) TurboPower Software 1996-2002 *}
{* All rights reserved. *}
{*********************************************************}
{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}
{Options required for this unit}
{$X+,F+,K+,B-}
unit AwWin32;
{-Device layer for standard Win32 communications API}
interface
uses
Windows,
Classes,
SysUtils,
AdWUtil,
AdSocket,
OoMisc,
awUser;
type
TApdWin32Dispatcher = class(TApdBaseDispatcher)
protected
ReadOL : TOverLapped;
WriteOL : TOverLapped;
function EscapeComFunction(Func : Integer) : LongInt; override;
function FlushCom(Queue : Integer) : Integer; override;
function GetComError(var Stat : TComStat) : Integer; override;
function GetComEventMask(EvtMask : Integer) : Cardinal; override;
function GetComState(var DCB: TDCB): Integer; override;
function SetComState(var DCB : TDCB) : Integer; override;
function ReadCom(Buf : PChar; Size: Integer) : Integer; override;
function WriteCom(Buf : PChar; Size: Integer) : Integer; override;
function SetupCom(InSize, OutSize : Integer) : Boolean; override;
procedure StartDispatcher; override;
procedure StopDispatcher; override;
function WaitComEvent(var EvtMask : DWORD;
lpOverlapped : POverlapped) : Boolean; override;
public
function CloseCom : Integer; override;
function OpenCom(ComName: PChar; InQueue,
OutQueue : Cardinal) : Integer; override;
function ProcessCommunications : Integer; override;
end;
TApdTAPI32Dispatcher = class(TApdWin32Dispatcher)
public
constructor Create(Owner : TObject; InCid : Integer);
function OpenCom(ComName: PChar; InQueue,
OutQueue : Cardinal) : Integer; override;
end;
implementation
{$IFDEF TRIALRUN}
{$I TRIAL07.INC}
{$I TRIAL03.INC}
{$I TRIAL01.INC}
{$ENDIF}
function TApdWin32Dispatcher.CloseCom : Integer;
{-Close the comport and cleanup}
begin
{Release the events}
if ReadOL.hEvent <> 0 then begin
CloseHandle(ReadOL.hEvent);
ReadOL.hEvent := 0;
end;
if WriteOL.hEvent <> 0 then begin
CloseHandle(WriteOL.hEvent);
WriteOL.hEvent := 0;
end;
if DispActive then begin
KillThreads := True;
{Force the comm thread to wake...}
SetCommMask(CidEx, 0);
SetEvent(ReadyEvent);
ResetEvent(GeneralEvent);
{$IFDEF DebugThreadConsole}
Writeln(ThreadStatus(ComKill));
{$ENDIF}
end;
{Close the comport}
if CloseHandle(CidEx) then begin
Result := 0;
CidEx := -1;
end else
Result := -1;
end;
function TApdWin32Dispatcher.EscapeComFunction(Func: Integer): LongInt;
{-Perform the extended comm function Func}
begin
EscapeCommFunction(CidEx, Func);
Result := 0;
end;
function TApdWin32Dispatcher.FlushCom(Queue: Integer): Integer;
{-Flush the input or output buffer}
begin
if (Queue = 0) and (OutThread <> nil) then begin
{Flush our own output buffer...}
SetEvent(OutFlushEvent);
{ this can cause a hang when using an IR port that does not have a }
{ connection (the IR receiver is not in range), the port drivers }
{ will not flush the buffers, so we'd wait forever }
WaitForSingleObject(GeneralEvent, 5000);{INFINITE);} {!!.02}
{...XMit thread has acknowledged our request, so flush it}
EnterCriticalSection(OutputSection);
try
OBufFull := False;
OBufHead := 0;
OBufTail := 0;
Result := Integer(PurgeComm(CidEx,
PURGE_TXABORT or PURGE_TXCLEAR));
finally
LeaveCriticalSection(OutputSection);
end;
end else
Result := Integer(PurgeComm(CidEx, PURGE_RXABORT or PURGE_RXCLEAR));
if Result = 1 then
Result := 0
else
Result := -Integer(GetLastError);
end;
function TApdWin32Dispatcher.GetComError(var Stat: TComStat): Integer;
{-Get the current error and update Stat}
var
Errors : DWORD;
begin
if ClearCommError(CidEx, Errors, @Stat) then
Result := Errors
else
Result := 0;
{Replace information about Windows output buffer with our own}
with Stat do begin
EnterCriticalSection(OutputSection);
try
cbOutQue := 0;
if OBufFull then
cbOutQue := OutQue
else if OBufHead > OBufTail then
{Buffer is not wrapped}
cbOutQue := OBufHead - OBufTail
else if OBufHead < OBufTail then
{Buffer is wrapped}
cbOutQue := OBufHead + (OutQue - OBufTail);
finally
LeaveCriticalSection(OutputSection);
end;
end;
end;
function TApdWin32Dispatcher.GetComEventMask(EvtMask: Integer): Cardinal;
{-Set the communications event mask}
begin
Result := 0;
end;
function TApdWin32Dispatcher.GetComState(var DCB: TDCB): Integer;
{-Fill in DCB with the current communications state}
begin
if Integer(GetCommState(CidEx, DCB)) = 1 then
Result := 0
else
Result := -1;
end;
function TApdWin32Dispatcher.OpenCom(ComName: PChar; InQueue, OutQueue: Cardinal): Integer;
{-Open the comport specified by ComName}
{$IFDEF TRIALRUN}
{$I TRIAL04.INC}
{$ENDIF}
begin
{Open the device}
{$IFDEF TRIALRUN}
TC;
{$ENDIF}
Result := CreateFile(ComName, {name}
GENERIC_READ or GENERIC_WRITE, {access attributes}
0, {no sharing}
nil, {no security}
OPEN_EXISTING, {creation action}
FILE_ATTRIBUTE_NORMAL or
FILE_FLAG_OVERLAPPED, {attributes}
0); {no template}
if Result <> Integer(INVALID_HANDLE_VALUE) then begin
CidEx := Result;
{Create port data structure}
ReadOL.hEvent := CreateEvent(nil, True, False, nil);
WriteOL.hEvent := CreateEvent(nil, True, False, nil);
if (ReadOL.hEvent = 0) or (WriteOL.hEvent = 0) then begin
{Failed to create events, get rid of everything}
CloseHandle(ReadOL.hEvent);
CloseHandle(WriteOL.hEvent);
CloseHandle(Result);
Result := ecOutOfMemory;
Exit;
end;
end else
{Failed to open port, just return error signal, caller will
call GetLastError to get actual error code}
Result := -1;
end;
function TApdWin32Dispatcher.ReadCom(Buf: PChar; Size: Integer): Integer;
{-Read Size bytes from the comport specified by Cid}
var
OK : Bool;
Temp : DWORD;
begin
{Post a read request...}
OK := ReadFile(CidEx, {handle}
Buf^, {buffer}
Size, {bytes to read}
Temp, {bytes read}
@ReadOL); {overlap record}
{...and see what happened}
if not OK then begin
if GetLastError = ERROR_IO_PENDING then begin
{Waiting for data}
if GetOverLappedResult(CidEx, {handle}
ReadOL, {overlapped structure}
Temp, {bytes written}
True) then begin {wait for completion}
{Read complete, reset event}
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -