awwin32.pas

Async Professional 4.04

{*********************************************************}
{*                   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}