dm_gsm.pas

boomerang library 5.11 internet ed

unit dm_GSM;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Connect, CommConnect, GSM, Terminal, XSMS, System.ComponentModel;

const
  cm_NetRegistrationChanged = wm_User+100;
  cm_SMSReceived = wm_User+101;
  cm_ModemStatusChanged = wm_User+102;

  NO_LOG_FILE = 'NUL';

type
  TGSMDataModule = class(TDataModule)
    GSM: TGSM;
    Comm1: TComm;
    procedure DataModule1Create(Sender: TObject);
    procedure GSMDataModuleDestroy(Sender: TObject);
    procedure GSMAfterOpen(DataSet: TConnection);
    procedure GSMNetworkRegistration(Sender: TObject; aNewStatus: Integer);
    procedure GSMBeforeOpen(DataSet: TConnection);
    procedure GSMAfterClose(DataSet: TConnection);
    procedure GSMBusyChanged(Sender: TObject; aBusy: Boolean);
    procedure GSMUnsolicitedSMS(Sender: TObject; Idx: Integer; aSMS: TSMS);
    procedure GSMRxChar(Sender: TObject; aChar: AnsiChar{TChar});
    procedure Comm1RxChar(Sender: TObject; Count: Integer);
  private
    FGSMStr: string;
    RecSMSBuffer: TList;
    FGSMLogFile: string;
    FSMSLogFile: string;
    FSMSProtocol: TSMSProtocolStack;
    function GetActive: Boolean;
    procedure SetActive(aValue: Boolean);
    procedure LogToFile(aFilename, aText: string);
    procedure ReadIniFile;
    procedure WriteIniFile;
    procedure SetGSMLogFile(const Value: string);
    procedure SetSMSLogFile(const Value: string);
    function LogSafe(S: TString): string;
  public
    ModemLog, SMSLog: TTerminal;
    property GSMLogFile: string read FGSMLogFile write SetGSMLogFile;
    property SMSLogFile: string read FSMSLogFile write SetSMSLogFile;
    property Active: Boolean read GetActive write SetActive;
    procedure SendSMS(aSMS: TSMSSubmit);
    procedure ModemStatusChanged(aNewStatus: Integer);
    procedure ProcessSMS(aSMS: TSMS);
    procedure LogSMS(aSMS: TSMS);
    procedure LogGSM(aChar: TChar);
  end;

var
  GSMDataModule: TGSMDataModule;

implementation
uses
  AuxProj{$IFDEF CLR}, AnsiClasses{$ENDIF};

{$R *.DFM}

procedure NotifyForms(Msg: Word; WParam, LParam: Longint);
var
  I: Integer;
begin
  for I:= 0 to Screen.FormCount-1 do
    Screen.Forms[I].Perform(Msg, WParam, LParam);
end;

procedure TGSMDataModule.DataModule1Create(Sender: TObject);
begin
  RecSMSBuffer:= TList.Create;
  FSMSProtocol:= TSMSProtocolStack.Create;

  FGSMStr := '';
  ReadIniFile;
end;

procedure TGSMDataModule.ReadIniFile;
var
  BR: TBaudrate;
  Timeout: Integer;
  {$IFNDEF CLR}
  PB: ^Byte;
  {$ENDIF}
begin 
  Comm1.DeviceName:= Ini.ReadString('Modem', 'DeviceName', Comm1.DeviceName);
  GSM.Equipment:= Str2GMSEquipment(UpperCase(Ini.ReadString('Modem', 'Device', GSMEquipmentShortName[GSM.Equipment])));
  GSM.PIN:= Ini.ReadString('Modem', 'PIN', GSM.PIN);
  GSM.SCA:= Ini.ReadString('Modem', 'SCA', GSM.SCA);
  {$IFDEF CLR}
  GSM.UnsolicitedIndication:= TGSMUnsolicitedIndicationSet(Ini.ReadInteger('Modem','UnsolicitedIndication', Byte(GSM.UnsolicitedIndication)));
  {$ELSE}
  PB:= @GSM.UnsolicitedIndication;
  GSM.UnsolicitedIndication:= TGSMUnsolicitedIndicationSet(Ini.ReadInteger('Modem','UnsolicitedIndication', PB^));
  {$ENDIF}
  GSM.SMSFormat:= Ini.ReadInteger('Modem','SMSFormat',0);
  GSM.SetDefaults;

  Timeout := Ini.ReadInteger('Modem','RecTimeout',0);
  if Timeout > 0 then
    GSM.RecTimeout := Timeout;

  if Int2Baudrate(Ini.ReadInteger('Modem', 'Baud', 0), BR) then
    GSM.COMDevice.Baudrate:= BR;

  FGSMLogFile:= Ini.ReadString('Modem.Files', 'GSMLog', GetProgramPath+'gsm.log');
  FSMSLogFile:= Ini.ReadString('Modem.Files', 'SMSLog', GetProgramPath+'sms.log');
end;

