gsm.int

一个delphi使用的传送短信(SMS)到GSM手机的单元及示范.

unit GSM;

interface
uses
  Classes, SysUtils, Windows, Connect, SyncObjs, Messages, Forms;

{ DONE 20.9.1999 DCS class FFFFxXxx, x .. 7/8 bit encoding }
{ DONE 14.7.2000 Nokia9110 support, SMS text format support }


{
  Nokia9110
    connection: system/faxmodem/select/activate

    SMS to be received through at+cmgl= and at+cmgr must have DCS = F3, otherwise
    goes directly to phone (ME) (except at+cnmi=,2) theoretically - in praxis goes
    allways to ME doesn'n matter on DCS
}

const
  pdutsRP = 7;
  pdutsUDHI = 6;
  pdutsSRI = 5;
  pdutsMMS = 2;
  pdutsMTI = 0;
  pdutsSRR = 5;
  pdutsVPF = 3;
  pdutsRD = 2;

  pdutRP = 1 shl pdutsRP;
  pdutUDHI = 1 shl pdutsUDHI;
  pdutSRI = 1 shl pdutsSRI;
  pdutMMS = 1 shl pdutsMMS;
  pdutMTI = 3 shl pdutsMTI;
  pdutSRR = 1 shl pdutsSRR;
  pdutVPF = 3 shl pdutsVPF;
  pdutRD = 1 shl pdutsRD;

  vpfNone = 0;
  vpfRelative = 2;
  vpfAbsolute = 3;

  dcsmCodingGroup = $F0;

  atrCode = $01;           { command returns OK/ERROR response }
  atrParams = $02;         { returns any params }
  atrBothNecessary = $04;  { command returns params and OK/ERROR }
  atrPDU = $08;            { PDU command, wait for prompt '>' }
  atrATResponse = $10;     { command returns parameters prefixed +cmd: }
  atrCRLF = $20;

  smsfPDU = 0;               { SMS format }
  smsfText = 1;

