awuser.pas

测试用例

    if not RS485Mode then
      SetRts(RtsState);
  end;

  procedure TApdBaseDispatcher.ResetStatusHits;
  var
    i : Integer;
  begin
    for i := pred(StatusTriggers.Count) downto 0 do
      PStatusTrigger(StatusTriggers[i])^.StatusHit := False;
    GlobalStatHit := False;
  end;

  procedure TApdBaseDispatcher.ResetDataTriggers;
  var
    i : Integer;
  begin
    for i := pred(DataTriggers.Count) downto 0 do
      with PDataTrigger(DataTriggers[i])^ do
        FillChar(tChkIndex, SizeOf(TCheckIndex), 0);
  end;

  function TApdBaseDispatcher.InitPort(
                         AComName : PChar;
                         Baud : LongInt;
                         Parity : Cardinal;
                         DataBits : TDatabits;
                         StopBits : TStopbits;
                         InSize, OutSize : Cardinal;
                         FlowOpts : DWORD) : Integer;                  
  type
    OS = record
      O : Cardinal;
      S : Cardinal;
    end;
  var
    Error : Integer;
  begin
    RingFlag := False;

    {Required inits in case DonePort is called}
    DBuffer := nil;
    OBuffer := nil;
    fEventBusy := False;
    DeletePending := False;

    {Create event objects}
    ComEvent := CreateEvent(nil, False, False, nil);
    ReadyEvent := CreateEvent(nil, False, False, nil);
    GeneralEvent := CreateEvent(nil, False, False, nil);
    OutputEvent := CreateEvent(nil, False, False, nil);
    SentEvent := CreateEvent(nil, True, False, nil);
    OutFlushEvent := CreateEvent(nil, False, False, nil);
    {wake up xmit thread when it's waiting for data}
    OutWaitObjects1[0] := OutputEvent;
    OutWaitObjects1[1] := OutFlushEvent;
    {wake up xmit thread when it's waiting for i/o completion}
    OutWaitObjects2[0] := SentEvent;
    OutWaitObjects2[1] := OutFlushEvent;

    {Ask Windows to open the comm port}
    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;
  begin
    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;