📄 admdm.pas
字号:
property DialTimeout;
property ModemCapFolder;
property RingWaitTimeout;
property SelectedDevice;
property StatusDisplay;
property OnModemCallerID;
property OnModemConnect;
property OnModemDisconnect;
property OnModemFail;
property OnModemLog;
property OnModemStatus;
end;
TAdAbstractModemStatus = class(TApdBaseComponent)
private
FStatusDialog: TForm;
FCaption: string;
FStarted: Boolean;
FModem: TAdCustomModem;
procedure SetCaption(const Value: string);
procedure SetStarted(Start : Boolean);
procedure SetModem(const Value: TAdCustomModem);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
property StatusDialog : TForm
read FStatusDialog write FStatusDialog;
property Caption : string
read FCaption write SetCaption;
property Modem : TAdCustomModem
read FModem write SetModem;
property Started : Boolean
read FStarted;
procedure UpdateDisplay(Modem : TAdCustomModem;
const StatusStr, TimeStr, DetailStr : string;
Action : TApdModemStatusAction);
end;
TAdModemStatus = class(TAdAbstractModemStatus)
published
property Caption;
property Modem;
end;
implementation
uses
AdMdmCfg,
AdMdmDlg;
{ TApdModemNameProp }
procedure TApdModemNameProp.Assign(Source: TPersistent); {!!.02}
begin
if Source is TApdModemNameProp then begin
Clear;
{Property inits}
FManufacturer := TApdModemNameProp(Source).FManufacturer;
FName := TApdModemNameProp(Source).FName;
FModemFile := TApdModemNameProp(Source).FModemFile;
end;
end;
procedure TApdModemNameProp.Clear; {!!.02}
{ clear the values }
begin
FManufacturer := '';
FModemFile := '';
FName := '';
end;
procedure TApdModemNameProp.SetManufacturer(const Value: string);
{ write access method for Manufacturer property }
begin
if FManufacturer <> Value then begin
FManufacturer := Value;
end;
end;
procedure TApdModemNameProp.SetModemFile(const Value: string);
begin
FModemFile := Value;
end;
procedure TApdModemNameProp.SetName(const Value: string);
{ write access method for Name property }
begin
FName := Value;
end;
{ TAdCustomModem }
procedure TAdCustomModem.ModemMessage(var Message: TMessage);
begin
case Message.Msg of
apw_AutoAnswer :
begin
{ got the message to answer the call... }
PrepForConnect(True);
{$IFDEF AdModemDebug}
FComPort.AddStringToLog('Answering');
{$ENDIF}
if not SendCommands(LmModem.Answer) then
DoFail(ecModemRejectedCommand);
end;
apw_CancelCall :
begin
CancelCall;
end;
apw_StartDial :
begin
ResponsePacket.Enabled := True;
if FModemConfig.ToneDial then {!!.06}
FComPort.Output := ConvertXML(LmModem.Settings.Prefix +
LMModem.Settings.DialPrefix +
LmModem.Settings.Tone + {!!.06}
FPhoneNumber +
LmModem.Settings.Terminator)
else
FComPort.Output := ConvertXML(LmModem.Settings.Prefix +
LMModem.Settings.DialPrefix +
LmModem.Settings.Pulse + {!!.06}
FPhoneNumber +
LmModem.Settings.Terminator);
DoStatus(msConnectWait);
end;
else {!!.02}
try {!!.02}
Dispatch(Message); {!!.02}
if Message.Msg = WM_QUERYENDSESSION then {!!.02}
Message.Result := 1; {!!.02}
except {!!.02}
Application.HandleException(Self); {!!.02}
end; {!!.02}
end;
end;
procedure TAdCustomModem.AutoAnswer;
{ initiate auto answer mode }
begin
CheckReady;
FCallerIDProvided := False;
if not Initialized then
Initialize;
{$IFDEF AdModemDebug}
FComPort.AddStringToLog('autoanswer for ' + IntToStr(FAnswerOnRing));
{$ENDIF}
{ turn on the CallerID detection }
SendCommands(LmModem.Voice.EnableCallerID);
DoStatus(msAutoAnswerBackground);
ResponsePacket.Timeout := 0;
ResponsePacket.EnableTimeout := 0; {!!.04}
ResponsePacket.Enabled := True;
end;
procedure TAdCustomModem.CancelCall;
{ cancel whatever we're doing, we'll keep the port open }
{var
ET : EventTimer;} {!!.05}
begin
if not Assigned(FComPort) then {!!.01}
Exit; {!!.01}
FCallerIDProvided := False;
DoStatus(msCancel);
{$IFDEF AdModemDebug}
if Assigned(FComPort) then
FComPort.AddStringToLog('cancel call');
{$ENDIF}
if Connected then begin
DoStatus(msHangup);
{ try lowering DTR first }
{ section rewritten to use SendCommand } {!!.05}
//if not SendCommand('<DTR>') then begin {!!.05}
SendCommand(apxDefModemEscape);
SendCommands(LmModem.Hangup);
//end; {!!.05}
{ end rewrite } {!!.05}
end else if FModemState in [msAnswerWait, msConnectWait] then
{ we've started answering/dialing, send a #13 to terminate that }
SendCommand('');
PrepForConnect(False);
DoDisconnect;
{ close the port if it was closed when we started }
if FPortWasOpen = 1 then {!!.05}
FComPort.Open := False; {!!.05}
FPortWasOpen := 0; {!!.05}
FConnected := False;
LastCommand := ''; {!!.05}
if Initialized then
DoStatus(msIdle)
else
DoStatus(msUnknown);
end;
procedure TAdCustomModem.CheckCallerID(const Response: string);
{ check for the CallerID tags }
var
I,
Psn : Integer;
S : string;
function CheckIt : Boolean;
begin
Psn := Pos(S, Response);
if Psn > 0 then begin
Result := True;
S := Copy(Response, Psn + Length(S) + 1, Length(Response));
S := Copy(S, 1, Length(S) - 2);
end else
Result := False;
end;
begin
if LmModem.Responses.Date.Count > 0 then
for I := 0 to pred(LmModem.Responses.Date.Count) do begin
S := ConvertXML(PLmResponseData(LmModem.Responses.Date[I]).Response);
if CheckIt then begin
FCallerIDInfo.HasData := True;
FCallerIDInfo.Date := S;
end;
end;
if LmModem.Responses.Time.Count > 0 then
for I := 0 to pred(LmModem.Responses.Time.Count) do begin
S := ConvertXML(PLmResponseData(LmModem.Responses.Time[I]).Response);
if CheckIt then begin
FCallerIDInfo.HasData := True;
FCallerIDInfo.Time := S;
end;
end;
if LmModem.Responses.Number.Count > 0 then
for I := 0 to pred(LmModem.Responses.Number.Count) do begin
S := ConvertXML(PLmResponseData(LmModem.Responses.Number[I]).Response);
if CheckIt then begin
FCallerIDInfo.HasData := True;
FCallerIDInfo.Number := S;
end;
end;
if LmModem.Responses.Name.Count > 0 then
for I := 0 to pred(LmModem.Responses.Name.Count) do begin
S := ConvertXML(PLmResponseData(LmModem.Responses.Name[I]).Response);
if CheckIt then begin
FCallerIDInfo.HasData := True;
FCallerIDInfo.Name := S;
end;
end;
if LmModem.Responses.Msg.Count > 0 then
for I := 0 to pred(LmModem.Responses.Msg.Count) do begin
S := ConvertXML(PLmResponseData(LmModem.Responses.Msg[I]).Response);
if CheckIt then begin
FCallerIDInfo.HasData := True;
FCallerIDInfo.Msg := S;
end;
end;
end;
function TAdCustomModem.CheckErrors(const Response: string): Integer;
begin
if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.Error) then
Result := ecModemRejectedCommand
else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.NoCarrier) then
Result := ecModemNoCarrier
else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.NoDialTone) then
Result := ecModemNoDialTone
else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.Busy) then
Result := ecModemDetectedBusy
else if CheckResponses(Response, ApxDefErrorResponse, LmModem.Responses.NoAnswer) then
Result := ecModemNoAnswer
else
Result := ecOK;
end;
procedure TAdCustomModem.CheckReady;
begin
if not Assigned(FComPort) then
raise EPortNotAssigned.Create(ecPortNotAssigned, False);
{ save the state of the port, we'll close it from CancelCall if it }
{ is closed here. 0=not set, 1=closed, 2=open }
if FPortWasOpen = 0 then {!!.05}
if FComPort.Open then {!!.05}
FPortWasOpen := 2 {!!.05}
else {!!.05}
FPortWasOpen := 1; {!!.05}
{FComPort.OnTriggerStatus := TriggerEvent;} {!!.06}
{FComPort.OnTriggerTimer := TriggerEvent;} {!!.06}
FSavedOnTrigger := FComPort.OnTrigger; {!!.06}
FComPort.OnTrigger := TriggerEvent; {!!.06}
if not Assigned(ResponsePacket) then begin
ResponsePacket := TApdDataPacket.Create(Self);
ResponsePacket.Name := Name + '_ResponsePacket';
ResponsePacket.Enabled := False;
ResponsePacket.AutoEnable := False;
ResponsePacket.Timeout := ApxDefCommandTimeout;
ResponsePacket.EnableTimeout := ApxDefCommandTimeout; {!!.04}
ResponsePacket.OnStringPacket := ResponseStringPacket;
ResponsePacket.OnTimeout := ResponseTimeout;
ResponsePacket.ComPort := FComPort;
ResponsePacket.StartCond := scAnyData;
ResponsePacket.EndCond := [ecString];
ResponsePacket.EndString := '?'#13#10;
ResponsePacket.Enabled := True;
end;
if not FComPort.Open then
FComPort.Open := True;
end;
function TAdCustomModem.CheckResponses(const Response, DefResponse: string;
Responses: TList): Boolean;
function StripCtrl(const S : string) : string;
{ strip out the CR/LF prefix and suffix }
begin
Result := S;
while Pos(#13, Result) > 0 do
Delete(Result, Pos(#13, Result), 1);
while Pos(#10, Result) > 0 do
Delete(Result, Pos(#10, Result), 1);
end;
var
I : Integer;
S : string;
begin
{ assume it's not a response that we're looking for }
Result := False;
if Responses.Count > 0 then begin
for I := 0 to pred(Responses.Count) do begin
S := ConvertXML(PLmResponseData(Responses[I]).Response);
if StripCtrl(S) = StripCtrl(Response) then begin
Result := True;
{Break;} {!!.05}
end;
if S = '<StandardConnect>' then {!!.05}
Result := ParseStandardConnect(Response); {!!.05}
if Result then Break; {!!.05}
end;
if not Result then
Result := Pos(DefResponse, Response) > 0;
end else
{ see if the default response is at the beginning of the response }
Result := Pos(DefResponse, Response) > 0; {!!.04}
end;
procedure TAdCustomModem.ConfigAndOpen;
{ open the port and configure the modem }
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -