awfossil.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 ***** *)

{*********************************************************}
{*                   AWFOSSIL.PAS 4.06                   *}
{*********************************************************}
{* Deprecated Fossil device layer/dispatcher             *}
{*********************************************************}

{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}

{Options required for this unit}
{$X+,F+}

unit AwFossil;
  {-Device layer for standard FOSSIL driver under Windows}

interface

uses
  WinTypes,
  WinProcs,
  SysUtils,
  OoMisc,
  awUser,
  awComm;

type
  TApdFossilDispatcher = class(TApdCommDispatcher)
    protected
      function CloseCom : Integer;                                          override;
      function EscapeComFunction(Func : Integer) : LongInt;                 override;
      function FlushCom(Queue : Integer) : Integer;                         override;
      function GetComError(var Stat : TComStat) : Integer;                  override;
      function GetComEventMask(EvtMask : Integer) : Word;                   override;
      function GetComState(var DCB: TDCB): Integer;                         override;
      function OpenCom(ComName: PChar; InQueue, OutQueue : Word) : Integer; override;
      function SetComEventMask(EvtMask : Word) : PWord;                     override;
      function SetComState(var DCB : TDCB) : Integer;                       override;
      function ReadCom(Buf : PChar; Size: Integer) : Integer;               override;
      function WriteCom(Buf : PChar; Size: Integer) : Integer;              override;
      procedure SetMsrShadow(OnOff : Boolean);                              override;
      function SetupCom(InSize, OutSize : Integer) : Boolean;               override;
  end;

implementation

var
  {Timer callback address}
  TimerAddr   : TFarProc;

  {Misc}
  ExitSave : Pointer;

const
  FossilTimerActive : Word = 0;

type
  {Information we need to store about each open TApdFossilDispatcher.AP port}
  TFossilPortInfo = record
    PortID     : Word;                  {Port ID, 0=COM1, 1=COM2, etc}
    EventWord  : Word;                  {Event word used by caller}
    EventFlags : Word;                  {Events we're checking for}
    Filler     : array[1..31] of Byte;  {Fill to MSR shadow locations}
    MSRShadow  : Byte;                  {MSR shadow register}
  end;

  TRegisters = record
    case Integer of
      0: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags: Word);
      1: (AL, AH, BL, BH, CL, CH, DL, DH: Byte);
  end;

  {Holds driver information from TApdFossilDispatcher.AP GetDriverInfo call}
  PDriverInfo = ^TDriverInfo;
  TDriverInfo = record
    diSize      : Word;
    diSpec      : Byte;
    diRev       : Byte;
    diID        : Pointer;
    diInSize    : Word;
    diInFree    : Word;
    diOutSize   : Word;
    diOutFree   : Word;
    diSWidth    : Byte;
    diSHeight   : Byte;
    diBaudMask  : Byte;
  end;

  DPMIRegisters = record
    drDI : LongInt;
    drSI : LongInt;
    drBP : LongInt;
    drReserved : LongInt;
    drBX : LongInt;
    drDX : LongInt;
    drCX : LongInt;
    drAX : LongInt;
    drFlags : Word;
    drES : Word;
    drDS : Word;
    drFS : Word;
    drGS : Word;
    drIP : Word;
    drCS : Word;
    drSP : Word;
    drSS : Word;
  end;

  {DOS memory pointer}
  TDosMemRec = record
    Sele, Segm : Word;
  end;

var
  {Needed by most calls so make global}
  Regs : TRegisters;

  {Info needed by each open TApdFossilDispatcher.AP port}
  FossilPorts : array[1..MaxComHandles] of TFossilPortInfo;

  {DOS memory blocks for TDriverInfo and I/O}
  InfoBlock : array[1..MaxComHandles] of TDosMemRec;
  IOBlock   : array[1..MaxComHandles] of TDosMemRec;

  {Keep track of open Cids}
  ValidCids : array[1..MaxComHandles] of Integer;

  {Timer identifier}
  FossilTimerID : Word;

const
  {Misc constants}
  FossilSignature = $1954;       {Signature returned by TApdFossilDispatcher.AP driver}
  TFossilRecAPFreq : Word = 100;        {Timer resolution}

{DPMI specifics}

  function SimulateRealModeInt(IntNo : Byte;
                               var Regs : DPMIRegisters) : Word; Assembler;
  asm
    xor     bx,bx
    mov     bl,IntNo
    xor     cx,cx       {StackWords = 0}
    les     di,Regs
    mov     ax,0300h
    int     31h
    jc      @@ExitPoint
    xor     ax,ax
  @@ExitPoint:
  end;

{Managing Cids}

  function AssignCid : Integer;
    {-Return next available CID, -1 if none left}
  var
    I : Word;
  begin
    for I := 1 to MaxComHandles do
      if ValidCids[I] = -1 then begin
        ValidCids[I] := I;
        AssignCid := I;
        Exit;
      end;
    AssignCid := -1;
  end;

  procedure RemoveCid(Cid : Integer);
    {-Mark Cid as available}
  begin
    if (Cid > 0) and (Cid <= MaxComHandles) then
      ValidCids[Cid] := -1;
  end;

{Utility routines}

  procedure FossilIntr(var Regs : TRegisters);
    {-Virtualized int}
  var
    DRegs : DPMIRegisters;
  begin
    FillChar(DRegs, SizeOf(DRegs), 0);
    with DRegs do begin
      drAX := Regs.AX;
      drBX := Regs.BX;
      drCX := Regs.CX;
      drDX := Regs.DX;
      drES := Regs.ES;
      drDI := Regs.DI;
      if SimulateRealModeInt($14, DRegs) = 0 then ;
      Regs.AX := drAX;
    end;
  end;

  function UpdateModemStatus(Cid : Word) : Byte;
    {-Return MSR from TApdFossilDispatcher.AP}
  begin
    with Regs do begin
      AH := $03;
      DX := FossilPorts[Cid].PortID;
      FossilIntr(Regs);
      UpdateModemStatus := AL;
    end;
  end;

  procedure UpdateDriverInfo(Cid : Integer; var Info : TDriverInfo);
    {-Return current driver information from the TApdFossilDispatcher.AP driver}
  begin
    with Regs do begin
      AH := $1B;
      CX := SizeOf(Info);
      DX := FossilPorts[Cid].PortID;
      Regs.ES := InfoBlock[Cid].Segm;
      Regs.DI := 0;
      FillChar(Mem[InfoBlock[Cid].Sele:0], SizeOf(Info), 0);
      FossilIntr(Regs);
      Move(Mem[InfoBlock[Cid].Sele:0], Info, SizeOf(Info));
    end;
  end;

  function FossilTimer(H : TApdHwnd; Msg : Word; wParam : Word; lParam : LongInt) : Word; export;
    {-Check status, update event word}
  var
    I : Word;
    Info : TDriverInfo;
  begin
    for I := 1 to MaxComHandles do begin
      if ValidCids[I] <> -1 then begin
        with FossilPorts[I] do begin
          {Update info}
          MSRShadow := UpdateModemStatus(I);
          UpdateDriverInfo(I, Info);

          {Set rcv/transmit bits in EventWord}
          with Info do begin
            if diInFree < diInSize then
              EventWord := EventWord or EV_RXCHAR;
            if diOutFree = diOutSize then
              EventWord := EventWord or EV_TXEMPTY;
          end;
        end;
      end;
    end;
  end;

  function TApdFossilDispatcher.CloseCom: Integer;
    {-Close TApdFossilDispatcher.AP port and possibly clear timer}
  var
    I : Word;
  begin
    Result := ecOK;

    with Regs do begin
      {Deinit the TApdFossilDispatcher.AP}
      AH := $05;
      DX := FossilPorts[CidEx].PortID;
      FossilIntr(Regs);
    end;

    {Clear our event word}
    FossilPorts[CidEx].EventWord := 0;

    {Release buffers}
    if LongInt(InfoBlock[CidEx]) <> 0 then
      GlobalDosFree(InfoBlock[CidEx].Sele);
    if LongInt(IOBlock[CidEx]) <> 0 then
      GlobalDosFree(IOBlock[CidEx].Sele);

    {See if we should release the timer}
    Dec(FossilTimerActive);
    if FossilTimerActive = 0 then
      KillTimer(0, FossilTimerID);

    RemoveCid(CidEx);
  end;

  function TApdFossilDispatcher.EscapeComFunction(Func: Integer): LongInt;
    {-Set/clear modem signals, xon/xoff status as requested}
  begin
    Result := ecOK;
    with Regs do begin
      case Func of
        SetXoff :
          AX := $1002;
        SetXon  :
          AX := $1000;
        WinTypes.SetDtr  :
          AX := $0601;
        WinTypes.ClrDtr  :
          AX := $0600;
        WinTypes.SetRts,
        WinTypes.ClrRts,
        ResetDev :
          begin
            Result := ecNotSupported;
            Exit;
          end;
      end;
      DX := FossilPorts[CidEx].PortID;
      FossilIntr(Regs);
    end;
  end;