procedure TGSMDataModule.WriteIniFile;
begin
  Ini.WriteString('Modem', 'DeviceName',Comm1.DeviceName);
  Ini.WriteString('Modem', 'Device', GSMEquipmentShortName[GSM.Equipment]);
  Ini.WriteString('Modem', 'PIN', GSM.PIN);
  Ini.WriteString('Modem', 'SCA', GSM.SCA);

  Ini.WriteInteger('Modem','SMSFormat',GSM.SMSFormat);
  Ini.WriteInteger('Modem','UnsolicitedIndication',Byte(GSM.UnsolicitedIndication));

  Ini.WriteString('Modem.Files', 'GSMLog', FGSMLogFile);
  Ini.WriteString('Modem.Files', 'SMSLog', FSMSLogFile);
end;

function TGSMDataModule.GetActive;
begin
  Result:= GSM.Active;
end;

procedure TGSMDataModule.SetActive;
begin
  GSM.Active:= aValue;
end;

procedure TGSMDataModule.GSMDataModuleDestroy(Sender: TObject);
begin
  WriteIniFile;
  RecSMSBuffer.Free;
  FSMSProtocol.Free;
end;

procedure TGSMDataModule.ProcessSMS;
var
  S2: string;
  I: Integer;
  NBS: TSMSProtocol;
  Addr: Word;
  SM: TSmartMessage;
  EMS: TEMS;
resourcestring
  sFragment = '*ref:%.2x, #%d/%d, , addr:%.4x';
  sComplete = 'complete';
begin
  LogSMS(aSMS);

  if aSMS is TSMSDeliver then
  begin
    S2:= '';
    fSMSProtocol.CleanSMSProtocols(5{min}/60/24, False);
    if fSMSProtocol.ProcessSMS(aSMS, NBS) then
    begin
      Addr:= 0;
      if NBS is TSMSProtocol2 then
        Addr:= TSMSProtocol2(NBS).DestinationAddress;
      S2:= Format(sFragment, [NBS.Reference, NBS.InsertedCount, NBS.FragmentCount, Addr]);
      if NBS.Status = smspsOK then
      begin
        S2:= S2+' '+sComplete;
        // here is possible process received data, show bitmap, play melody, save it to file etc.
        if NBS is TSMSProtocol2 then
          begin
            SM:= TSmartMessage.CreateSM(NBS.Data, TSMSProtocol2(NBS).DestinationAddress);
            if SM <> nil then
              try
                S2:= S2 + ' SmartMessage:'+SM.ClassName;
                {if SM is TSMMultipartMessage then
                  S2:= S2+'Multipart message'
                else if SM is TSMRingingTine then
                  S2:= S2+'Ringing tone'  classname  inheritsfrom }
              finally
                SM.Free;
              end
            else if NBS is TUDHProtocol then
              begin
                EMS:= TEMS.Create;
                try
                  try
                    EMS.ReadFrom(TUDHProtocol(NBS));
                    S2:= S2+ ' EMS';
                    for I:= 0 to EMS.Objects.Count-1 do
                    begin
                      if I > 0 then
                        S2:= S2+',';
                      S2:= S2+EMS.Objects[I].ClassName;
                    end;
                  except
                  end;
                finally
                  EMS.Free;
                end;
              end;
          end
        else if NBS is TSiemensOTA then
          begin
            S2:= S2 + Format(' SEO: %s, Name: "%s"', [string(TSiemensOTA(NBS).ObjectType), string(TSiemensOTA(NBS).ObjectName)]);
          end;

        fSMSProtocol.RemoveSMSProtocol(NBS);
        NBS.Free;                                  // delete processed data
      end;
    end;
    if S2 <> '' then
    begin
      if SMSLog <> nil then
        SMSLog.Log(S2);
      S2 := S2+#13#10;
      LogToFile(FSMSLogFile,S2);
    end;
  end;
  
//  NotifyForms(cm_SMSReceived, 0, Longint(aSMS));
end;

procedure TGSMDataModule.GSMAfterOpen(DataSet: TConnection);
var
  Sg: Classes.TStrings;
  I, J: Integer;
begin
  if GSM.Equipment in [eqM20, eqNokia9110, eqWavecom, eqFasttrack] then Sg:= GSM.GetSMSList(4{all})
                                                                   else Sg:= GSM.GetSMSList(-1);
  try
    for I:= 0 to Sg.Count-1 do
    begin
      J:= StrToInt(Sg.Names[I]);
      if StrToInt(Sg.Values[Sg.Names[I]]) in [0{unreaed}] then
      begin
        if Sg.Objects[I] <> nil then
          ProcessSMS(Sg.Objects[I] as TSMS);
      end;
      GSM.DeleteSMS(J);
    end;
  finally
    Sg.Free;
  end;
  ModemStatusChanged(1 or $80);
end;

procedure TGSMDataModule.GSMNetworkRegistration(Sender: TObject;
  aNewStatus: Integer);
begin
  NotifyForms(cm_NetRegistrationChanged, aNewStatus, 0);
end;

procedure TGSMDataModule.GSMBeforeOpen(DataSet: TConnection);
begin
  WriteIniFile;
  ModemStatusChanged(0);
