adport.pas

测试用例

      ComWindowProc := DefWindowProc(hWindow, Msg, wParam, lParam);
      exit;
    end;
    LockPortList;
    try
      ComWindowProc := ecOK;
      if (PortList <> nil) and (LP.Dispatcher < PortList.Count) then begin
        D := PortList[LP.Dispatcher];
        if D <> nil then
          CP := TApdCustomComPort(TApdBaseDispatcher(D).Owner)
        else
          CP := nil;
        if Assigned(CP) then with CP do begin
          try
            if Msg = APW_TRIGGERAVAIL then
              Trigger(Msg, TrigHandle, Count)
            else
              Trigger(Msg, TrigHandle, LP.Data);
            case Msg of
              APW_CLOSEPENDING :
                begin
                  if FDispatcher.Active then begin
                    PostMessage(FComWindow,APW_CLOSEPENDING,0,lparam);
                  end else begin
                    {Get rid of the trigger handler}
                    RegisterComPort(False);
                    FDispatcher.Free;
                    FDispatcher := nil;
                    PortState := psClosed;
                    FOpen := False;                                      {!!.02}
                    if OpenPending then begin
                      InitPort;
                      OpenPending := False;
                    end;
                  end;
                end;
              APW_TRIGGERAVAIL :
                TriggerAvail(Count);
              APW_TRIGGERDATA :
                TriggerData(TrigHandle);
              APW_TRIGGERSTATUS :
                begin
                  TriggerStatus(TrigHandle);
                  case Dispatcher.ClassifyStatusTrigger(TrigHandle) of
                    stModem       : TriggerModemStatus;
                    stLine        : TriggerLineError(LineError, LineBreak);
                    stOutBuffFree : TriggerOutbuffFree;
                    stOutBuffUsed : TriggerOutbuffUsed;
                    stOutSent     : TriggerOutSent;
                  end;
                end;
              APW_TRIGGERTIMER :
                TriggerTimer(TrigHandle);
            end;
          except
            if GetCurrentThreadID = MainThreadID then
              Application.HandleException(nil);
          end;
        end;
      end;
    finally
      UnlockPortList;
    end;
  end;

