www.pudn.com > TAPIOfControl.rar > AdPort.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 ***** *)
{*********************************************************}
{* ADPORT.PAS 4.06 *}
{*********************************************************}
{* TApdComPort component *}
{*********************************************************}
{
This unit defines the TApdCustomComPort and TApdComPort components. Both
of these are interfaces to the dispatcher, which is what does the actual
port communication. The base dispatcher is defined in AwUser.pas, serial
port dispatcher (Win32) is in AwWin32.pas, Winsock dispatcher is in
AwWnSock.pas The term dispatcher is used for the code that interfaces with
the device.
}
{Global defines potentially affecting this unit}
{$I AWDEFINE.INC}
{Options required for this unit}
{$G+,X+,F+. $J+}
{$C MOVEABLE,DEMANDLOAD,DISCARDABLE}
{!!.02} { removed Win16 references }
unit AdPort;
{-Delphi serial port component}
interface
uses
WinTypes,
WinProcs,
SysUtils,
Classes,
Messages,
Controls,
Forms,
OoMisc,
AwUser,
AwWin32,
AdExcept,
AdSelCom;
type
{Parity type}
TParity = (pNone, pOdd, pEven, pMark, pSpace);
{Activation procedure type}
TActivationProcedure = function(Owner : TObject) : TApdBaseDispatcher;
{Device layer types}
TDeviceLayer = (dlWin32, dlWinsock);
TDeviceLayers = set of TDeviceLayer;
{Baud type}
TBaudRate = LongInt;
{Tapi modes}
TTapiMode = (tmNone, tmAuto, tmOn, tmOff);
{Port state}
TPortState = (psClosed, psShuttingDown, psOpen);
{Hardware flow control types}
THWFlowOptions = (
hwfUseDTR, {Use DTR for receive flow control}
hwfUseRTS, {Use RTS for receive flow control}
hwfRequireDSR, {Require DSR before transmitting}
hwfRequireCTS); {Require CTS before transmitting}
THWFlowOptionSet = set of THWFlowOptions;
{Software flow control types}
TSWFlowOptions = (swfNone, swfReceive, swfTransmit, swfBoth);
{For reporting flow states, note: no rcv hardware flow status is provided}
TFlowControlState = (fcOff, {No flow control is in use}
fcOn, {Transmit blocked}
fcDsrHold, {Transmit blocked by low DSR}
fcCtsHold, {Transmit blocked by low CTS}
fcDcdHold, {Transmit blocked by low DCD}
fcXOutHold, {Transmit blocked by Xoff}
fcXInHold, {Receive blocked by Xoff}
fcXBothHold); {Both are blocked by Xoff}
{Tracing/logging states}
TTraceLogState = (tlOff, tlOn, tlDump, tlAppend, tlClear, tlPause);
{General trigger event handler}
TTriggerEvent = procedure(CP : TObject;
Msg, TriggerHandle, Data : Word) of object;
{Specific trigger event handlers}
TTriggerAvailEvent = procedure(CP : TObject; Count : Word) of object;
TTriggerDataEvent = procedure(CP : TObject; TriggerHandle : Word) of object;
TTriggerStatusEvent = procedure(CP : TObject;
TriggerHandle : Word) of object;
TTriggerTimerEvent = procedure(CP : TObject; TriggerHandle : Word) of object;
{Status event handlers}
TTriggerLineErrorEvent = procedure(CP : TObject;
Error : Word;
LineBreak : Boolean) of object;
{WaitChar event handler}
TWaitCharEvent = procedure(CP : TObject; C : Char) of object;
{Port open/close callbacks}
TPortCallback = procedure(CP : TObject; Opening : Boolean) of object;
{Extended port open/closing/close callbacks} {!!.03}
TApdCallbackType = (ctOpen, ctClosing, ctClosed);
TPortCallbackEx = procedure(CP : TObject; CallbackType : TApdCallbackType) of object;
{For keeping track of port users}
PUserListEntry = ^TUserListEntry;
TUserListEntry = record
Handle : THandle;
OpenClose : TPortCallback;
OpenCloseEx: TPortCallbackEx; {!!.03}
IsEx : Boolean; {!!.03}
end;
TApThreadBoost = (tbNone, tbPlusOne, tbPlusTwo);
const
{Parity strings}
ParityName : array[TParity] of string[5] =
('None', 'Odd', 'Even', 'Mark', 'Space');
{Property defaults}
adpoDefDeviceLayer = dlWin32;
adpoDefPromptForPort = True;
adpoDefComNumber = 0;
adpoDefBaudRt = 19200;
adpoDefParity = pNone;
adpoDefDatabits = 8;
adpoDefStopbits = 1;
adpoDefInSize = 4096;
adpoDefOutSize = 4096;
adpoDefOpen = False;
adpoDefAutoOpen = True;
adpoDefBaseAddress = 0;
adpoDefTapiMode = tmAuto;
adpoDefDTR = True;
adpoDefRTS = True;
adpoDefTracing = tlOff;
adpoDefTraceSize = 10000;
adpoDefTraceName = 'APRO.TRC';
adpoDefTraceHex = True;
adpoDefTraceAllHex = False;
adpoDefLogging = tlOff;
adpoDefLogSize = 10000;
adpoDefLogName = 'APRO.LOG';
adpoDefLogHex = True;
adpoDefLogAllHex = False;
adpoDefUseMSRShadow = True;
adpoDefUseEventWord = True;
adpoDefSWFlowOptions = swfNone;
adpoDefXonChar = #17;
adpoDefXoffChar = #19;
adpoDefBufferFull = 0;
adpoDefBufferResume = 0;
adpoDefTriggerLength = 1;
adpoDefCommNotificationLevel = 10;
adpoDefRS485Mode = False;
type
{Port component}
TApdCustomComPort = class(TApdBaseComponent)
private
protected {private}
{.Z+}
{Internal stuff}
Force : Boolean; {True to force property setting}
PortState : TPortState; {State of the physical port/dispatcher}
OpenPending : Boolean; {True if Open := True while shutting down}
ForceOpen : Boolean; {Force open after loading}
UserList : TList; {List of comport users}
CopyTriggers : Boolean; {Copy triggers on open}
SaveTriggerBuffer: TTriggerSave; {Triggers to copy}
BusyBeforeWait : Boolean; {True if EventBusy before Wait}
WaitPrepped : Boolean; {True if PrepareWait called}
fComWindow : THandle; {Hidden window handle}
fCustomDispatcher: TActivationProcedure;{Custom device layer activation}
FMasterTerminal : TWinControl; {The terminal that replies to requests}
{Port info}
FDeviceLayer : TDeviceLayer; {Device layer for this port}
FDeviceLayers : TDeviceLayers;
FDispatcher : TApdBaseDispatcher; {Handle to comm object}
FComNumber : Word; {Com1 - ComWhatever}
FBaud : LongInt; {Baud rate}
FParity : TParity; {Parity}
FDatabits : Word; {Data bits}
FStopbits : Word; {Stop bits}
FInSize : Word; {Input buffer size}
FOutSize : Word; {Output buffer size}
FOpen : Boolean; {True if the port is open}
FPromptForPort : Boolean;
{True to display the com port selection dialog if no port is selected}
FAutoOpen : Boolean; {True to do implicit opens}
FCommNotificationLevel : Word; {Comm notify level}
FTapiCid : Word; {Cid from TAPI}
FTapiMode : TTapiMode; {True if using TAPI}
FRS485Mode : Boolean; {True if in RS485 mode}
FThreadBoost : TApThreadBoost; {Boost for dispatcher threads}
{Modem control/status}
FDTR : Boolean; {DTR control state}
FRTS : Boolean; {RTS control state}
{Flow control}
FBufferFull : Word; {Flow control cutoff}
FBufferResume : Word; {Flow control resume}
FHWFlowOptions : THWFlowOptionSet; {Hardware flow control}
FSWFlowOptions : TSWFlowOptions; {Software flow control}
FXOnChar : Char; {Xon character}
FXOffChar : Char; {Xoff character}
{Debugging}
FTracing : TTraceLogState; {Controls Tracing state}
FTraceSize : Cardinal; {Number of tracing entries}
FTraceName : TPassString; {Name of trace file}
FTraceHex : Boolean; {True to dump trace non-printables in hex}
FTraceAllHex : Boolean; {True to dump all trace chars in hex}
FLogging : TTraceLogState; {Controls DispatchLogging state}
FLogSize : Cardinal; {Size, in bytes, of log buffer}
FLogName : TPassString; {Name of log file}
FLogHex : Boolean; {True to dump log non-printables in hex}
FLogAllHex : Boolean; {True to dump all log chars in hex}
{Options}
FUseMSRShadow : Boolean; {True to use MSR shadow reg}
FUseEventWord : Boolean; {True to use the EventWord}
{Triggers}
FTriggerLength : Word; {Number of bytes for avail trigger}
FOnTrigger : TTriggerEvent; {All-encompassing event handler}
FOnTriggerAvail : TTriggerAvailEvent; {APW_TRIGGERAVAIL events}
FOnTriggerData : TTriggerDataEvent; {APW_TRIGGERDATA events}
FOnTriggerStatus : TTriggerStatusEvent; {APW_TRIGGERSTATUS events}
FOnTriggerTimer : TTriggerTimerEvent; {APW_TRIGGERTIMER events}
FOnTriggerLineError : TTriggerLineErrorEvent; {Got line error}
FOnTriggerModemStatus : TNotifyEvent; {Got modem status change}
FOnTriggerOutbuffFree : TNotifyEvent; {Outbuff free above mark}
FOnTriggerOutbuffUsed : TNotifyEvent; {Outbuff used above mark}
FOnTriggerOutSent : TNotifyEvent; {Data was transmitted}
FOnPortOpen : TNotifyEvent; {Port just opened}
FOnPortClose : TNotifyEvent; {Port just closed}
FOnWaitChar : TWaitCharEvent; {Received char during wait}
{Property read/write methods}
procedure SetDeviceLayer(const NewDevice : TDeviceLayer);
procedure SetComNumber(const NewNumber : Word);
procedure SetBaud(const NewBaud : Longint);
procedure SetParity(const NewParity : TParity);
procedure SetDatabits(const NewBits : Word);
procedure SetStopbits(const NewBits : Word);
procedure SetInSize(const NewSize : Word);
procedure SetOutSize(const NewSize : Word);
procedure SetTracing(const NewState : TTraceLogState);
procedure SetTraceSize(const NewSize : Cardinal);
procedure SetLogging(const NewState : TTraceLogState);
procedure SetLogSize(const NewSize : Cardinal);
procedure SetOpen(const Enable : Boolean);
procedure SetHWFlowOptions(const NewOpts : THWFlowOptionSet);
function GetFlowState : TFlowControlState;
procedure SetSWFlowOptions(const NewOpts : TSWFlowOptions);
procedure SetXonChar(const NewChar : Char);
procedure SetXoffChar(const NewChar : Char);
procedure SetBufferFull(const NewFull : Word);
procedure SetBufferResume(const NewResume : Word);
procedure SetTriggerLength(const NewLength : Word);
procedure SetDTR(const NewDTR : Boolean);
procedure SetRTS(const NewRTS : Boolean);
{Trigger write methods}
procedure SetOnTrigger(const Value : TTriggerEvent);
procedure SetOnTriggerAvail(const Value : TTriggerAvailEvent);
procedure SetOnTriggerData(const Value : TTriggerDataEvent);
procedure SetOnTriggerStatus(const Value : TTriggerStatusEvent);
procedure SetOnTriggerTimer(const Value : TTriggerTimerEvent);
procedure SetOnTriggerLineError(const Value : TTriggerLineErrorEvent);
procedure SetOnTriggerModemStatus(const Value : TNotifyEvent);
procedure SetOnTriggerOutbuffFree(const Value : TNotifyEvent);
procedure SetOnTriggerOutbuffUsed(const Value : TNotifyEvent);
procedure SetOnTriggerOutSent(const Value : TNotifyEvent);
function GetBaseAddress : Word;
function GetDispatcher : TApdBaseDispatcher;
function GetModemStatus : Byte;
function GetDSR : Boolean;
function GetCTS : Boolean;
function GetRI : Boolean;
function GetDCD : Boolean;
function GetDeltaDSR : Boolean;
function GetDeltaCTS : Boolean;
function GetDeltaRI : Boolean;
function GetDeltaDCD : Boolean;
function GetLineError : Word;
function GetLineBreak : Boolean;
function GetInBuffUsed : Word;
function GetInBuffFree : Word;
function GetOutBuffUsed : Word;
function GetOutBuffFree : Word;
procedure SetUseEventWord(NewUse : Boolean);
procedure SetCommNotificationLevel(NewLevel : Word);
procedure SetRS485Mode(NewMode : Boolean);
procedure SetBaseAddress(NewBaseAddress : Word);
procedure SetThreadBoost(NewBoost : TApThreadBoost);
protected
{Misc}
function ActivateDeviceLayer : TApdBaseDispatcher; virtual;
procedure DeviceLayerChanged; virtual;
function InitializePort : integer; virtual;
procedure Loaded; override;
procedure RegisterComPort(Enabling : Boolean); virtual;
procedure ValidateComport; virtual;
procedure SetUseMSRShadow(NewUse : Boolean); virtual;
{Trigger event methods}
procedure Trigger(Msg, TriggerHandle, Data : Word); virtual;
procedure TriggerAvail(Count : Word); virtual;
procedure TriggerData(TriggerHandle : Word); virtual;
procedure TriggerStatus(TriggerHandle : Word); virtual;
procedure TriggerTimer(TriggerHandle : Word); virtual;
procedure UpdateHandlerFlag; virtual;
{Port open/close/change event methods}
procedure PortOpen; dynamic;
procedure PortClose; dynamic;
procedure PortClosing; dynamic; {!!.03}
{Status trigger methods}
procedure TriggerLineError(const Error : Word;
const LineBreak : Boolean); virtual;
procedure TriggerModemStatus; virtual;
procedure TriggerOutbuffFree; virtual;
procedure TriggerOutbuffUsed; virtual;
procedure TriggerOutSent; virtual;
{Wait trigger method}
procedure WaitChar(C : Char); virtual;
{Tracing}
procedure InitTracing(const NumEntries : Cardinal);
procedure DumpTrace(const FName : ShortString; const InHex : Boolean);
procedure AppendTrace(const FName : ShortString; const InHex : Boolean);
procedure ClearTracing;
procedure AbortTracing;
procedure StartTracing;
procedure StopTracing;
{DispatchLogging}
procedure InitLogging(const Size : Cardinal);
procedure DumpLog(const FName : ShortString; const InHex : Boolean);
procedure AppendLog(const FName : ShortString; const InHex : Boolean);
procedure ClearLogging;
procedure AbortLogging;
procedure StartLogging;
procedure StopLogging;
public
OverrideLine : Boolean; {True to override line parms}
{Creation/destruction}
constructor Create(AOwner : TComponent); override;
{-Create a TApdComPort component}
destructor Destroy; override;
{-Destroy a TApdComPort component}
{General}
procedure InitPort; dynamic;
{-Physically open the serial port}
procedure DonePort; virtual;
{-Physically close the serial port}
procedure Assign(Source: TPersistent); override;
{-Assign fields from TApdComPort object specified by Source}
procedure ForcePortOpen;
{-Force the port open after it is loaded}
procedure SendBreak(Ticks : Word; Yield : Boolean);
{-Send a line break of ticks duration}
procedure SetBreak(BreakOn : Boolean);
{-Sets or clears line break condition}
{.Z-}
procedure RegisterUser(const H : THandle);
{-Register a TApdComPort user to receive PortOpen/PortClose events}
procedure RegisterUserEx(const H : THandle); {!!.03}
{-Register a TApdComPort user to receive open/closing/close events}
procedure RegisterUserCallback(CallBack : TPortCallback);
{-Register a TApdComPort user to receive callbacks}
procedure RegisterUserCallbackEx(CallBackEx : TPortCallbackEx); {!!.03}
{-Register a TApdComPort user to receive extended callbacks}
procedure DeregisterUser(const H : THandle);
{-Deregister a TApdComPort user from receiving PortOpen/PortClose events}
procedure DeregisterUserCallback(CallBack : TPortCallback);
{-Deregister a TApdComPort user callback}
procedure DeregisterUserCallbackEx(CallBackEx : TPortCallbackEx); {!!.03}
{-Deregister a TApdComPort user callback}
procedure ProcessCommunications; virtual;
{-Call the internal dispatcher}
procedure FlushInBuffer;
{-Discard the contents of the input buffer}
procedure FlushOutBuffer;
{-Discard the contents of the output buffer}
{Trigger managment}
function AddDataTrigger(const Data : ShortString;
const IgnoreCase : Boolean) : Word;
{-Add a data trigger}
function AddTimerTrigger : Word;
{-Add a timer trigger}
function AddStatusTrigger(const SType : Word) : Word;
{-Add a status trigger}
procedure RemoveTrigger(const Handle : Word);
{-Remove a trigger}
procedure RemoveAllTriggers;
{-Remove all triggers}
procedure SetTimerTrigger(const Handle : Word; const Ticks : LongInt;
const Activate : Boolean);
{-Activate or deactivate a timer trigger}
procedure SetStatusTrigger(const Handle : Word; const Value : Word;
const Activate : Boolean);
{-Activate or deactivate a status trigger}
{I/O}
function CharReady : Boolean;
{-Return True if at least one character is in the input buffer}
function PeekChar(const Count : Word) : Char;
{-Return a received character other than the next one}
function GetChar : Char;
{-Return the next received character}
procedure PeekBlock(var Block; const Len : Word);
{-Return a block of data other than the next block}
procedure GetBlock(var Block; const Len : Word);
{-Return the next block of data}
procedure PutChar(const C : Char);
{-Add C to the output buffer}
procedure PutString(const S : String);
{-Add S to the output buffer}
function PutBlock(const Block; const Len : Word) : Integer;
{-Add Block to the output buffer}
{Waits}
function CheckForString(var Index : Byte; C : Char;
const S : String;
IgnoreCase : Boolean) : Boolean;
{-Compare C against a sequence of chars, looking for S}
function WaitForString(const S : String;
const Timeout : LongInt;
const Yield, IgnoreCase : Boolean) : Boolean;
{-Wait for S}
function WaitForMultiString(const S : String; const Timeout : LongInt;
const Yield, IgnoreCase : Boolean;
const SepChar : Char) : Integer;
{-Wait for S, which contains several substrings separated by ^}
procedure PrepareWait;
{-Set EventBusy true to prevent triggers}
property ComNumber : Word
read FComNumber write SetComNumber default adpoDefComNumber;
property CustomDispatcher : TActivationProcedure
read fCustomDispatcher write fCustomDispatcher;
property DeviceLayer : TDeviceLayer
read FDeviceLayer write SetDeviceLayer default adpoDefDeviceLayer;
property ComWindow : THandle
read fComWindow;
property Baud : LongInt
read FBaud write SetBaud default adpoDefBaudRt;
property Parity : TParity
read FParity write SetParity default adpoDefParity;
property PromptForPort : Boolean
read FPromptForPort write FPromptForPort
default adpoDefPromptForPort;
property DataBits : Word
read FDatabits write SetDatabits default adpoDefDatabits;
property StopBits : Word
read FStopbits write SetStopbits default adpoDefStopbits;
{Miscellaneous port properties}
property InSize : Word
read FInSize write SetInSize default adpoDefInSize;
property OutSize : Word
read FOutSize write SetOutSize default adpoDefOutSize;
property Open : Boolean
read FOpen write SetOpen default adpoDefOpen;
property AutoOpen : Boolean
read FAutoOpen write FAutoOpen default adpoDefAutoOpen;
property CommNotificationLevel : Word
read FCommNotificationLevel write SetCommNotificationLevel
default adpoDefCommNotificationLevel;
property TapiMode : TTapiMode
read FTapiMode write FTapiMode default adpoDefTapiMode;
property TapiCid : Word
read FTapiCid write FTapiCid;
property RS485Mode : Boolean
read FRS485Mode write SetRS485Mode default adpoDefRS485Mode;
property BaseAddress : Word
read GetBaseAddress write SetBaseAddress
default adpoDefBaseAddress;
property ThreadBoost : TApThreadBoost
read FThreadBoost write SetThreadBoost;
property MasterTerminal : TWinControl
read FMasterTerminal write FMasterTerminal;
{Modem control/status}
property DTR : Boolean
read FDTR write SetDTR default adpoDefDTR;
property RTS : Boolean
read FRTS write SetRTS default adpoDefRTS;
{Flow control properties}
property HWFlowOptions : THWFlowOptionSet
read FHWFlowOptions write SetHWFlowOptions default [];
property FlowState : TFlowControlState
read GetFlowState;
property SWFlowOptions : TSWFlowOptions
read FSWFlowOptions write SetSWFlowOptions default adpoDefSWFlowOptions;
property XOnChar : Char
read FXonChar write SetXonChar default adpoDefXOnChar;
property XOffChar : Char
read FXOffChar write SetXoffChar default adpoDefXOffChar;
property BufferFull : Word
read FBufferFull write SetBufferFull default adpoDefBufferFull;
property BufferResume : Word
read FBufferResume write SetBufferResume default adpoDefBufferResume;
{Debugging}
property Tracing : TTraceLogState
read FTracing write SetTracing default adpoDefTracing;
property TraceSize : Cardinal
read FTraceSize write SetTraceSize default adpoDefTraceSize;
property TraceName : TPassString
read FTraceName write FTraceName;
property TraceHex : Boolean
read FTraceHex write FTraceHex default adpoDefTraceHex;
property TraceAllHex : Boolean
read FTraceAllHex write FTraceAllHex default adpoDefTraceAllHex;
property Logging : TTraceLogState
read FLogging write SetLogging default adpoDefLogging;
property LogSize : Cardinal
read FLogSize write SetLogSize default adpoDefLogSize;
property LogName : TPassString
read FLogName write FLogName;
property LogHex : Boolean
read FLogHex write FLogHex default adpoDefLogHex;
property LogAllHex : Boolean
read FLogAllHex write FLogAllHex default adpoDefLogAllHex;
{Options}
property UseMSRShadow : Boolean
read FUseMSRShadow write SetUseMSRShadow default adpoDefUseMSRShadow;
property UseEventWord : Boolean
read FUseEventWord write SetUseEventWord default adpoDefUseEventWord;
{Tracing}
procedure AddTraceEntry(const CurEntry, CurCh : Char);
{-Add an entry to the trace buffer}
procedure AddStringToLog(S : string);
{-Add a string to the current LOG file}
{Trigger events}
property TriggerLength : Word
read FTriggerLength write SetTriggerLength default adpoDefTriggerLength;
property OnTrigger : TTriggerEvent
read FOnTrigger write SetOnTrigger;
property OnTriggerAvail : TTriggerAvailEvent
read FOnTriggerAvail write SetOnTriggerAvail;
property OnTriggerData : TTriggerDataEvent
read FOnTriggerData write SetOnTriggerData;
property OnTriggerStatus : TTriggerStatusEvent
read FOnTriggerStatus write SetOnTriggerStatus;
property OnTriggerTimer : TTriggerTimerEvent
read FOnTriggerTimer write SetOnTriggerTimer;
{Port open/close/change events}
property OnPortOpen : TNotifyEvent
read FOnPortOpen write FOnPortOpen;
property OnPortClose : TNotifyEvent
read FOnPortClose write FOnPortClose;
{Status events}
property OnTriggerLineError : TTriggerLineErrorEvent
read FOnTriggerLineError write SetOnTriggerLineError;
property OnTriggerModemStatus : TNotifyEvent
read FOnTriggerModemStatus write SetOnTriggerModemStatus;
property OnTriggerOutbuffFree : TNotifyEvent
read FOnTriggerOutbuffFree write SetOnTriggerOutbuffFree;
property OnTriggerOutbuffUsed : TNotifyEvent
read FOnTriggerOutbuffUsed write SetOnTriggerOutbuffUsed;
property OnTriggerOutSent : TNotifyEvent
read FOnTriggerOutSent write SetOnTriggerOutSent;
{WaitChar event}
property OnWaitChar : TWaitCharEvent
read FOnWaitchar write FOnWaitChar;
{I/O properties}
property Output : String
write PutString;
{TComHandle, read only}
property Dispatcher : TApdBaseDispatcher
read GetDispatcher;
function ValidDispatcher : TApdBaseDispatcher;
{Modem status, read only}
property ModemStatus : Byte
read GetModemStatus;
property DSR : Boolean
read GetDSR;
property CTS : Boolean
read GetCTS;
property RI : Boolean
read GetRI;
property DCD : Boolean
read GetDCD;
property DeltaDSR : Boolean
read GetDeltaDSR;
property DeltaCTS : Boolean
read GetDeltaCTS;
property DeltaRI : Boolean
read GetDeltaRI;
property DeltaDCD : Boolean
read GetDeltaDCD;
{Line errors}
property LineError : Word
read GetLineError;
property LineBreak : Boolean
read GetLineBreak;
{Buffer info, readonly}
property InBuffUsed : Word
read GetInBuffUsed;
property InBuffFree : Word
read GetInBuffFree;
property OutBuffUsed : Word
read GetOutBuffUsed;
property OutBuffFree : Word
read GetOutBuffFree;
end;
{Port component}
TApdComPort = class(TApdCustomComPort)
published
property DeviceLayer;
property ComNumber;
property Baud;
property PromptForPort;
property Parity;
property DataBits;
property StopBits;
property InSize;
property OutSize;
property AutoOpen;
property Open;
property DTR;
property RTS;
property HWFlowOptions;
property SWFlowOptions;
property XOnChar;
property XOffChar;
property BufferFull;
property BufferResume;
property Tracing;
property TraceSize;
property TraceName;
property TraceHex;
property TraceAllHex;
property Logging;
property LogSize;
property LogName;
property LogHex;
property LogAllHex;
property UseMSRShadow;
property UseEventWord;
property CommNotificationLevel;
property TapiMode;
property RS485Mode;
property OnPortClose;
property OnPortOpen;
property OnTrigger;
property OnTriggerAvail;
property OnTriggerData;
property OnTriggerStatus;
property OnTriggerTimer;
property OnTriggerLineError;
property OnTriggerModemStatus;
property OnTriggerOutbuffFree;
property OnTriggerOutbuffUsed;
property OnTriggerOutSent;
property Tag;
end;
function ComName(const ComNumber : Word) : ShortString;
function SearchComPort(const C : TComponent) : TApdCustomComPort;
implementation
const
ComWindowClass = 'awComWindow';
{Main trigger handler}
function ComWindowProc(hWindow : TApdHwnd; Msg, wParam : Word;
lParam : Longint) : Longint;
stdcall; export;
{-Receives all triggers, dispatches to event handlers}
type
lParamCast = record
Data : Word;
Dispatcher : Word;
end;
var
LP : lParamCast absolute lParam;
TrigHandle : Word absolute wParam;
Count : Word absolute wParam;
CP : TApdCustomComPort;
D : Pointer;
begin
case Msg of
APW_CLOSEPENDING, APW_TRIGGERAVAIL, APW_TRIGGERDATA,
APW_TRIGGERSTATUS, APW_TRIGGERTIMER : ;
else
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
Result := TFlowControlState(Pred(CheckException(Self,
ValidDispatcher.HWFlowState)));
if Result = fcOff then
Result := TFlowControlState(Pred(CheckException(Self,
Dispatcher.SWFlowState)));
end else begin
Result := fcOff;
end;
end;
procedure TApdCustomComPort.SetSWFlowOptions(const NewOpts : TSWFlowOptions);
var
Opts : Word;
begin
if (FSWFlowOptions <> NewOpts) or Force then begin
if NewOpts = swfBoth then
Opts := sfTransmitFlow + sfReceiveFlow
else if NewOpts = swfTransmit then
Opts := sfTransmitFlow
else if NewOpts = swfReceive then
Opts := sfReceiveFlow
else
Opts := 0;
{Validate bufferfull and bufferresume if opts not zero}
if Opts <> 0 then begin
if (BufferFull = 0) or (BufferFull > InSize) then
FBufferFull := Trunc(InSize * 0.75);
if (BufferResume = 0) or (BufferResume > BufferFull) then
FBufferResume := Trunc(InSize * 0.25);
end;
if (PortState = psOpen) then begin
if Opts <> 0 then
CheckException(Self,
Dispatcher.SWFlowEnable(FBufferFull, FBufferResume, Opts))
else
CheckException(Self, Dispatcher.SWFlowDisable);
end;
FSWFlowOptions := NewOpts;
end;
end;
procedure TApdCustomComPort.SetXonChar(const NewChar : Char);
{-Set new xon character}
begin
if (NewChar <> FXOnChar) or Force then begin
FXOnChar := NewChar;
if (PortState = psOpen) then
CheckException(Self, Dispatcher.SWFlowChars(FXOnChar, FXOffChar));
end;
end;
procedure TApdCustomComPort.SetXoffChar(const NewChar : Char);
{-Set new xoff character}
begin
if (NewChar <> FXOffChar) or Force then begin
FXOffChar := NewChar;
if (PortState = psOpen) then
CheckException(Self, Dispatcher.SWFlowChars(FXOnChar, FXOffChar));
end;
end;
procedure TApdCustomComPort.SetBufferFull(const NewFull : Word);
{-Set buffer full mark}
var
SaveForce : Boolean;
begin
if (NewFull <> FBufferFull) or Force then begin
if NewFull <= InSize then
FBufferFull := NewFull
else
FBufferFull := Trunc(NewFull * 0.9);
SaveForce := Force;
Force := True;
SetHWFlowOptions(HWFlowOptions);
SetSWFlowOptions(SWFlowOptions);
Force := SaveForce;
end;
end;
procedure TApdCustomComPort.SetBufferResume(const NewResume : Word);
{-Set buffer resume mark}
var
SaveForce : Boolean;
begin
if (NewResume <> FBufferResume) or Force then begin
if NewResume > FBufferFull then
FBufferResume := Trunc(FBufferFull * 0.1)
else
FBufferResume := NewResume;
SaveForce := Force;
Force := True;
SetHWFlowOptions(HWFlowOptions);
SetSWFlowOptions(SWFlowOptions);
Force := SaveForce;
end;
end;
procedure TApdCustomComPort.SetDTR(const NewDTR : Boolean);
{-Set a new DTR value}
begin
if (NewDTR <> FDTR) or Force then begin
if (PortState = psOpen) then begin
if CheckException(Self, Dispatcher.SetDTR(NewDTR)) = ecOK then
FDTR := NewDTR;
end else begin
FDTR := NewDTR;
end;
end;
end;
procedure TApdCustomComPort.SetRTS(const NewRTS : Boolean);
{-Set new RTS value}
begin
if (NewRTS <> FRTS) or Force then begin
if (PortState = psOpen) then begin
if CheckException(Self, Dispatcher.SetRTS(NewRTS)) = ecOK then
FRTS := NewRTS;
end else begin
FRTS := NewRTS;
end;
end;
end;
procedure TApdCustomComPort.SetOnTrigger(const Value : TTriggerEvent);
begin
FOnTrigger := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerAvail(const Value : TTriggerAvailEvent);
begin
FOnTriggerAvail := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerData(const Value : TTriggerDataEvent);
begin
FOnTriggerData := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerStatus(const Value : TTriggerStatusEvent);
begin
FOnTriggerStatus := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerTimer(const Value : TTriggerTimerEvent);
begin
FOnTriggerTimer := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerLineError(const Value : TTriggerLineErrorEvent);
begin
FOnTriggerLineError := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerModemStatus(const Value : TNotifyEvent);
begin
FOnTriggerModemStatus := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerOutbuffFree(const Value : TNotifyEvent);
begin
FOnTriggerOutbuffFree := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerOutbuffUsed(const Value : TNotifyEvent);
begin
FOnTriggerOutbuffUsed := Value;
UpdateHandlerFlag;
end;
procedure TApdCustomComPort.SetOnTriggerOutSent(const Value : TNotifyEvent);
begin
FOnTriggerOutSent := Value;
UpdateHandlerFlag;
end;
function TApdCustomComPort.GetDispatcher : TApdBaseDispatcher;
{-Return the current Dispatcher, opening the port if necessary}
begin
if FDispatcher = nil then
if not (csDesigning in ComponentState) then begin
if (PortState <> psOpen) and
(not (csLoading in ComponentState)) and
AutoOpen then
Open := True;
end;
Result := FDispatcher;
end;
function TApdCustomComPort.GetModemStatus : Byte;
{-Return the current modem status register value}
begin
if (PortState = psShuttingDown) then
Result := 0
else
Result := ValidDispatcher.GetModemStatus;
end;
function TApdCustomComPort.GetDSR : Boolean;
{-Return the DSR bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckDSR
else
Result := False;
end;
function TApdCustomComPort.GetCTS : Boolean;
{-Return CTS bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckCTS
else
Result := False;
end;
function TApdCustomComPort.GetRI : Boolean;
{-Return RI bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckRI
else
Result := False;
end;
function TApdCustomComPort.GetDCD : Boolean;
{-Return DCD bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckDCD
else
Result := False;
end;
function TApdCustomComPort.GetDeltaDSR : Boolean;
{-Return delta DSR bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckDeltaDSR
else
Result := False;
end;
function TApdCustomComPort.GetDeltaCTS : Boolean;
{-Return delta CTS bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckDeltaCTS
else
Result := False;
end;
function TApdCustomComPort.GetDeltaRI : Boolean;
{-Return delta RI bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckDeltaRI
else
Result := False;
end;
function TApdCustomComPort.GetDeltaDCD : Boolean;
{-Return delta DCD bit state}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckDeltaDCD
else
Result := False;
end;
function TApdCustomComPort.GetLineError : Word;
{-Return most severe current line error}
begin
if (PortState = psOpen) then
Result := Word(CheckException(Self, Word(Dispatcher.GetLineError)))
else
Result := leNoError;
end;
function TApdCustomComPort.GetLineBreak : Boolean;
{-Return True if break received}
begin
if (PortState = psOpen) then
Result := Dispatcher.CheckLineBreak
else
Result := False;
end;
procedure TApdCustomComPort.SetTriggerLength(const NewLength : Word);
{-Change the length trigger}
begin
if (FTriggerLength <> NewLength) or Force then begin
FTriggerLength := NewLength;
if (PortState = psOpen) then
Dispatcher.ChangeLengthTrigger(NewLength);
end;
end;
function TApdCustomComPort.GetInBuffUsed : Word;
{-Return the number of used bytes in the input buffer}
begin
if (PortState = psOpen) then
Result := Dispatcher.InBuffUsed
else
Result := 0;
end;
function TApdCustomComPort.GetInBuffFree : Word;
{-Return amount of freespace in inbuf}
begin
if (PortState = psOpen) then
Result := Dispatcher.InBuffFree
else
Result := DispatchBufferSize;
end;
function TApdCustomComPort.GetOutBuffUsed : Word;
{-Return number of used bytes in output buffer}
begin
if (PortState = psOpen) then
Result := Dispatcher.OutBuffUsed
else
Result := 0;
end;
function TApdCustomComPort.GetOutBuffFree : Word;
{-Return amount of free space in outbuff}
begin
if (PortState = psOpen) then
Result := Dispatcher.OutBuffFree
else
Result := FOutSize;
end;
procedure TApdCustomComPort.SetUseMSRShadow(NewUse : Boolean);
{-Set the MSR shadow option}
begin
{ UseMSRShadow is only applicable to 16-bit, ignore it }
end;
procedure TApdCustomComPort.SetUseEventWord(NewUse : Boolean);
{-Set the UseEventWord option}
begin
if (FUseEventWord <> NewUse) or Force then begin
FUseEventWord := NewUse;
if (PortState = psOpen) then
if FUseEventWord then
Dispatcher.OptionsOn(poUseEventWord)
else
Dispatcher.OptionsOff(poUseEventWord);
end;
end;
procedure TApdCustomComPort.SetCommNotificationLevel(NewLevel : Word);
{-Set the comm notification level}
begin
{ 16-bit }
if (FCommNotificationLevel <> NewLevel) or Force then begin
FCommNotificationLevel := NewLevel;
end;
end;
procedure TApdCustomComPort.SetRS485Mode(NewMode : Boolean);
{-Set the RS485 mode}
var
NewFlowOpts : THWFlowOptionSet;
begin
if (FRS485Mode <> NewMode) or Force then begin
FRS485Mode := NewMode;
if (PortState = psOpen) then
Dispatcher.SetRS485Mode(NewMode);
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 := adpoDefSWFlowOptions;
FXonChar := adpoDefXOnChar;
FXOffChar := adpoDefXOffChar;
FBufferFull := adpoDefBufferFull;
FBufferResume := adpoDefBufferResume;
FTriggerLength := adpoDefTriggerLength;
FTracing := adpoDefTracing;
FTraceSize := adpoDefTraceSize;
FTraceName := adpoDefTraceName;
FTraceHex := adpoDefTraceHex;
TraceAllHex:= adpoDefTraceAllHex;
FLogging := adpoDefLogging;
FLogSize := adpoDefLogSize;
FLogName := adpoDefLogName;
FLogHex := adpoDefLogHex;
LogAllHex := adpoDefLogAllHex;
FUseMSRShadow := adpoDefUseMSRShadow;
FUseEventWord := adpoDefUseEventWord;
FCommNotificationLevel := adpoDefCommNotificationLevel;
FTapiMode := adpoDefTapiMode;
if not OverrideLine then begin
FBaud := adpoDefBaudRt;
FParity := adpoDefParity;
FDatabits := adpoDefDatabits;
FStopbits := adpoDefStopbits;
FInSize := adpoDefInSize;
FOutSize := adpoDefOutSize;
FHWFlowOptions := [];
end;
{Event inits}
FOnTrigger := nil;
FOnTriggerAvail := nil;
FOnTriggerData := nil;
FOnTriggerStatus := nil;
FOnTriggerTimer := nil;
FOnTriggerLineError := nil;
FOnTriggerModemStatus := nil;
FOnTriggerOutbuffFree := nil;
FOnTriggerOutbuffUsed := nil;
FOnTriggerOutSent := nil;
FOnPortOpen := nil;
FOnPortClose := nil;
FOnWaitChar := nil;
end;
destructor TApdCustomComPort.Destroy;
{-Destroy the object instance}
var
I : Word;
UL : PUserListEntry;
begin
{Close the port}
if (PortState = psOpen) then begin
DonePort;
end;
{Get rid of the user list}
if Assigned(UserList) and (UserList.Count > 0) then begin {!!.02}
for I := UserList.Count-1 downto 0 do begin
UL := UserList.Items[I];
UserList.Remove(UL);
Dispose(UL);
end;
end;
UserList.Free;
TApdBaseDispatcher.ClearSaveBuffers(SaveTriggerBuffer);
inherited Destroy;
end;
procedure TApdCustomComPort.InitPort;
{-Physically open the comport}
var
Res : Integer;
nBaud : LongInt;
nParity : Word;
nDataBits : TDatabits;
nStopBits : TStopbits;
nHWOpts, nSWOpts, nBufferFull, nBufferResume : Cardinal;
nOnChar, nOffChar : Char;
begin
{ Validate the comport -- not needed for Tapi }
if TapiMode <> tmOn then
ValidateComport;
{ Activate the specified device layer }
FDispatcher := ActivateDeviceLayer;
FDispatcher.DeviceName := Format('COM%d', [ComNumber]);
try
{ Get line parameters that Tapi set }
if TapiMode = tmOn then begin
if ValidDispatcher.ComHandle = 0 then
CheckException(Self, ecNotOpenedByTapi);
FDispatcher.GetLine(nBaud, nParity, nDataBits, nStopBits);
FDispatcher.GetFlowOptions(nHWOpts, nSWOpts, nBufferFull,
nBufferResume, nOnChar, nOffChar);
{ Sync our properties with those set by Tapi }
FBaud := nBaud;
FParity := TParity(nParity);
FDataBits := Ord(nDataBits);
FStopBits := Ord(nStopBits);
FHWFlowOptions := [];
if (nHWOpts and hfUseDTR) <> 0 then
Include(FHWFlowOptions, hwfUseDTR);
if (nHWOpts and hfUseRTS) <> 0 then
Include(FHWFlowOptions, hwfUseRTS);
if (nHWOpts and hfRequireDSR) <> 0 then
Include(FHWFlowOptions, hwfRequireDSR);
if (nHWOpts and hfRequireCTS) <> 0 then
Include(FHWFlowOptions, hwfRequireCTS);
FSWFlowOptions := TSWFlowOptions(nSWOpts);
FXOnChar := nOnChar;
FXOffChar := nOffChar;
end;
Res := InitializePort;
{Remap access denied and file not found errors}
if Res = ecAccessDenied then
Res := ecAlreadyOpen
else if (Res = ecFileNotFound) or (Res = ecPathNotFound) then
Res := ecBadId;
if (Res = ecOk) then begin
{Handle preset properties}
PortState := psOpen;
UpdateHandlerFlag;
Force := True;
SetTracing(Tracing);
SetLogging(Logging);
SetHWFlowOptions(HWFlowOptions);
SetSWFlowOptions(SWFlowOptions);
SetXOnChar(FXonChar);
SetXOffChar(FXoffChar);
SetTriggerLength(FTriggerLength);
SetDTR(FDTR);
SetRTS(FRTS);
{SetUseMSRShadow(FUseMSRShadow);} {16-bit} {!!.02}
SetUseEventWord(FUseEventWord);
{SetCommNotificationLevel(FCommNotificationLevel);} {16-bit} {!!.02}
SetRS485Mode(FRS485Mode);
SetThreadBoost(FThreadBoost);
Force := False;
FOpen := True;
{Prepare for triggers}
RegisterComPort(True);
{Add pending triggers}
if CopyTriggers then begin
CopyTriggers := False;
FDispatcher.RestoreTriggers(SaveTriggerBuffer);
end;
{Send OnPortEvent}
PortOpen;
end else
CheckException(Self, Res);
except
FOpen := False;
PortState := psClosed;
FDispatcher.Free;
FDispatcher := nil;
raise;
end;
end;
procedure TApdCustomComPort.DonePort;
{-Physically close the comport}
begin
{FOpen := False;} {!!.02}
if (PortState = psOpen) then begin
{ Force trace/log dumps if they were on }
Tracing := tlDump;
Logging := tlDump;
{ Port is shutting down }
PortState := psShuttingDown;
{ Send OnPortClose event }
{PortClose;} {!!.02}
PortClosing; {!!.03}
{ Save triggers in case this port is reopened }
Dispatcher.SaveTriggers(SaveTriggerBuffer);
CopyTriggers := True;
{ Close the port and clear ComTable }
Dispatcher.DonePort;
if Dispatcher.EventBusy then begin
PostMessage(fComWindow, apw_ClosePending, 0,
Dispatcher.Handle shl 16);
SafeYield;
end else begin
{ Get rid of the trigger handler }
RegisterComPort(False);
FDispatcher.Free;
FDispatcher := nil;
PortState := psClosed;
FOpen := False; {!!.02}
end;
{ Send OnPortClose event }
PortClose; {!!.02}
end;
end;
procedure TApdCustomComPort.Assign(Source: TPersistent);
{-Assign values of Source to self}
var
SourcePort : TApdCustomComPort absolute Source;
I : Word;
UL : PUserListEntry;
begin
if Source is TApdCustomComPort then begin
{Discard existing userlist}
if UserList.Count > 0 then
for I := UserList.Count-1 downto 0 do begin
UL := UserList.Items[I];
UserList.Remove(UL);
Dispose(UL);
end;
UserList.Free;
{Copy Source's userlist}
UserList := TList.Create;
if SourcePort.UserList.Count > 0 then
for I := 0 to SourcePort.UserList.Count-1 do begin
New(UL);
Move(SourcePort.UserList.Items[I]^, UL^,
SizeOf(TUserListEntry));
UserList.Add(UL);
end;
{Copy triggers from Source}
if (SourcePort.PortState = psOpen) then begin
SourcePort.Dispatcher.SaveTriggers(SaveTriggerBuffer);
CopyTriggers := True;
end;
{Copy all other fields}
Force := SourcePort.Force;
FDeviceLayer := SourcePort.FDeviceLayer;
FComNumber := SourcePort.FComNumber;
FBaud := SourcePort.FBaud;
FParity := SourcePort.FParity;
FDatabits := SourcePort.FDatabits;
FStopbits := SourcePort.FStopbits;
FInSize := SourcePort.FInSize;
FOutSize := SourcePort.FOutSize;
FOpen := False;
FAutoOpen := SourcePort.FAutoOpen;
FPromptForPort := SourcePort.FPromptForPort;
FRS485Mode := SourcePort.FRS485Mode;
FThreadBoost := SourcePort.FThreadBoost;
FDTR := SourcePort.FDTR;
FRTS := SourcePort.FRTS;
FBufferFull := SourcePort.FBufferFull;
FBufferResume := SourcePort.FBufferResume;
FHWFlowOptions := SourcePort.FHWFlowOptions;
FSWFlowOptions := SourcePort.FSWFlowOptions;
FXOnChar := SourcePort.FXOnChar;
FXOffChar := SourcePort.FXOffChar;
FTracing := SourcePort.FTracing;
FTraceSize := SourcePort.FTraceSize;
FTraceName := SourcePort.FTraceName;
FTraceHex := SourcePort.FTraceHex;
FTraceAllHex := SourcePort.FTraceAllHex;
FLogging := SourcePort.FLogging;
FLogSize := SourcePort.FLogSize;
FLogName := SourcePort.FLogName;
FLogHex := SourcePort.FLogHex;
FLogAllHex := SourcePort.FLogAllHex;
FTriggerLength := SourcePort.FTriggerLength;
{Must go through write method to ensure flag gets updated}
OnTrigger := SourcePort.FOnTrigger;
OnTriggerAvail := SourcePort.FOnTriggerAvail;
OnTriggerData := SourcePort.FOnTriggerData;
OnTriggerStatus := SourcePort.FOnTriggerStatus;
OnTriggerTimer := SourcePort.FOnTriggerTimer;
FOnPortOpen := SourcePort.FOnPortOpen;
FOnPortClose := SourcePort.FOnPortClose;
FTapiMode := SourcePort.FTapiMode;
end;
end;
procedure TApdCustomComPort.RegisterUser(const H : THandle);
{-Register a user of this comport}
var
UL : PUserListEntry;
begin
New(UL);
with UL^ do begin
Handle := H;
OpenClose := nil;
OpenCloseEx := nil; {!!.03}
IsEx := False; {!!.03}
end;
UserList.Add(UL);
end;
procedure TApdCustomComPort.RegisterUserEx(const H : THandle);{!!.03}
{-Register a TApdComPort user to receive open/closing/close events}
var
UL : PUserListEntry;
begin
New(UL);
with UL^ do begin
Handle := H;
OpenClose := nil;
OpenCloseEx := nil;
IsEx := True;
end;
UserList.Add(UL);
end;
procedure TApdCustomComPort.RegisterUserCallback(CallBack : TPortCallback);
{-Register a user of this comport}
var
UL : PUserListEntry;
begin
New(UL);
with UL^ do begin
Handle := 0;
OpenClose := Callback;
OpenCloseEx := nil; {!!.03}
IsEx := False; {!!.03}
end;
UserList.Add(UL);
end;
procedure TApdCustomComPort.RegisterUserCallbackEx( {!!.03}
CallBackEx : TPortCallbackEx);
{-Register a TApdComPort user to receive extended callbacks}
var
UL : PUserListEntry;
begin
New(UL);
with UL^ do begin
Handle := 0;
OpenClose := nil;
OpenCloseEx := CallbackEx;
IsEx := True;
end;
UserList.Add(UL);
end;
procedure TApdCustomComPort.DeregisterUser(const H : THandle);
{-Deregister a user of this comport}
var
UL : PUserListEntry;
I : Word;
begin
if csDestroying in ComponentState then Exit; {!!.05}
if Assigned(UserList) and (UserList.Count > 0) then begin {!!.02}
for I := UserList.Count-1 downto 0 do begin
UL := UserList.Items[I];
with UL^ do begin
if Handle = H then begin
UserList.Remove(UL);
Dispose(UL);
end;
end;
end;
end;
end;
procedure TApdCustomComPort.DeregisterUserCallback(CallBack : TPortCallback);
{-Deregister a user of this comport}
var
UL : PUserListEntry;
I : Word;
begin
if csDestroying in ComponentState then Exit; {!!.05}
if Assigned(UserList) and (UserList.Count > 0) then begin {!!.02}
for I := UserList.Count-1 downto 0 do begin
UL := UserList.Items[I];
with UL^ do begin
if @CallBack = @OpenClose then begin
UserList.Remove(UL);
Dispose(UL);
end;
end;
end;
end;
end;
procedure TApdCustomComPort.DeregisterUserCallbackEx( {!!.03}
CallBackEx : TPortCallbackEx);
{-Deregister a TApdComPort user callback}
var
UL : PUserListEntry;
I : Word;
begin
if csDestroying in ComponentState then Exit; {!!.05}
if Assigned(UserList) and (UserList.Count > 0) then begin
for I := UserList.Count-1 downto 0 do begin
UL := UserList.Items[I];
with UL^ do begin
if @CallBackEx = @OpenCloseEx then begin
UserList.Remove(UL);
Dispose(UL);
end;
end;
end;
end;
end;
procedure TApdCustomComPort.ProcessCommunications;
{-Process communications receive events, but not triggers}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.ProcessCommunications);
end;
procedure TApdCustomComPort.FlushInBuffer;
{-Flush the input buffer}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.FlushInBuffer);
end;
procedure TApdCustomComPort.FlushOutBuffer;
{-Flush the output buffer}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.FlushOutBuffer);
end;
procedure TApdCustomComPort.InitTracing(const NumEntries : Cardinal);
{-Start tracing}
begin
if (PortState = psShuttingDown) then Exit;
if NumEntries <> 0 then
FTraceSize := NumEntries;
CheckException(Self, Dispatcher.InitTracing(NumEntries));
FTracing := tlOn;
end;
procedure TApdCustomComPort.DumpTrace(const FName : ShortString;
const InHex : Boolean);
{-Dump the trace file}
var
Dest : array[0..255] of Char;
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, Dispatcher.DumpTrace(StrPCopy(Dest, FName),
InHex, TraceAllHex));
FTracing := tlOff;
end;
procedure TApdCustomComPort.AppendTrace(const FName : ShortString;
const InHex : Boolean);
{-Append the trace file}
var
Dest : array[0..255] of Char;
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self,
Dispatcher.AppendTrace(StrPCopy(Dest, FName), InHex, TraceAllHex));
FTracing := tlOff;
end;
procedure TApdCustomComPort.ClearTracing;
{-Clear the trace buffer but keep tracing}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, Dispatcher.ClearTracing);
end;
procedure TApdCustomComPort.AbortTracing;
{-Abort tracing without dumping the trace file}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.AbortTracing;
FTracing := tlOff;
end;
procedure TApdCustomComPort.AddTraceEntry(const CurEntry, CurCh : Char);
{-Add a trace entry}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.AddTraceEntry(CurEntry, CurCh);
end;
procedure TApdCustomComPort.AddStringToLog(S : string);
begin
if (PortState = psShuttingDown) then Exit;
ValidDispatcher.AddStringToLog(S);
end;
procedure TApdCustomComPort.StartTracing;
{-Resume tracing after StopTracing}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.StartTracing;
FTracing := tlOn;
end;
procedure TApdCustomComPort.StopTracing;
{-Temporarily stop tracing}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.StopTracing;
FTracing := tlPause;
end;
procedure TApdCustomComPort.ForcePortOpen;
{-Ensure port is opened after loading}
begin
if AutoOpen then
ForceOpen := True;
end;
procedure TApdCustomComPort.SendBreak(Ticks : Word; Yield : Boolean);
{-Send a line break of ticks duration}
begin
if (PortState = psShuttingDown) then Exit;
ValidDispatcher.SendBreak(Ticks, Yield);
end;
procedure TApdCustomComPort.SetBreak(BreakOn: Boolean);
{-Sets or clears line break condition}
begin
if (PortState = psShuttingDown) then Exit;
ValidDispatcher.SetBreak(BreakOn);
end;
procedure TApdCustomComPort.InitLogging(const Size : Cardinal);
{-Start dispatch logging}
begin
if (PortState = psShuttingDown) then Exit;
if Size <> 0 then
FLogSize := Size;
Dispatcher.InitDispatchLogging(FLogSize);
FLogging := tlOn;
end;
procedure TApdCustomComPort.DumpLog(const FName : ShortString;
const InHex : Boolean);
{-Dump the dispatch log}
var
Dest : array[0..255] of Char;
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self,
Dispatcher.DumpDispatchLog(StrPCopy(Dest, FName), InHex, LogAllHex));
FLogging := tlOff;
end;
procedure TApdCustomComPort.AppendLog(const FName : ShortString;
const InHex : Boolean);
{-Dump the dispatch log}
var
Dest : array[0..255] of Char;
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self,
Dispatcher.AppendDispatchLog(StrPCopy(Dest, FName), InHex, LogAllHex));
FLogging := tlOff;
end;
procedure TApdCustomComPort.ClearLogging;
{-Clear the log but keep logging}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.ClearDispatchLogging;
end;
procedure TApdCustomComPort.AbortLogging;
{-Abort logging without dumping the log}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.AbortDispatchLogging;
FLogging := tlOff;
end;
procedure TApdCustomComPort.StartLogging;
{-Resume logging after stopping}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.StartDispatchLogging;
FLogging := tlOn;
end;
procedure TApdCustomComPort.StopLogging;
{-Temporarily stop logging}
begin
if (PortState = psShuttingDown) then Exit;
Dispatcher.StopDispatchLogging;
FLogging := tlPause;
end;
function TApdCustomComPort.AddDataTrigger(const Data : ShortString;
const IgnoreCase : Boolean) : Word;
{-Add a ShortString data trigger}
var
Len : Word;
P : array[0..255] of Char;
begin
if (PortState = psShuttingDown) then begin
Result := 0;
Exit;
end;
Len := Length(Data);
Move(Data[1], P, Len);
Result := Word(CheckException(Self,
ValidDispatcher.AddDataTriggerLen(P, IgnoreCase, Len)));
end;
function TApdCustomComPort.AddTimerTrigger : Word;
{-Add a timer trigger}
begin
if (PortState = psShuttingDown) then
Result := 0
else
Result := Word(CheckException(Self, ValidDispatcher.AddTimerTrigger));
end;
function TApdCustomComPort.AddStatusTrigger(const SType : Word) : Word;
{-Add a status trigger of type SType}
begin
if (PortState = psShuttingDown) then
Result := 0
else
Result := Word(CheckException(Self,
ValidDispatcher.AddStatusTrigger(SType)));
end;
procedure TApdCustomComPort.RemoveTrigger(const Handle : Word);
{-Remove trigger with index Index}
begin
if (PortState = psOpen) then
CheckException(Self, Dispatcher.RemoveTrigger(Handle));
end;
procedure TApdCustomComPort.RemoveAllTriggers;
{-Remove all triggers}
begin
if (PortState = psOpen) then begin
Dispatcher.RemoveAllTriggers;
FTriggerLength := 0;
end;
end;
procedure TApdCustomComPort.SetTimerTrigger(const Handle : Word;
const Ticks : LongInt;
const Activate : Boolean);
{-Set the timer for trigger Index}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.SetTimerTrigger(Handle, Ticks, Activate));
end;
procedure TApdCustomComPort.SetStatusTrigger(const Handle : Word;
const Value : Word;
const Activate : Boolean);
{-Set status trigger}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self,
ValidDispatcher.SetStatusTrigger(Handle, Value, Activate));
end;
{I/O}
function TApdCustomComPort.CharReady : Boolean;
{-Return the next character in the receive buffer}
begin
if (PortState = psShuttingDown) then
Result := False
else
Result := ValidDispatcher.CharReady;
end;
function TApdCustomComPort.PeekChar(const Count : Word) : Char;
{-Peek at the Count'th character in the buffer (1=next)}
var
Res : Integer;
C : Char;
begin
if (PortState = psShuttingDown) then begin
Res := ecOk;
C := #0;
end else
Res := ValidDispatcher.PeekChar(C, Count);
if Res = ecOK then
Result := C
else begin
CheckException(Self, Res);
Result := #0;
end;
end;
function TApdCustomComPort.GetChar : Char;
{-Retrieve the next character from the input queue}
var
Res : Integer;
C : Char;
begin
if (PortState = psShuttingDown) then begin
Res := ecOk;
C := #0;
end else
Res := ValidDispatcher.GetChar(C);
if Res = ecOK then
Result := C
else begin
CheckException(Self, Res);
Result := #0;
end;
end;
procedure TApdCustomComPort.PeekBlock(var Block; const Len : Word);
{-Peek at the next Len characters, but don't remove from buffer}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.PeekBlock(PChar(@Block), Len));
end;
procedure TApdCustomComPort.GetBlock(var Block; const Len : Word);
{-Return the next Len characters from the buffer}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.GetBlock(PChar(@Block), Len));
end;
procedure TApdCustomComPort.PutChar(const C : Char);
{-Add C to the output buffer}
begin
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.PutChar(C));
end;
procedure TApdCustomComPort.PutString(const S : String);
{-Add S to the output buffer}
begin
if (PortState = psShuttingDown) then Exit;
{$IFOPT H+}
CheckException(Self, ValidDispatcher.PutBlock(Pointer(S)^, Length(S)));
{$ELSE}
CheckException(Self, ValidDispatcher.PutString(S));
{$ENDIF}
end;
function TApdCustomComPort.PutBlock(const Block; const Len : Word) : Integer;
{-Add Block to the output buffer}
begin
PutBlock := 0;
if (PortState = psShuttingDown) then Exit;
CheckException(Self, ValidDispatcher.PutBlock(PChar(Block), Len));
end;
{Waits}
function TApdCustomComPort.CheckForString(var Index : Byte; C : Char;
const S : String;
IgnoreCase : Boolean) : Boolean;
{-Compare C against a sequence of chars, looking for S}
var
CurChar : Char;
begin
CheckForString := False;
if (PortState = psShuttingDown) then Exit;
Inc(Index);
{Upcase both data if ignoring case}
if IgnoreCase then begin
C := Upcase(C);
CurChar := Upcase(S[Index]);
end else
CurChar := S[Index];
{Compare...}
if C = CurChar then
{Got match, was it complete?}
if Index = Length(S) then begin
Index := 0;
CheckForString := True;
end else
else
{No match, reset Index}
if (IgnoreCase and (C = Upcase(S[1]))) or
(C = S[1]) then
Index := 1
else
Index := 0;
end;
function TApdCustomComPort.WaitForString(const S : String;
const Timeout : LongInt;
const Yield, IgnoreCase : Boolean)
: Boolean;
{-Wait for data, generate ETimeout exception if not found}
var
ET : EventTimer;
C : Char;
CurChar : Char;
StartChar : Char;
Index : Byte;
Finished : Boolean;
WasBusy : Boolean;
Len : Word;
begin
Result := True;
{Exit immediately if nothing to do}
if (S = '') or (PortState = psShuttingDown) then
Exit;
{Set busy flag}
ValidDispatcher.SetEventBusy(WasBusy, True);
{Note the length of the string}
Len := Length(S);
{Prepare...}
NewTimer(ET, Timeout);
Index := 0;
Finished := False;
StartChar := S[1];
if IgnoreCase then
StartChar := Upcase(StartChar);
{Wait for data...}
repeat
if CharReady then begin
{Char is ready, go get it}
C := GetChar;
Inc(Index);
CurChar := S[Index];
{Report the character}
WaitChar(C);
{If ignoring case then upcase both}
if IgnoreCase then begin
C := Upcase(C);
CurChar := Upcase(CurChar);
end;
{Compare current character}
if C = CurChar then begin
if Index = Len then
Finished := True;
end else begin
{No match, reset...}
if C = StartChar then
Index := 1
else
Index := 0;
end;
end;
{Check for timeout if we're not otherwise finished}
if not Finished then begin
Finished := TimerExpired(ET);
{Yield}
if Yield then
Application.ProcessMessages;
end;
until Finished or Application.Terminated;
{Indicate timeout if we timed out}
if not Application.Terminated then
Result := not TimerExpired(ET);
{Restore busy flag}
if WaitPrepped and not BusyBeforeWait then
Dispatcher.SetEventBusy(WasBusy, False)
else if not WasBusy then
Dispatcher.SetEventBusy(WasBusy, False);
WaitPrepped := False;
BusyBeforeWait := False;
end;
function TApdCustomComPort.WaitForMultiString(const S : String;
const Timeout : LongInt;
const Yield : Boolean;
const IgnoreCase : Boolean;
const SepChar : Char) : Integer;
{-Wait for S, which contains several substrings separated by ^}
const
MaxSubs = 127;
var
ET : EventTimer;
I, Total : Word;
C : Char;
CurChar : Char;
Finished : Boolean;
WasBusy : Boolean;
StartChar : array[1..MaxSubs] of Char;
StartIndex : array[1..MaxSubs] of Byte;
EndIndex : array[1..MaxSubs] of Byte;
Index : array[1..MaxSubs] of Byte;
Len : Word;
begin
Result := 0;
{Exit immediately if nothing to do}
if (S = '') or (PortState = psShuttingDown) then
Exit;
{Note the length of the string}
Len := Length(S);
{Set busy flag}
ValidDispatcher.SetEventBusy(WasBusy, True);
{Prepare to parse for substrings}
Total := 1;
I := 1;
StartIndex[Total] := I;
Index[Total] := I;
StartChar[Total] := S[I];
if IgnoreCase then
StartChar[Total] := Upcase(StartChar[Total]);
{Loop through S, noting start positions of each substring}
while (I <= Len) and (Total < MaxSubs) do begin
if S[I] = SepChar then begin
EndIndex[Total] := I-1;
Inc(I);
Inc(Total);
StartIndex[Total] := I;
Index[Total] := I;
StartChar[Total] := S[I];
If IgnoreCase then
StartChar[Total] := Upcase(StartChar[Total]);
end else
Inc(I);
end;
{Handle last string}
if S[Len] <> SepChar then
EndIndex[Total] := Len
else
Dec(Total);
{Prepare to wait}
NewTimer(ET, Timeout);
Finished := False;
{Wait for data...}
repeat
if CharReady then begin
{Char is ready, go get it}
C := GetChar;
{Report the character}
WaitChar(C);
{Handle case}
if IgnoreCase then
C := Upcase(C);
{Compare against all substrings}
for I := 1 to Total do begin
CurChar := S[Index[I]];
if IgnoreCase then
CurChar := Upcase(CurChar);
{Compare current character}
if C = CurChar then begin
if Index[I] = EndIndex[I] then begin
Result := I;
Finished := True;
break;
end;
Inc(Index[I]);
end else begin
{No match, reset...}
if C = StartChar[I] then
Index[I] := StartIndex[I]+1
else
Index[I] := StartIndex[I];
end;
end;
end;
{Check for timeout if we're not otherwise finished}
if not Finished then begin
Finished := TimerExpired(ET);
{Yield}
if Yield then
Application.ProcessMessages;
end;
until Finished or Application.Terminated;
{Restore busy flag}
if WaitPrepped and not BusyBeforeWait then
Dispatcher.SetEventBusy(WasBusy, False)
else if not WasBusy then
Dispatcher.SetEventBusy(WasBusy, False);
WaitPrepped := False;
BusyBeforeWait := False;
end;
procedure TApdCustomComPort.PrepareWait;
{-Set EventBusy true to prevent triggers}
begin
if (PortState = psShuttingDown) then Exit;
WaitPrepped := True;
ValidDispatcher.SetEventBusy(BusyBeforeWait, True);
end;
{Miscellaneous procedures}
function SearchComPort(const C : TComponent) : TApdCustomComPort;
{-Search for a comport in the same form as TComponent}
function FindComPort(const C : TComponent) : TApdCustomComPort;
var
I : Integer;
begin
Result := nil;
if not Assigned(C) then
Exit;
{Look through all of the owned components}
for I := 0 to C.ComponentCount-1 do begin
if C.Components[I] is TApdCustomComPort then begin
Result := TApdCustomComPort(C.Components[I]);
Exit;
end;
{If this isn't one, see if it owns other components}
Result := FindComPort(C.Components[I]);
end;
end;
begin
{Search the entire form}
Result := FindComPort(C);
end;
function ComName(const ComNumber : Word) : ShortString;
{-Return a comname ShortString for ComNumber}
begin
Result := 'COM' + IntToStr(ComNumber);
end;
end.