awuser.pas

Async Professional 4.04

    CidEx := OpenCom(AComName, InSize, OutSize);
    if CidEx < 0 then begin
      if CidEx = ecOutOfMemory then
        Result := ecOutOfMemory
      else
        Result := -Integer(GetLastError);
      DonePort;
      Exit;
    end;

    {set the buffer sizes}
    Result := SetCommBuffers(InSize, OutSize);
    if Result <> 0 then begin
      DonePort;
      Exit;
    end;

    {Allocate dispatch buffer}
    DBuffer := AllocMem(DispatchBufferSize);

    {Allocate output buffer}
    OBuffer := AllocMem(OutSize);
    OBufHead := 0;
    OBufTail := 0;
    OBufFull := False;

    {Initialize fields}
    InQue := InSize;
    OutQue := OutSize;
    LastError := 0;
    OutSentPending := False;
    ClosePending := False;
    fDispatcherWindow := 0;
    DispatchFull := False;
    GetCount := 0;
    LastLineErr := 0;
    LastModemStatus := 0;
    RS485Mode := False;
    BaseAddress := 0;

    {Assure DCB is up to date in all cases}
    GetComState(DCB);

    { Set initial flow control options }
    if (FlowOpts and ipAutoDTR) <> 0 then begin
      DTRAuto := True;
    end else begin
      DTRAuto := False;
      SetDTR((FlowOpts and ipAssertDTR) <> 0);
    end;

    if (FlowOpts and ipAutoRTS) <> 0 then begin
      RTSAuto := True;
    end else begin
      RTSAuto := False;
      SetRTS((FlowOpts and ipAssertRTS) <> 0);
    end;

    {Trigger inits}
    LastTailData := 0;
    LastTailLen := 1;
    RemoveAllTriggers;
    DBufHead := 0;
    DBufTail := 0;
    NotifyTail := 0;
    ResetStatusHits;

    InAvailMessage := False;

    ModemStatus := 0;
    GetModemStatusPrim($F0);

    {Set the requested line parameters}
    LastBaud := 115200;

    Error := SetLine(Baud, Parity, DataBits, StopBits);
    if Error <> ecOk then begin
      Result := Error;
      DonePort;
      Exit;
    end;

    {Get initial status}
    RefreshStatus;

    TracingOn := False;
    TraceQueue := nil;
    TraceIndex := 0;
    TraceMax := 0;
    TraceWrapped := False;

    TimeBase := AdTimeGetTime;
    DLoggingOn := False;
    DLoggingQueue := nil;
    DLoggingHead := 0;
    DLoggingTail := 0;
    DLoggingFree := 0;
    DLoggingMax := 0;

    {Start the dispatcher}
    StartDispatcher;
  end;

  function TApdBaseDispatcher.InitSocket(Insize, OutSize : Cardinal) : Integer;
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
  begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
    Result := ecOK;

    {Create a socket}
    CidEx := OpenCom(nil, InSize, OutSize);
    if CidEx < 0 then begin
      Result := -CidEx;
      DonePort;
      Exit;
    end;

    {Connect or bind socket}
    if not SetupCom(0, 0) then begin
      Result := -GetComError(ComStatus);
      DonePort;
      Exit;
    end;

    {Allocate dispatch buffer}
    DBuffer := AllocMem(DispatchBufferSize);

    {Initialize fields}
    InQue := InSize;
    OutQue := OutSize;

    {Trigger inits}
    LastTailLen := 1;

    {Set default options}
    ModemStatus := 0;

    {Get initial status}
    RefreshStatus;

    TimeBase := AdTimeGetTime;                                      

    {Start the dispatcher}
    StartDispatcher;
  end;

  function TApdBaseDispatcher.SetCommBuffers(InSize, OutSize : Integer) : Integer;
    {-Set the new buffer sizes, win32 only}
  begin
    if SetupCom(InSize, OutSize) then
      Result := ecOK
    else
      Result := -Integer(GetLastError);
  end;

  procedure TApdBaseDispatcher.DonePortPrim;
    {-Close the port and free the handle}
  begin
    {Stop dispatcher}
    EnterCriticalSection(DataSection);                                   {!!.02}
    try                                                                  {!!.02}
      DoDonePortPrim := False;                                           {!!.02}
      if DispActive then
        StopDispatcher;
      { Free memory for the output buffer }
      if OBuffer <> nil then begin
        FreeMem(OBuffer);
        OBuffer := nil;
      end;

      { Free memory for the dispatcher buffer }
      if DBuffer <> nil then begin
        FreeMem(DBuffer, DispatchBufferSize);
        DBuffer := nil;
      end;
    finally                                                              {!!.02}
      LeaveCriticalSection(DataSection);                                 {!!.02}
    end;                                                                 {!!.02}
  end;

  procedure TApdBaseDispatcher.DonePort;
    {-Close the port and free the handle}
  begin
    {Always close the physical port...}
    if CidEx >= 0 then begin
      {Flush the output queue}
      FlushOutBuffer;
      FlushInBuffer;                                                

      CloseCom;
    end;

    {...but destroy our object only if not within a notify}
    if fEventBusy then begin
      ClosePending := True;
    end else
      DonePortPrim;
  end;

  function ActualBaud(BaudCode : LongInt) : Longint;              
  const
    BaudTable : array[0..23] of LongInt =
      (110,    300,    600,    1200,    2400,    4800,    9600,    14400,
       19200,  0,      0,      38400,   0,       0,       0,       56000,
       0,      0,      0,      128000,  0,       0,       0,       256000);
  var
    Index : Cardinal;
    Baud : LongInt;                                                
  begin
    if BaudCode = $FEFF then
      {COMM.DRV's 115200 hack}
      Result := 115200
    else if BaudCode < $FF10 then
      {Must be a baud rate, return it}
      Result := BaudCode
    else begin
      {It's a code, look it up}
      Index := BaudCode - $FF10;
      if Index > 23 then
        {Unknown code, just return it}
        Result := BaudCode
      else begin
        Baud := BaudTable[Index];
        if Baud = 0 then
          {Unknown code, just return it}
          Result := BaudCode
        else
          Result := Baud;
      end;
    end;
  end;

  { Wait till pending Tx Data is sent for H -- used for line parameter }
  { changes -- so the data in the buffer at the time the change is made }
  { goes out under the "old" line parameters. }
  procedure TApdBaseDispatcher.WaitTxSent;
  var
    BitsPerChar     : DWORD;
    BPS             : Longint;
    MicroSecsPerBit : DWORD;
    MicroSecs       : DWORD;
    MilliSecs       : DWORD;
    TxWaitCount     : Integer;
  begin
    { Wait till our Output Buffer becomes free. }
    { If output hasn't drained in 10 seconds, punt. }
    TxWaitCount := 0;
    while((OutBuffUsed > 0) and (TxWaitCount < 5000)) do begin
      Sleep(2);
      Inc(TxWaitCount);
    end;

    { Delay based upon a 16-character TX FIFO + 1 character for TX output }
    { register + 1 extra character for slop (= 18).  Delay is based upon }
    { 1/bps * (start bit + data bits + parity bit + stop bits). }

    GetComState(DCB);
    BitsPerChar := DCB.ByteSize + 2;   { Bits per Char + 1 start + 1 stop }
    if (DCB.Parity <> 0) then
      Inc(BitsPerChar);
    if (DCB.StopBits <> 0) then
      Inc(BitsPerChar);
    BPS := ActualBaud(LastBaud);
    MicroSecsPerBit := 10000000 div BPS;
    MicroSecs := MicroSecsPerBit * BitsPerChar * 18;
    if (MicroSecs < 10000) then
      MicroSecs := MicroSecs + MicroSecs;
    MilliSecs := Microsecs div 10000;
    if ((Microsecs mod 10000) <> 0) then
      Inc(MilliSecs);
    Sleep(MilliSecs);
  end;

  function TApdBaseDispatcher.SetLine(
                    Baud : LongInt;
                    Parity : Cardinal;
                    DataBits : TDatabits;
                    StopBits : TStopbits) : Integer;
  var
    NewBaudRate  : DWORD;
    NewParity    : Cardinal;
    NewByteSize  : TDatabits;
    NewStopBits  : Byte;
    {-Set or change the line parameters}
  begin
    Result := ecOK;
    EnterCriticalSection(DataSection);
    try
      {Get current DCB parameters}
      GetComState(DCB);

      {Set critical default DCB options}
      with DCB do begin
        Flags := Flags or dcb_Binary;
        Flags := Flags and not dcb_Parity;
        Flags := Flags and not dcb_DsrSensitivity;
        Flags := Flags or dcb_TxContinueOnXoff;
        Flags := Flags and not dcb_Null;
      end;

      {Validate stopbit range}
      if StopBits <> DontChangeStopBits then
        if StopBits < 1 then
          StopBits := 1
        else if StopBits > 2 then
          StopBits := 2;

      {Determine new line parameters}
      if Baud <> DontChangeBaud then begin
        NewBaudRate := Baud;
      end else
        NewBaudRate := DCB.BaudRate;

      if Parity <> DontChangeParity then
        NewParity := Parity
      else
        NewParity := DCB.Parity;

      NewStopBits := DCB.StopBits;

      if DataBits <> DontChangeDataBits then
      begin
        NewByteSize := DataBits;
        if (DataBits = 5) then
          NewStopBits := One5StopBits;
      end else
        NewByteSize := DCB.ByteSize;

      if StopBits <> DontChangeStopBits then begin
        NewStopBits := StopBitArray[StopBits];
        if (NewByteSize = 5) then
          NewStopBits := One5StopBits;
      end;
    finally
      LeaveCriticalSection(DataSection);
    end;

    if ((DCB.BaudRate = NewBaudRate) and
        (DCB.Parity = NewParity) and
        (DCB.ByteSize = NewByteSize) and
        (DCB.StopBits = NewStopBits)) then
      Exit;

    { wait for the chars to be transmitted, don't want to change line }
    { settings while chars are pending }
    WaitTxSent;

    EnterCriticalSection(DataSection);
    try
      {Get current DCB parameters}
      GetComState(DCB);

      {Change the parameters}
      DCB.BaudRate := NewBaudRate;
      DCB.Parity   := NewParity;
      DCB.ByteSize := NewByteSize;
      DCB.StopBits := NewStopBits;

      {Set line parameters}
      Result := SetCommStateFix(DCB);
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  procedure TApdBaseDispatcher.GetLine(
                    var Baud : LongInt;
                    var Parity : Word;
                    var DataBits : TDatabits;
                    var StopBits : TStopbits);
    {-Return line parameters}
  begin
    EnterCriticalSection(DataSection);
    try
      {Get current DCB parameters}
      GetComState(DCB);

      {Return the line parameters}
      Baud := ActualBaud(DCB.Baudrate);

      Parity := DCB.Parity;
      DataBits := DCB.ByteSize;
      if DCB.StopBits = OneStopBit then
        StopBits := 1
      else
        StopBits := 2;
    finally
      LeaveCriticalSection(DataSection);
    end;
  end;

  function TApdBaseDispatcher.SetModem(Dtr, Rts : Boolean) : Integer;
    {-Set modem control lines, Dtr and Rts}
  begin
    Result := SetDtr(Dtr);
    if Result = ecOK then
      Result := SetRts(Rts);                                             {!!.02}