type
  TSMS = class;

  TRxCharEvent = procedure(Sender: TObject; aChar: Char) of object;
  TUnsolicitedLineEvent = procedure(Sender: TObject; const aLine: string) of object;
  TUnsolicitedSMSEvent = procedure(Sender: TObject; Idx: Integer; aSMS: TSMS) of object;
  TNetworkRegistrationEvent = procedure(Sender: TObject; aNewStatus: Integer) of object;
  TBusyChanged = procedure(Sender: TObject; aBusy: Boolean) of object;

  TGSM = class;

  TSMS = class
  private
    FPDUType: Byte;
    FPID: Byte;
    FDCS: Byte;
    FUD: string;
    FGSM: TGSM;
    function GetPDU: string;
    procedure SetPDU(const Value: string);
    function GetPDUTypeBit(Index: Integer): Boolean;
    procedure SetPDUTypeBit(Index: Integer; Value: Boolean);
    function GetPDUType2Bits(Index: Integer): Byte;
    procedure SetPDUType2Bits(Index: Integer; Value: Byte);
    function EncodeODA(const ODA: string): string;
    function DecodeODA(const ODA: string; var I: Integer): string;
    function EncodeUD: string;
    procedure DecodeUD(const S: string);
    function EncodeStamp(DT: TDateTime): string;
    function DecodeStamp(const DT: string): TDateTime;
    function EncodeTextStamp(DT: TDateTime; TZ: Shortint): string;
    function DecodeTextStamp(const DT: string; var TZ: Shortint): TDateTime;
    function Byte2BCD(B: Byte): Byte;
    function BCD2Byte(B: Byte): Byte;
  protected
    function EncodePDU: string; virtual; abstract;
    procedure DecodePDU(const Value: string); virtual; abstract;
  public
    class function CreateSMS(aOwner: TGSM; const aPDU: string): TSMS;
    property PDU: string read GetPDU write SetPDU;
    property GSM: TGSM read FGSM write FGSM;
    property PDUType: Byte read FPDUType write FPDUType;
    property RP: Boolean index pdutsRP read GetPDUTypeBit write SetPDUTypeBit;
    property UDHI: Boolean index pdutsUDHI read GetPDUTypeBit write SetPDUTypeBit;
    property MTI: Byte index pdutsMTI read GetPDUType2Bits write SetPDUType2Bits;
    property PID: Byte read FPID write FPID;
    property DCS: Byte read FDCS write FDCS;
    property UD: string read FUD write FUd;
  end;

  TMTSMS = class(TSMS) { mobile terminated }
  private
    FOA: string;
    FSCTS: TDateTime;
    FSCTSTZ: ShortInt;
  protected
    function EncodePDU: string; override;
    procedure DecodePDU(const Value: string); override;
  public
    property OA: string read FOA write FOA;
    property SCTS: TDateTime read FSCTS write FSCTS;
    property SCTSTZ: ShortInt read FSCTSTZ write FSCTSTZ;
    property SRI: Boolean index pdutsSRI read GetPDUTypeBit write SetPDUTypeBit;
    property MMS: Boolean index pdutsMMS read GetPDUTypeBit write SetPDUTypeBit;
  end;

  TMOSMS = class(TSMS) { mobile originated }
  private
    FDA: string;
    FMR: Byte;
    FVP: TDateTime;
    FVPTZ: Shortint;
  protected
    function EncodePDU: string; override;
    procedure DecodePDU(const Value: string); override;
  public
    constructor Create; virtual;
    property DA: string read FDA write FDA;
    property MR: Byte read FMR write FMR;
    property VP: TDateTime read FVP write FVP;
    property VPTZ: ShortInt read FVPTZ write FVPTZ;
    property VPF: Byte index pdutsVPF read GetPDUType2Bits write SetPDUType2Bits;
    property SRR: Boolean index pdutsSRR read GetPDUTypeBit write SetPDUTypeBit;
    property RD: Boolean index pdutsRD read GetPDUTypeBit write SetPDUTypeBit;
  end;

  TGSMAsyncThread = class(TThread)
  private
    FOwner: TGSM;
    FAsyncEvent: TSimpleEvent;
    procedure cmRxChar;
  protected
    procedure Execute; override;
    procedure Terminate;
  public
    constructor Create(aOwner: TGSM);
    destructor Destroy; override;
  end;

  TGSMEquipment = (eqA1, eqM1, eqM20, eqGM12, eqNokia9110);

  TGSM = class(TConnection)
  private
    FEquipment: TGSMEquipment;
    FPIN: string;
    FSCA: string;
    FSMSFormat: Byte;
    FComDevice: TComm;
    FLastError: Integer;
    FLastErrorMsg: string;
    FNetworkRegistration: Integer;
    FRepeatCount: Integer;
    FRecTimeout: Longint;
    FRepeatTimeout: Longint;
    FErrorCodes: TStrings;
    FSyncATCmd: string;
    FSyncATResult: TStrings;
    FSyncWaitFor: Byte;
    FSyncSignaled: Byte;
    FSyncEvent: TEvent;
    FRecCmdFlag: Boolean;
    FBusyFlag: Integer;
    FEnableUnsolicitedMI: Boolean;
    FCriticalSection: TCriticalSection;
    FProcessedRxChars: Integer;
    FCMTSMS: TMTSMS;   { unsolicited CMT }
    FNextRxLineLength: Integer;  { length of next line, 0..if not expecting line length}
    FNextRxOmitLength: Integer;
    FRxBuffer: string;     { for window thread }
    FSyncRxBuffer: string; { for COM thread }
    FSaveOnRxChar: TCommRxCharEvent;
    FOnRxChar: TRxCharEvent;
    FOnUnsolicitedLine: TUnsolicitedLineEvent;
    FOnUnsolicitedSMS: TUnsolicitedSMSEvent;
    FOnNetworkRegistration: TNetworkRegistrationEvent;
    FOnBusyChanged: TBusyChanged;
    procedure SetPIN(Value: string);
    procedure SetSMSFormat(Value: Byte);
    procedure SetEnableUnsolicitedMI(Value: Boolean);
    procedure DoSetUnsolicitedMI(Value: Boolean);
    procedure SetSCA(Value: string);
    procedure SetComDevice(Value: TComm);
    procedure DoComRxChar(Sender: TObject; Count: Integer);
    procedure cmRxChar;{(var Msg: TMessage); {message cm_RxChar;}
    function GetIsBusy: Boolean;
  protected
    FAsyncThread: TGSMAsyncThread;
    procedure OpenConn; override;
    procedure CloseConn; override;
    procedure DoRxChar(aChar: Char); virtual;
    procedure ProcessRxLine(const aLine: string); virtual;
    procedure DoUnsolicitedLine(const aLine: string); virtual;
    procedure DoUnsolicitedSMS(Idx: Integer; aSMS: TSMS); virtual;
    procedure DoNetworkRegistration(aNewStatus: Integer); virtual;
    procedure DoBusyChanged(aBusy: Boolean); virtual;
    function SCAinPDU: Boolean;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    procedure SetDefaults;

    procedure Busy;
    procedure Unbusy;
    function SendATCommand(const aCmd: string; aWaitFor: Byte; aResultS: TStrings): Integer;
    function CheckAT(aRes: Integer): Integer;
    procedure SendSMS(aSMS: TSMS);
    function ReadSMS(aIndex: Integer; var Stat: Integer): TSMS;
    procedure DeleteSMS(aIndex: Integer);
    function GetSMSList(aStat: Integer): TStrings;
    procedure SwitchOff;
    property IsBusy: Boolean read GetIsBusy;
    property LastError: Integer read FLastError write FLastError;
    property LastErrorMsg: string read FLastErrorMsg write FLastErrorMsg;
    property ErrorCodes: TStrings read FErrorCodes write FErrorCodes;
    property NetworkRegistration: Integer read FNetworkRegistration;
  published
    property Equipment: TGSMEquipment read FEquipment write FEquipment;
    property SMSFormat: Byte read FSMSFormat write SetSMSFormat;
    property EnableUnsolicitedMI: Boolean read FEnableUnsolicitedMI write SetEnableUnsolicitedMI;
    property PIN: string read FPIN write SetPin;
    property SCA: string read FSCA write SetSCA;
    property COMDevice: TComm read FComDevice write SetComDevice;
    property RepeatCount: Integer read FRepeatCount write FRepeatCount default 5;
    property RecTimeout: Longint read FRecTimeout write FRecTimeout default 3000;
    property RepeatTimeout: Longint read FRepeatTimeout write FRepeatTimeout default 500;
    property OnRxChar: TRxCharEvent read FOnRxChar write FOnRxChar;
    property OnUnsolicitedLine: TUnsolicitedLineEvent read FOnUnsolicitedLine write FOnUnsolicitedLine;
    property OnUnsolicitedSMS: TUnsolicitedSMSEvent read FOnUnsolicitedSMS write FOnUnsolicitedSMS;
    property OnNetworkRegistration: TNetworkRegistrationEvent read FOnNetworkRegistration write FOnNetworkRegistration;
    property OnBusyChanged: TBusyChanged read FOnBusyChanged write FOnBusyChanged;
  end;

  EGSMError = class(EComError);

function DTToValPer(DT: TDateTime): Byte;
function ValPerToDT(VP: Byte): TDateTime;

function StripATResponse(const S: string): string;
function IsATResponse(const S: string): Boolean;

function ExtractParam(const S: string; var Pos: Integer): string;
function TrimQuotes(const S: string): string;

procedure GSMError(const Msg: string);

procedure Register;

const           // <stat> param strings
  StatS: array[0..4] of string = ('REC UNREAD', 'REC READ', 'STO UNSENT', 'STO SENT', 'ALL');

resourcestring
  errsBadAtCommand = 'Bad AT command';
  errsNoComDevice = 'No assigned COM device';
  errsBadPDU = 'Bad PDU format';
  errsNoReplyOnATCommand = 'No reply on AT command: %s';
  errsPINNotExpected = 'PIN is not expected (%s)';
  errsResultErr = 'Error was returned: %s';
implementation