{Misc}

  procedure RegisterComWindow;
    {-Make sure the comwindow class is registered}
  const
    Registered : Boolean = False;
  var
    XClass: TWndClass;
  begin
    if Registered then
      Exit;
    Registered := True;

    with XClass do begin
      Style         := 0;
      lpfnWndProc   := @ComWindowProc;
      cbClsExtra    := 0;
      cbWndExtra    := SizeOf(Pointer);
      if ModuleIsLib and not ModuleIsPackage then
        { we're in a DLL, not a package }
        hInstance   := SysInit.hInstance
      else
        { we're a package or exe }
        hInstance   := System.MainInstance;
      hIcon         := 0;
      hCursor       := 0;
      hbrBackground := 0;
      lpszMenuName  := nil;
      lpszClassName := ComWindowClass;
    end;
    WinProcs.RegisterClass(XClass);
  end;

  function TApdCustomComPort.ValidDispatcher : TApdBaseDispatcher;    
    {- return the current dispatcher object. Raise an exception if NIL }
  begin
    if Dispatcher = nil then
      CheckException(Self,ecCommNotOpen);
    Result := Dispatcher;                    
  end;

  procedure TApdCustomComPort.SetDeviceLayer(const NewDevice : TDeviceLayer);
    {-Set a new device layer, ignore if port is open}
  begin
    if (NewDevice <> FDeviceLayer) and (PortState = psClosed) then
      if NewDevice in FDeviceLayers then begin                       
        FDeviceLayer := NewDevice;
        DeviceLayerChanged;
      end;
  end;

  procedure TApdCustomComPort.SetComNumber(const NewNumber : Word);
    {-Set a new comnumber, close the old port if open}
  var
    WasOpen : Boolean;
    OldTracing : TTraceLogState;
    OldLogging : TTraceLogState;
  begin
    if FComNumber <> NewNumber then begin
      WasOpen := (PortState = psOpen);
      OldTracing := tlOff;
      OldLogging := tlOff;
      if (PortState = psOpen) then begin                           
        Dispatcher.SaveTriggers(SaveTriggerBuffer);
        OldTracing := Tracing;
        OldLogging := Logging;
        Open := False;
      end;
      FComNumber := NewNumber;
      if WasOpen then begin
        Tracing := OldTracing;
        Logging := OldLogging;
        Open := True;
        Dispatcher.RestoreTriggers(SaveTriggerBuffer);
      end;
    end;
  end;

  procedure TApdCustomComPort.SetBaud(const NewBaud : Longint);
    {-Set a new baud rate}
  begin
    if NewBaud <> FBaud then begin
      FBaud := NewBaud;
      if (PortState = psOpen) then                                  
        CheckException(Self,
          Dispatcher.SetLine(NewBaud, Ord(Parity), Databits, Stopbits));
    end;
  end;

  procedure TApdCustomComPort.SetParity(const NewParity : TParity);
    {-Set new parity}
  begin
    if NewParity <> FParity then begin
      FParity := NewParity;
      if (PortState = psOpen) then                                 
        CheckException(Self,
          Dispatcher.SetLine(Baud, Ord(FParity), Databits, Stopbits));
    end;
  end;

  procedure TApdCustomComPort.SetDatabits(const NewBits : Word);
    {-Set new databits}
  begin
    if NewBits <> FDatabits then begin
      FDatabits := NewBits;
      if (PortState = psOpen) then                                  
        CheckException(Self,
          Dispatcher.SetLine(Baud, Ord(Parity), FDatabits, Stopbits));
    end;
  end;

  procedure TApdCustomComPort.SetStopbits(const NewBits : Word);
    {-Set new stop bits}
  begin
    if NewBits <> FStopbits then begin
      FStopbits := NewBits;
      if (PortState = psOpen) then                                  
        CheckException(Self,
          Dispatcher.SetLine(Baud, Ord(Parity), Databits, FStopbits));
    end;
  end;

  procedure TApdCustomComPort.SetInSize(const NewSize : Word);
    {-Set new insize, requires re-opening port if port was open}
  begin
    if NewSize <> FInSize then begin
      FInSize := NewSize;
      if (PortState = psOpen) then
        Dispatcher.SetCommBuffers(NewSize, OutSize);
    end;
  end;

  procedure TApdCustomComPort.SetOutSize(const NewSize : Word);
    {-Set new outsize, requires re-opening port if port was open}
  begin
    if NewSize <> FOutSize then begin
      FOutSize := NewSize;
      if (PortState = psOpen) then                             
        Dispatcher.SetCommBuffers(InSize, NewSize);
    end;
  end;

  procedure TApdCustomComPort.SetTracing(const NewState : TTraceLogState);
    {-Set Tracing state, FTracing is modified by called methods}
  begin
    if (FTracing <> NewState) or Force then begin
      if (PortState = psOpen) then begin                           
        {Port is open -- do it}
        case NewState of
          tlOff    : if (FTracing = tlOn) or (FTracing = tlPause) then
                       AbortTracing;
          tlOn     : if FTracing = tlPause then
                       StartTracing
                     else
                       InitTracing(FTraceSize);
          tlDump   : if (FTracing = tlOn) or (FTracing = tlPause) then begin
                       StartTracing;
                       DumpTrace(FTraceName, FTraceHex);
                     end;
          tlAppend : if (FTracing = tlOn) or (FTracing = tlPause) then begin
                       StartTracing;
                       AppendTrace(FTraceName, FTraceHex);
                     end;
          tlPause  : if (FTracing = tlOn) then
                       StopTracing;
          tlClear  : if (FTracing = tlOn) or (FTracing = tlPause) then
                       ClearTracing;
        end;
      end else begin
        {Port is closed, only acceptable values are tlOff and tlOn}
        case NewState of
          tlOff, tlOn : FTracing := NewState;
          else          FTracing := tlOff;
        end;
      end;
    end;
  end;

  procedure TApdCustomComPort.SetTraceSize(const NewSize : Cardinal); 
    {-Set trace size}
  var
    OldState : TTraceLogState;
  begin
    if NewSize <> FTraceSize then begin
      if NewSize > HighestTrace then
        FTraceSize := HighestTrace
      else                                                           
        FTraceSize := NewSize;
      if (PortState = psOpen) and ((FTracing = tlOn) or (FTracing = tlPause)) then begin 
        {Trace file is open: abort, then restart to get new size}
        OldState := Tracing;
        AbortTracing;
        Tracing := OldState;
      end;
    end;
  end;

  procedure TApdCustomComPort.SetLogging(const NewState : TTraceLogState);
    {-Set Logging state, FLogging is modified by called methods}
  begin
    if (FLogging <> NewState) or Force then begin
      if (PortState = psOpen) then begin                             
        case NewState of
          tlOff    : if (FLogging = tlOn) or (FLogging = tlPause) then
                       AbortLogging;
          tlOn     : if FLogging = tlPause then
                       StartLogging
                     else
                       InitLogging(FLogSize);
          tlDump   : if (FLogging = tlOn) or (FLogging = tlPause) then begin
                       StartLogging;
                       DumpLog(FLogName, FLogHex);
                     end;
          tlAppend : if (FLogging = tlOn) or (FLogging = tlPause) then begin
                       StartLogging;
                       AppendLog(FLogName, FLogHex);
                     end;
          tlPause  : if (FLogging = tlOn) then
                       StopLogging;
          tlClear  : if (FLogging = tlOn) or (FLogging = tlPause) then
                       ClearLogging;
        end;
      end else begin
        {Port is closed, only acceptable values are tlOff and tlOn}
        case NewState of
          tlOff, tlOn : FLogging := NewState;
          else          FLogging := tlOff;
        end;
      end;
    end;
  end;

  procedure TApdCustomComPort.SetLogSize(const NewSize : Cardinal);  
    {-Set log size}
  var
    OldState : TTraceLogState;
  begin
    if NewSize <> FLogSize then begin
      if NewSize > MaxDLogQueueSize then
        FLogSize := MaxDLogQueueSize
      else
        FLogSize := NewSize;
      if (PortState = psOpen) and ((FLogging = tlOn) or (FLogging = tlPause)) then begin 
        {Log file is open: abort, then restart to get new size}
        OldState := FLogging;
        AbortLogging;
        Logging := OldState;
      end;
    end;
  end;

  procedure TApdCustomComPort.SetOpen(const Enable : Boolean);
    {-Open/close the port}
  begin
    if FOpen <> Enable then begin
      if not (csDesigning in ComponentState) and
         not (csLoading in ComponentState) then begin
        if Enable then begin
          if (PortState = psClosed) then
            { open the port }
            InitPort
          else
            { wait until we're closed }
            OpenPending := True;
        end else
          { close the port }
          DonePort;
      end else begin
        { we're loading or designing, just set a flag }
        FOpen := Enable;
        if Enable then
          ForceOpen := True;
      end;
    end;
  end;

  procedure TApdCustomComPort.SetHWFlowOptions(const NewOpts : THWFlowOptionSet);
    {-Set hardware flow options}
  const
    UseDTR : array[Boolean] of Word = (0, hfUseDTR);
    UseRTS : array[Boolean] of Word = (0, hfUseRTS);
    RequireDSR : array[Boolean] of Word = (0, hfRequireDSR);
    RequireCTS : array[Boolean] of Word = (0, hfRequireCTS);
  var
    Opts : Word;
  begin
    if (FHWFlowOptions <> NewOpts) or Force then begin
      Opts := UseDTR[hwfUseDTR in NewOpts] +
              UseRTS[hwfUseRTS in NewOpts] +
              RequireDSR[hwfRequireDSR in NewOpts] +
              RequireCTS[hwfRequireCTS in NewOpts];

      {Validate bufferfull and bufferresume if opts not zero}
      if Opts <> 0 then begin
        if (BufferFull = 0) or (BufferFull > InSize) then
          FBufferFull := Trunc(InSize * 0.9);
        if (BufferResume = 0) or (BufferResume > BufferFull) then
          FBufferResume := Trunc(InSize * 0.1);
      end;

      if (PortState = psOpen) then begin
        CheckException(Self, Dispatcher.HWFlowOptions(FBufferFull, FBufferResume, Opts))
      end;
      FHWFlowOptions := NewOpts;
      {Force RS485 mode off if using RTS/CTS flow control}
      if (hwfUseRTS in NewOpts) or
         (hwfRequireCTS in NewOpts) then
        RS485Mode := False;
    end;
  end;

  function TApdCustomComPort.GetFlowState : TFlowControlState;
    {-Return the current state of flow control}
  begin
    if (PortState <> psShuttingDown) then begin