end;

procedure TGSMDataModule.ModemStatusChanged;
begin
  NotifyForms(cm_ModemStatusChanged, aNewStatus, 0);
end;

procedure TGSMDataModule.GSMAfterClose(DataSet: TConnection);
begin
  ModemStatusChanged(-1);
end;

procedure TGSMDataModule.GSMBusyChanged(Sender: TObject; aBusy: Boolean);
begin
  ModemStatusChanged(Integer(not aBusy));
end;

procedure TGSMDataModule.SendSMS;
begin
  GSM.SendSMS(aSMS);
end;

procedure TGSMDataModule.GSMUnsolicitedSMS(Sender: TObject; Idx: Integer;
  aSMS: TSMS);
var
  Stat: Integer;
begin
  if aSMS = nil then  { PDU mode }
    begin
      try
        aSMS:= GSM.ReadSMS(Idx, Stat);
        if Stat in [0{unread}] then
          ProcessSMS(aSMS);
      finally
        GSM.DeleteSMS(Idx);
      end;
    end
  else
    begin           { text mode }
      ProcessSMS(aSMS);
      if Idx <> -1 then
        GSM.DeleteSMS(Idx);
    end;
end;

procedure TGSMDataModule.LogToFile(aFilename, aText: string);
var
  St: TStream;
  M: Word;
begin
  if aFilename <> NO_LOG_FILE then
  begin
    if FileExists(aFilename) then
       M:= fmOpenWrite+fmShareDenyWrite
    else M:= fmCreate;
     St:= TFileStream.Create(aFilename, M);
    try
      St.Position:= St.Size;
      StringToStream(aText, St);
    finally
      St.Free;
    end;
  end;
end;

procedure TGSMDataModule.LogGSM(aChar: TChar);
begin
  FGSMStr := FGSMStr + aChar;
  if aChar = LF then
  begin
    LogToFile(FGSMLogFile,
      Format('%s: %s',[DateTimeToStr(Now),string(FGSMStr)]));   // *** CLR Format
    FGSMStr := '';
  end;
end;

procedure TGSMDataModule.LogSMS;
var
  S2, S3: string;
//  I: Integer;
begin
  S3:= '';
 { if aSMS is TSMS2 then
    if TSMS2(aSMS).DCS and dcsmAplhabet <> dcsAlphabetDefault) then        // 8bit taky hexa
    begin
      S3:= '';
      for I:= 1 to Length(TSMSSubmit(aSMS).UD) do
        S3:= S3+Format('%.2x', [Byte(TSMSSubmit(aSMS).UD[I])]);
      S3:= S3+' / ';
    end; }
  if aSMS is TSMSDeliver then
    begin
      with aSMS as TSMSDeliver do
        S2:= Format('>%s, OA: %s, PID: %.2x, UD: %s%s',
             [DateTimeToStr(SCTS), string(OA), PID, S3, LogSafe{SMStoISO}(UD)]);   // *** CLR Format
    end
  else if aSMS is TSMSSubmit then
    begin
      with aSMS as TSMSSubmit do
        S2:= Format('<%s, DA: %s, PID: %.2x, UD: %s%s',
             [DateTimeToStr(Now), string(DA), PID, S3, LogSafe{SMStoISO}(UD)]);   // *** CLR Format
    end
  else if aSMS is TSMSStatusReport then
    begin
      with aSMS as TSMSStatusReport do
        S2:= Format('!%s, OA: %s, Status: %d, DT: %s', [DateTimeToStr(Now), string(OA), Status, DateTimeToStr(DT)]);   // *** CLR Format
    end
  else
    Exit;
  if SMSLog <> nil then
    SMSLog.Log(S2);
  S2 := S2+#13#10;
  LogToFile(FSMSLogFile,S2);
end;

procedure TGSMDataModule.GSMRxChar(Sender: TObject; aChar: TChar);
begin
  if ModemLog <> nil then
    ModemLog.LogTerm(aChar);
  LogGSM(aChar);
end;

procedure TGSMDataModule.Comm1RxChar(Sender: TObject; Count: Integer);
var
  I: Integer;
  S: TString;
begin
  S:= (Sender as TComm).Retrieve(Count);
  for I:= 1 to Length(S) do
    GSMRxChar(nil, S[I]);
end;

procedure TGSMDataModule.SetGSMLogFile(const Value: string);
begin
  FGSMLogFile := Value;
end;

procedure TGSMDataModule.SetSMSLogFile(const Value: string);
begin
  FSMSLogFile := Value;
end;

function TGSMDataModule.LogSafe(S: TString): string;
var
  I: Integer;
begin
  Result:= '';
  for I:= 1 to Length(S) do
    if Ord(S[I]) = 13 then
      Result:= Result+'<CR>'
    else if Ord(S[I]) = 10 then
      Result:= Result+'<LF>'
    else if Ord(S[I]) in [0..31] then
      begin
        Result:= Bin2Hex(S);
        Break;
      end
    else
      Result:= Result+S[I];
end;

end.