admdm.pas

Async Professional 4.04

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;
        FComPort.Output := ConvertXML(LmModem.Settings.Prefix +
                                      LMModem.Settings.DialPrefix +
                                      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;                                                       {!!.04}
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 }
    WaitingForResponse := True;
    TimedOut := False;
    ResponsePacket.TimeOut := ApxDefDTRTimeout;
    ResponsePacket.Enabled := True;
    FComPort.DTR := False;

    { wait for the response }
    NewTimer(ET, Secs2Ticks(ApxDefDTRTimeout));                          {!!.04}
    repeat
      {Application.HandleMessage;}                                       {!!.02}
      DelayTicks(2, True);                                               {!!.02}
      if csDestroying in ComponentState then Exit;
    until not(WaitingForResponse) or (TimedOut) or TimerExpired(ET);     {!!.04}

    ResponsePacket.Enabled := False;
    if TimedOut or TimerExpired(ET) then begin                           {!!.04}
      { lowering DTR didn't work, escape and send the hangup command }
      SendCommand(ApxDefModemEscape);
      if not SendCommands(LmModem.Hangup) then begin
        SendCommand(ApxDefModemEscape);
        SendCommand(ApxDefHangupCmd);
      end;
    end;
  end else if FModemState in [msAnswerWait, msConnectWait] then
    { we've started answering/dialing, send a #13 to terminate that }
    SendCommand('');
  PrepForConnect(False);
  DoDisconnect;
  FConnected := False;
  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;
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
  if not Assigned(FComPort) then
    raise EPortNotAssigned.Create(ecPortNotAssigned, False);

  FComPort.OnTriggerStatus := TriggerEvent;
  FComPort.OnTriggerTimer := TriggerEvent;

  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;
      end;
    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
  FCallerIDProvided := False;
  CheckReady;       
  {$IFDEF AdModemDebug}
  FComPort.AddStringToLog('ConfigAndOpen');
  {$ENDIF}
  PassthroughMode := True;
  Initialize;
  DoStatus(msIdle);
  DoConnect;
end;

function TAdCustomModem.ConvertXML(const S: string): string;
  { converts the '<CR>' and '<LF>' from LibModem into #13 and #10 }
var
  Psn : Integer;
begin
  Result := S;
  while Pos('<CR>', AnsiUpperCase(Result)) > 0 do begin
    Psn := Pos('<CR>', AnsiUpperCase(Result));
    Delete(Result, Psn, Length('<CR>'));
    Insert(#13, Result, Psn);
  end;
  while Pos('<LF>', AnsiUpperCase(Result)) > 0 do begin
    Psn := Pos('<LF>', AnsiUpperCase(Result));
    Delete(Result, Psn, Length('<LF>'));
    Insert(#10, Result, Psn);
  end;
  { XML also doubles any '%' char, strip that }
  while Pos('%%', Result) > 0 do
    Delete(Result, Pos('%%', Result), 1);
end;

constructor TAdCustomModem.Create(AOwner: TComponent);
  { we're being created }
begin
  FSelectedDevice := TApdModemNameProp.Create;
  FStatusDisplay := nil;
  inherited;
  Initialized := False;
  PassthroughMode := False;
  ResponsePacket := nil;

  { property inits }
  FAnswerOnRing := 2;
  FBPSRate := 0;
  FConnected := False;
  FDialTimeout := 60;
  FFailCode := 0;
  FModemCapFolder := ApxDefModemCapFolder;
  FModemState := msUnknown;
  FNegotiationResponses := TStringList.Create;
  FRingCount := 0;
  FRingWaitTimeout := 1200;
  FSelectedDevice.Manufacturer := '';
  FSelectedDevice.Name := '';
  FStartTime := 0;
  LmModem.Manufacturer := 'Generic Hayes compatible';
  LmModem.Model := 'Generic modem';
  LmModem.FriendlyName := 'Generic modem';
  LibModem := TApdLibModem.Create(Self);
  FModemConfig := DefaultDeviceConfig;
  FCallerIDProvided := False;
  with CallerIDInfo do begin
    HasData := False;
    Date   := '';
    Time   := '';
    Number := '';
    Name   := '';
    Msg    := '';
  end;
  FHandle := AllocateHWnd(ModemMessage);
  FComPort := SearchComPort(Owner);
end;

procedure TAdCustomModem.TriggerEvent(CP: TObject;
  TriggerHandle: Word);
  { handle our DCD and timer triggers }
begin
  if TriggerHandle = DCDTrigger then begin
    if FComPort.DCD then
      DoConnect
    else
      DoDisconnect;
  end else if TriggerHandle = StatusTimerTrigger then begin
    DoStatus(FModemState);
    FComPort.SetTimerTrigger(StatusTimerTrigger, 1000, True);
    if (FModemState = msConnectWait) and
       (Integer(ElapsedTime div 1000) >= FDialTimeout) then begin
       { > DialTimeout elapsed, cancel }
      PostMessage(Handle, apw_CancelCall, 0, 0);
      DoFail(ecModemNoAnswer);                                           {!!.04}
    end;
  end;           
end;

function TAdCustomModem.DefaultDeviceConfig: TApdModemConfig;
begin
  with Result do begin
    ConfigVersion := ApxModemConfigVersion;
    { port settings }
    DataBits := 8;
    Parity := pNone;
    StopBits := 1;
    if Assigned(FComPort) then
      AttachedTo := FComPort.Dispatcher.DeviceName
    else
      AttachedTo := 'unknown';

    Manufacturer := LmModem.Manufacturer;
    ModemName := LmModem.FriendlyName;
    ModemModel := LmModem.Model;
    { speaker options }
    SpeakerVolume :=  svMed;
    SpeakerMode := smDial;
    { connection control }
    FlowControl := fcHard;
    ErrorControl := [ecOn];
    Compression := True;;
    Modulation := smCCITT;;
    ToneDial := True;
    BlindDial := False;
    CallSetupFailTimeout := 60;
    InactivityTimeout := 0;
    { extra commands }
    ExtraSettings := '';
    FillChar(Padding, SizeOf(Padding), #0);
  end;
end;

destructor TAdCustomModem.Destroy;
  { we're being destroyed }
begin
  DeallocateHWnd(FHandle);                                               {!!.02}
  ResponsePacket.Free;
  FNegotiationResponses.Free;
  FSelectedDevice.Free;
  LibModem.Free;
  inherited Destroy;
end;

procedure TAdCustomModem.Dial(const ANumber: string);
  { initiate the dialing sequence }
begin