awwin32.pas

测试用例

(***** 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):
 *
 * ***** END LICENSE BLOCK ***** *)

{*********************************************************}
{*                   AWWIN32.PAS 4.06                    *}
{*********************************************************}
{* 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) : 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

  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}
  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: 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}