V9.2
This commit is contained in:
f1iwq2
563
AwWin32.pas
Normal file
563
AwWin32.pas
Normal file
@@ -0,0 +1,563 @@
|
||||
(***** BEGIN LICENSE BLOCK *****
|
||||
* Version: MPL 1.1
|
||||
*
|
||||
* The contents of this file are subject to the Mozilla Public License Version
|
||||
* 1.1 (the "License"); you may not use this file except in compliance with
|
||||
* the License. You may obtain a copy of the License at
|
||||
* http://www.mozilla.org/MPL/
|
||||
*
|
||||
* Software distributed under the License is distributed on an "AS IS" basis,
|
||||
* WITHOUT WARRANTY OF ANY KIND, either express or implied. See the License
|
||||
* for the specific language governing rights and limitations under the
|
||||
* License.
|
||||
*
|
||||
* The Original Code is TurboPower Async Professional
|
||||
*
|
||||
* The Initial Developer of the Original Code is
|
||||
* TurboPower Software
|
||||
*
|
||||
* Portions created by the Initial Developer are Copyright (C) 1991-2002
|
||||
* the Initial Developer. All Rights Reserved.
|
||||
*
|
||||
* Contributor(s):
|
||||
* Sulaiman Mah
|
||||
* Sean B. Durkin
|
||||
* Sebastian Zierer
|
||||
*
|
||||
* ***** END LICENSE BLOCK ***** *)
|
||||
|
||||
{*********************************************************}
|
||||
{* AWWIN32.PAS 5.00 *}
|
||||
{*********************************************************}
|
||||
{* Win32 serial device layer and dispatcher *}
|
||||
{*********************************************************}
|
||||
|
||||
{
|
||||
Along with AwUser.pas, this unit defines/implements the dreaded Windows
|
||||
serial port dispatcher. This unit provides the interface to the Win32
|
||||
serial port drivers, the threading code is in AwUser.pas.
|
||||
Be extrememly cautious when making changes here or in AwUser. The multi-
|
||||
threaded nature, and very strict timing requirements, can lead to very
|
||||
unpredictable results. Things as simple as adding doing a writeln to a
|
||||
console window can dramatically change the results.
|
||||
}
|
||||
|
||||
{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) : Integer; 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 : PAnsiChar; Size: Integer) : Integer; override;
|
||||
function WriteCom(Buf : PAnsiChar; 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;
|
||||
function OutBufUsed: Cardinal; override; // SWB
|
||||
public
|
||||
function CloseCom : Integer; override;
|
||||
function OpenCom(ComName: PChar; InQueue,
|
||||
OutQueue : Cardinal) : Integer; override;
|
||||
function ProcessCommunications : Integer; override;
|
||||
function CheckPort(ComName: PChar): Boolean; override;
|
||||
end;
|
||||
|
||||
TApdTAPI32Dispatcher = class(TApdWin32Dispatcher)
|
||||
public
|
||||
constructor Create(Owner : TObject; InCid : Integer);
|
||||
function OpenCom(ComName: PChar; InQueue,
|
||||
OutQueue : Cardinal) : Integer; override;
|
||||
end;
|
||||
|
||||
implementation
|
||||
|
||||
uses
|
||||
StrUtils;
|
||||
|
||||
function TApdWin32Dispatcher.CheckPort(ComName: PChar): Boolean; //SZ
|
||||
// Returns true if a port exists
|
||||
var
|
||||
Tmp: string;
|
||||
CC: PCommConfig;
|
||||
Len: Cardinal;
|
||||
begin
|
||||
Tmp := ComName;
|
||||
if AnsiStartsText('\\.\', Tmp) then
|
||||
Delete(Tmp, 1, 4);
|
||||
|
||||
New(CC);
|
||||
try
|
||||
FillChar(CC^, SizeOf(CC^), 0);
|
||||
CC^.dwSize := SizeOf(CC^);
|
||||
Len := SizeOf(CC^);
|
||||
Result := GetDefaultCommConfig(PChar(Tmp), CC^, Len);
|
||||
finally
|
||||
Dispose(CC);
|
||||
end;
|
||||
if (not Result) and (GetLastError = ERROR_INSUFFICIENT_BUFFER) then
|
||||
begin
|
||||
GetMem(CC, Len);
|
||||
try
|
||||
FillChar(CC^, SizeOf(CC^), 0);
|
||||
CC^.dwSize := SizeOf(CC^);
|
||||
Result := GetDefaultCommConfig(PChar(Tmp), CC^, Len);
|
||||
finally
|
||||
FreeMem(CC);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TApdWin32Dispatcher.CloseCom : Integer;
|
||||
{-Close the comport and cleanup}
|
||||
begin
|
||||
// Under certain circumstances, it is possible that CloseCom can be called
|
||||
// recursively. In that event, we don't want to be re-executing this code.
|
||||
// So, set a flag to show that we are inside this method and check it
|
||||
// every time we enter. If it is already set, just exit and do nothing.
|
||||
// This used to be accomplished by acquiring the DataSection critical section
|
||||
// but this lead to occasional deadlocks.
|
||||
EnterCriticalSection(DataSection); // SWB
|
||||
if (CloseComActive) then // SWB
|
||||
begin // SWB
|
||||
LeaveCriticalSection(DataSection); // SWB
|
||||
Result := 0; // SWB
|
||||
Exit; // SWB
|
||||
end; // SWB
|
||||
CloseComActive := True; // SWB
|
||||
LeaveCriticalSection(DataSection); // SWB
|
||||
try // SWB
|
||||
{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;
|
||||
finally // SWB
|
||||
CloseComActive := False; // SWB
|
||||
end; // SWB
|
||||
end;
|
||||
|
||||
function TApdWin32Dispatcher.EscapeComFunction(Func: Integer): Integer;
|
||||
{-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}
|
||||
Stat.cbOutQue := OutBufUsed; // SWB
|
||||
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}
|
||||
begin
|
||||
{Open the device}
|
||||
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: PAnsiChar; 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}
|
||||
ResetEvent(ReadOL.hEvent);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
Result := Integer(Temp);
|
||||
end;
|
||||
|
||||
function TApdWin32Dispatcher.SetComState(var DCB: TDCB): Integer;
|
||||
{-Set the a new communications device state from DCB}
|
||||
begin
|
||||
if SetCommState(CidEx, DCB) then
|
||||
Result := 0
|
||||
else
|
||||
Result := -Integer(GetLastError);
|
||||
end;
|
||||
|
||||
function TApdWin32Dispatcher.WriteCom(Buf: PAnsiChar; Size: Integer): Integer;
|
||||
{-Write data to the comport}
|
||||
type
|
||||
PBArray = ^TBArray;
|
||||
TBArray = array[0..pred(High(Integer))] of Byte;
|
||||
var
|
||||
SizeAtEnd : Integer;
|
||||
LeftOver : Integer;
|
||||
begin
|
||||
{Add the data to the output queue}
|
||||
EnterCriticalSection(OutputSection);
|
||||
try
|
||||
{we already know at this point that there is enough room for the block}
|
||||
SizeAtEnd := OutQue - OBufHead;
|
||||
if SizeAtEnd >= Size then begin
|
||||
{can move data to output queue in one block}
|
||||
Move(Buf^, OBuffer^[OBufHead], Size);
|
||||
if SizeAtEnd = Size then
|
||||
OBufHead := 0
|
||||
else
|
||||
Inc(OBufHead, Size);
|
||||
end else begin
|
||||
{ need to use two moves }
|
||||
Move(Buf^, OBuffer^[OBufHead], SizeAtEnd);
|
||||
LeftOver := Size - SizeAtEnd;
|
||||
Move(PBArray(Buf)^[SizeAtEnd], OBuffer^, LeftOver);
|
||||
OBufHead := LeftOver;
|
||||
end;
|
||||
finally
|
||||
LeaveCriticalSection(OutputSection);
|
||||
end;
|
||||
|
||||
{...finally, wake up the output thread to send the data}
|
||||
SetEvent(OutputEvent);
|
||||
Result := Size; {report all was sent}
|
||||
end;
|
||||
|
||||
function TApdWin32Dispatcher.SetupCom(InSize, OutSize : Integer) : Boolean;
|
||||
{-Set new in/out buffer sizes}
|
||||
begin
|
||||
Result := SetupComm(CidEx, InSize, OutSize);
|
||||
end;
|
||||
|
||||
function TApdWin32Dispatcher.WaitComEvent(var EvtMask : DWORD;
|
||||
lpOverlapped : POverlapped) : Boolean;
|
||||
begin
|
||||
Result := WaitCommEvent(CidEx, EvtMask, lpOverlapped);
|
||||
end;
|
||||
|
||||
procedure TApdWin32Dispatcher.StartDispatcher;
|
||||
begin
|
||||
EnterCriticalSection(DataSection);
|
||||
try
|
||||
{See if we're already active}
|
||||
if DispActive then
|
||||
raise Exception.Create('Dispatcher already started');
|
||||
|
||||
DispActive := True;
|
||||
|
||||
{Create the com events thread}
|
||||
KillThreads := False;
|
||||
|
||||
ComThread := TComThread.Create(Self);
|
||||
{Wait for it to start...}
|
||||
WaitForSingleObject(GeneralEvent, ThreadStartWait);
|
||||
{$IFDEF DebugThreadConsole}
|
||||
Writeln(ThreadStatus(ComStart));
|
||||
{$ENDIF}
|
||||
|
||||
{Create the dispatcher thread}
|
||||
fDispThread := TDispThread.Create(Self);
|
||||
{Wait for it to start...}
|
||||
WaitForSingleObject(GeneralEvent, ThreadStartWait);
|
||||
{$IFDEF DebugThreadConsole}
|
||||
Writeln(ThreadStatus(DispStart));
|
||||
{$ENDIF}
|
||||
|
||||
{Create the output thread}
|
||||
OutThread := TOutThread.Create(Self);
|
||||
{Wait for it to start...}
|
||||
WaitForSingleObject(GeneralEvent, ThreadStartWait);
|
||||
{$IFDEF DebugThreadConsole}
|
||||
Writeln(ThreadStatus(OutStart));
|
||||
{$ENDIF}
|
||||
finally
|
||||
LeaveCriticalSection(DataSection);
|
||||
end;
|
||||
end;
|
||||
|
||||
procedure TApdWin32Dispatcher.StopDispatcher;
|
||||
var
|
||||
ET : EventTimer;
|
||||
begin
|
||||
if not DispActive then
|
||||
Exit;
|
||||
|
||||
{ Set the flag to kill the threads next time they wake, or after }
|
||||
{ their current processing }
|
||||
KillThreads := True;
|
||||
|
||||
if Assigned(OutThread) then begin
|
||||
{Force the output thread to wake...}
|
||||
SetEvent(OutFlushEvent);
|
||||
|
||||
{...and wait for it to die}
|
||||
while (OutThread <> nil) do
|
||||
SafeYield;
|
||||
|
||||
{$IFDEF DebugThreadConsole}
|
||||
Writeln(ThreadStatus(OutKill));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
if Assigned(ComThread) then begin
|
||||
{Force the comm thread to wake...}
|
||||
SetCommMask(CidEx, 0);
|
||||
SetEvent(ReadyEvent);
|
||||
|
||||
{... and wait for it to die}
|
||||
ResetEvent(GeneralEvent);
|
||||
while (ComThread <> nil) do
|
||||
SafeYield;
|
||||
|
||||
{$IFDEF DebugThreadConsole}
|
||||
Writeln(ThreadStatus(ComKill));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
{Now kill the timer}
|
||||
KillTimer(0, TimerID);
|
||||
|
||||
if Assigned(DispThread) then begin
|
||||
KillThreads := True;
|
||||
{Wait for it to die}
|
||||
NewTimer(ET, 36); { start a 2-second timer to prevent blocks }
|
||||
while (DispThread <> nil) and not(TimerExpired(ET)) do
|
||||
SafeYield;
|
||||
if DispThread <> nil then begin
|
||||
{$IFDEF DebugThreadConsole}
|
||||
WriteLn('DispThread<>nil');
|
||||
{$ENDIF}
|
||||
{ thread didn't die, reset the event }
|
||||
SetEvent(ComEvent);
|
||||
{Wait for it to die yet again}
|
||||
NewTimer(ET, 36); { start a 2-second timer to prevent blocks }
|
||||
while (DispThread <> nil) and not(TimerExpired(ET)) do
|
||||
SafeYield;
|
||||
if DispThread <> nil then
|
||||
{ disp thread is not responding, brutally terminate it }
|
||||
DispThread.Free;
|
||||
end;
|
||||
|
||||
{$IFDEF DebugThreadConsole}
|
||||
Writeln(ThreadStatus(DispKill));
|
||||
{$ENDIF}
|
||||
end;
|
||||
|
||||
if ComEvent <> INVALID_HANDLE_VALUE then begin
|
||||
if CloseHandle(ComEvent) then
|
||||
ComEvent := INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
|
||||
if ReadyEvent <> INVALID_HANDLE_VALUE then begin
|
||||
if CloseHandle(ReadyEvent) then
|
||||
ReadyEvent := INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
|
||||
if GeneralEvent <> INVALID_HANDLE_VALUE then begin
|
||||
if CloseHandle(GeneralEvent) then
|
||||
GeneralEvent := INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
|
||||
if OutputEvent <> INVALID_HANDLE_VALUE then begin
|
||||
if CloseHandle(OutputEvent) then
|
||||
OutputEvent := INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
|
||||
if SentEvent <> INVALID_HANDLE_VALUE then begin
|
||||
if CloseHandle(SentEvent) then
|
||||
SentEvent := INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
|
||||
if OutFlushEvent <> INVALID_HANDLE_VALUE then begin
|
||||
if CloseHandle(OutFlushEvent) then
|
||||
OutFlushEvent := INVALID_HANDLE_VALUE;
|
||||
end;
|
||||
end;
|
||||
|
||||
function TApdWin32Dispatcher.ProcessCommunications : Integer;
|
||||
{-Communications are running in separate threads -- give them a chance}
|
||||
begin
|
||||
Sleep(0);
|
||||
Result := 0;
|
||||
end;
|
||||
|
||||
constructor TApdTAPI32Dispatcher.Create(Owner : TObject; InCid : Integer);
|
||||
begin
|
||||
CidEx := InCid;
|
||||
inherited Create(Owner);
|
||||
end;
|
||||
|
||||
function TApdTAPI32Dispatcher.OpenCom(ComName: PChar; InQueue, OutQueue : Cardinal) : Integer;
|
||||
begin
|
||||
ReadOL.hEvent := CreateEvent(nil, True, False, nil);
|
||||
WriteOL.hEvent := CreateEvent(nil, True, False, nil);
|
||||
if (ReadOL.hEvent = 0) or (WriteOL.hEvent = 0) then begin
|
||||
CloseCom;
|
||||
Result := -1;
|
||||
Exit;
|
||||
end;
|
||||
if CidEx <> 0 then
|
||||
Result := CidEx
|
||||
else begin
|
||||
Result := ecCommNotOpen;
|
||||
SetLastError(-Result);
|
||||
end;
|
||||
end;
|
||||
// Added by SWB
|
||||
function TApdWin32Dispatcher.OutBufUsed: Cardinal;
|
||||
begin
|
||||
EnterCriticalSection(OutputSection);
|
||||
try
|
||||
Result := 0;
|
||||
if OBufFull then
|
||||
Result := OutQue
|
||||
else if OBufHead > OBufTail then
|
||||
{Buffer is not wrapped}
|
||||
Result := OBufHead - OBufTail
|
||||
else if OBufHead < OBufTail then
|
||||
{Buffer is wrapped}
|
||||
Result := OBufHead + (OutQue - OBufTail);
|
||||
finally
|
||||
LeaveCriticalSection(OutputSection);
|
||||
end;
|
||||
end;
|
||||
|
||||
end.
|
||||
Reference in New Issue
Block a user