adport.pas

测试用例

      if NewMode then begin
        {Force rts/cts flow control off}
        NewFlowOpts := FHWFlowOptions;
        Exclude(NewFlowOpts, hwfUseRTS);
        Exclude(NewFlowOpts, hwfRequireCTS);
        SetHWFlowOptions(NewFlowOpts);

        {Force RTS off}
        RTS := False;
      end;
    end;
  end;

  procedure TApdCustomComPort.SetBaseAddress(NewBaseAddress : Word);
    {-Set the base address}
  begin
    if (BaseAddress <> NewBaseAddress) or Force then begin
      if (PortState = psOpen) then
        Dispatcher.SetBaseAddress(NewBaseAddress);
    end;
  end;

  procedure TApdCustomComPort.SetThreadBoost(NewBoost : TApThreadBoost);
  begin
    if (FThreadBoost <> NewBoost) or Force then begin
      FThreadBoost := NewBoost;
      if (PortState = psOpen) then
        Dispatcher.SetThreadBoost(Ord(NewBoost));
    end;
  end;

  function TApdCustomComPort.GetBaseAddress : Word;
    {-Get the base address}
  begin
    if (PortState = psOpen) then
      Result := Dispatcher.GetBaseAddress
    else
      Result := 0;
  end;

{TApdComPort protected}

  function TApdCustomComPort.ActivateDeviceLayer : TApdBaseDispatcher;
  begin
    if Assigned(fCustomDispatcher) then
      Result := CustomDispatcher(Self)
    else case DeviceLayer of
    dlWin32  :
      if TapiMode = tmOn then
        Result := TApdTAPI32Dispatcher.Create(Self,FTapiCID)
      else
        Result := TApdWin32Dispatcher.Create(Self);
    else
      raise ENullAPI.Create(ecNullAPI, False);
    end;
  end;

  procedure TApdCustomComPort.DeviceLayerChanged;
    {-Notification that device layer has changed}
  begin
    { Do nothing at this level }
  end;

  function TApdCustomComPort.InitializePort : Integer;
  var
    Temp : array[0..12] of Char;
    FlowFlags : DWORD;

    function MakeComName(const ComNum : Word) : PChar;
      {-Return a string like 'COMXX'}
    begin
      if TapiMode <> tmOn then begin
        StrFmt(Temp, '\\.\COM%d', [ComNum]);
        Result := Temp;
      end else
        Result := nil;
    end;

  begin
    { Set up initial flow control info }
    FlowFlags := 0;

    { Manual settings }
    if FDTR then FlowFlags := (FlowFlags or ipAssertDTR);
    if FRTS then FlowFlags := (FlowFlags or ipAssertRTS);

    if (hwfUseDTR in FHWFlowOptions) then
      FlowFlags := (FlowFlags or ipAutoDTR);

    if (hwfUseRTS in FHWFlowOptions) then
      FlowFlags := (FlowFlags or ipAutoRTS);

    Result := Dispatcher.InitPort(MakeComName(FComNumber), FBaud,
      Ord(FParity), FDatabits, FStopbits, FInSize, FOutSize, FlowFlags);
  end;

  procedure TApdCustomComPort.Loaded;
    {-Physically open the port if FOpen is True}
  begin
    inherited Loaded;

    if not (csDesigning in ComponentState) then begin
      if ForceOpen then
        FOpen := True;
      if FOpen then begin
        ForceOpen := False;
        try
          InitPort;
        except
          FOpen := False;
          Application.HandleException(nil);
        end;
      end;
    end;
  end;

  procedure TApdCustomComPort.Trigger(Msg, TriggerHandle, Data : Word);
    {-For internal processing of all triggers}
  begin
    if Assigned(FOnTrigger) then
      FOnTrigger(Self, Msg, TriggerHandle, Data);
  end;

  procedure TApdCustomComPort.TriggerAvail(Count : Word);
    {-For internal triggeravail processing}
  begin
    if Assigned(FOnTriggerAvail) then
      FOnTriggerAvail(Self, Count);
  end;

  procedure TApdCustomComPort.TriggerData(TriggerHandle : Word);
    {-For internal triggerdata processing}
  begin
    if Assigned(FOnTriggerData) then
      FOnTriggerData(Self, TriggerHandle);
  end;

  procedure TApdCustomComPort.TriggerStatus(TriggerHandle : Word);
    {-For internal triggerstatus processing}
  begin
    if Assigned(FOnTriggerStatus) then
      FOnTriggerStatus(Self, TriggerHandle);
  end;

  procedure TApdCustomComPort.TriggerTimer(TriggerHandle : Word);
    {-For internal triggertimer processing}
  begin
    if Assigned(FOnTriggerTimer) then
      FOnTriggerTimer(Self, TriggerHandle);
  end;

  procedure TApdCustomComPort.UpdateHandlerFlag;
  begin
    if (PortState <> psOpen) then Exit;
    if Assigned(FOnTrigger) or Assigned(FOnTriggerAvail) or
      Assigned(FOnTriggerData) or Assigned(FOnTriggerStatus) or
      Assigned(FOnTriggerTimer) or Assigned(FOnTriggerLineError) or
      Assigned(FOnTriggerModemStatus) or Assigned(FOnTriggerOutbuffFree) or
      Assigned(FOnTriggerOutbuffUsed) or Assigned(FOnTriggerOutSent) then
      FDispatcher.UpdateHandlerFlags(fuEnablePort)
    else
      FDispatcher.UpdateHandlerFlags(fuDisablePort);
  end;

  procedure TApdCustomComPort.PortOpen;
    {-Port open processing}
  var
    I : Word;
    UL : PUserListEntry;
  begin
    {Tell all comport users that the port is now open}
    if UserList.Count > 0 then begin
      for I := UserList.Count-1 downto 0 do begin
        UL := UserList.Items[I];
        with UL^ do begin
          if Handle <> 0 then
            SendMessage(Handle, APW_PORTOPEN, 0, 0)
          else begin                                                     {!!.03}
            if IsEx then                                                 {!!.03}
              UL^.OpenCloseEx(Self, ctOpen)                              {!!.03}
            else                                                         {!!.03}
              UL^.OpenClose(Self, True);
          end;                                                           {!!.03}
        end;
      end;
    end;

    if Assigned(FOnPortOpen) then
      FOnPortOpen(Self);
  end;

  procedure TApdCustomComPort.PortClose;
    {-Port close processing}
  var
    I : Word;
    UL : PUserListEntry;
  begin
    {Tell all comport users that the port is now closed}
    if UserList.Count > 0 then begin
      for I := UserList.Count-1 downto 0 do begin
        UL := UserList.Items[I];
        with UL^ do begin
          if Handle <> 0 then
            SendMessage(Handle, APW_PORTCLOSE, 0, 0)
          else begin                                                     {!!.03}
            if IsEx then                                                 {!!.03}
              UL^.OpenCloseEx(Self, ctClosed)                            {!!.03}
            else                                                         {!!.03}
              UL^.OpenClose(Self, False);
          end;                                                           {!!.03}
        end;
      end;
    end;

    if Assigned(FOnPortClose) then
      FOnPortClose(Self);
  end;

  procedure TApdCustomComPort.PortClosing;                               {!!.03}
    {-Port closing processing, sent to other controls to notify that the port }
    { is starting to close for cleanup }
  var
    I : Word;
    UL : PUserListEntry;
  begin
    { tell all users that the port is now being closed }
    if UserList.Count > 0 then begin
      for I := pred(UserList.Count) downto 0 do begin
        UL := UserList.Items[I];
        { only notify if they are registered as extended }
        if UL^.IsEx then
          with UL^ do begin
            if Handle <> 0 then
              SendMessage(Handle, APW_CLOSEPENDING, 0, 0)
            else
              UL^.OpenCloseEx(Self, ctClosing);
          end;
      end;
    end;
  end;

  procedure TApdCustomComPort.TriggerLineError(const Error : Word;
                                            const LineBreak : Boolean);
    {-Received a line error}
  begin
    if Assigned(FOnTriggerLineError) then
      FOnTriggerLineError(Self, Error, LineBreak);
  end;

  procedure TApdCustomComPort.TriggerModemStatus;
    {-Received a modem status change}
  begin
    if Assigned(FOnTriggerModemStatus) then
      FOnTriggerModemStatus(Self);
  end;

  procedure TApdCustomComPort.TriggerOutbuffFree;
    {-Received and outbuff free trigger}
  begin
    if Assigned(FOnTriggerOutbuffFree) then
      FOnTriggerOutbuffFree(Self);
  end;

  procedure TApdCustomComPort.TriggerOutbuffUsed;
    {-Received and outbuff used trigger}
  begin
    if Assigned(FOnTriggerOutbuffUsed) then
      FOnTriggerOutbuffUsed(Self);
  end;

  procedure TApdCustomComPort.TriggerOutSent;
    {-Received an outsent trigger}
  begin
    if Assigned(FOnTriggerOutSent) then
      FOnTriggerOutSent(Self);
  end;

  procedure TApdCustomComPort.WaitChar(C : Char);
    {-Received a character in WaitForString or WaitForMultiString}
  begin
    if Assigned(FOnWaitChar) then
      FOnWaitChar(Self, C);
  end;

  procedure TApdCustomComPort.RegisterComPort(Enabling : Boolean);
    {-Use a hidden window to get triggers}
  var
    Instance : THandle;
  begin
    if Enabling then begin
      {Make sure the window is registered}
      RegisterComWindow;

      if ModuleIsLib and not ModuleIsPackage then
        { we're a DLL, not a package }
        Instance   := SysInit.hInstance
      else
        {we're an exe or package }
        Instance   := System.MainInstance;

      {Create a window}
      fComWindow := CreateWindow(ComWindowClass,        {class name}
                                '',                     {caption}
                                ws_Overlapped,          {window style}
                                0,                      {X}
                                0,                      {Y}
                                0,                      {width}
                                0,                      {height}
                                0,                      {parent}
                                0,                      {menu}
                                Instance,               {instance}
                                nil);                   {parameter}

      {Register it}
      FDispatcher.RegisterWndTriggerHandler(ComWindow);              
    end else begin
      {Deregister it}
      FDispatcher.DeregisterWndTriggerHandler(ComWindow);
      DestroyWindow(ComWindow);
    end;
  end;

  procedure TApdCustomComPort.ValidateComport;
  var
    ComSelDlg : TComSelectForm;                                    
  begin
    if (FComNumber = 0) then
      if (not FPromptForPort) then
        raise ENoPortSelected.Create(ecNoPortSelected, False)
      else begin
        ComSelDlg := TComSelectForm.Create(Application);
        try
          if (ComSelDlg.ShowModal = mrOk) then
            ComNumber := ComSelDlg.SelectedComNum
          else
            raise ENoPortSelected.Create(ecNoPortSelected, False);
        finally
          ComSelDlg.Free;
        end;
      end;                                                           
  end;

  constructor TApdCustomComPort.Create(AOwner : TComponent);
    {-Create the object instance}
  begin

    {Create the registration list before notification events are sent}
    UserList := TList.Create;

    {No override by default}
    OverrideLine := False;

    {This causes notification events for all other components}
    inherited Create(AOwner);

    {Private inits}
    Force := False;
    PortState := psClosed;
    ForceOpen := False;
    CopyTriggers := False;
    BusyBeforeWait := False;
    WaitPrepped := False;
    fComWindow := 0;

    {Data inits}
    FDeviceLayers := [dlWin32];
    FPromptForPort := adpoDefPromptForPort;
    FDeviceLayer := adpoDefDeviceLayer;
    FDispatcher := nil;
    FComNumber := adpoDefComNumber;
    FOpen      := adpoDefOpen;
    FAutoOpen  := adpoDefAutoOpen;
    FDTR       := adpoDefDTR;
    FRTS       := adpoDefRTS;
    FSWFlowOptions := adpoDefSWFlowOptio