gsmcom.pas

很好的手机发短信的例子。含GSM群发机设计原理和使用说明。还有详细代码

unit GSMCom;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OoMisc, AdPort, adgsm, AdExcept, ADODB, DB, DBClient, Provider,
  IniFiles, ComCtrls, SynaCode, Base32, Math;

const
  WM_SENDERROR = WM_USER+321;
  WM_SENDSUCC  = WM_USER+322;
  WM_STOPFEE   = WM_USER+323;
  WM_TOOMANYERROR = WM_USER+324;



Type
  TGSMSets = class;
  TSendItems = class;
  TGSMTask = class;
  TGSMServer = class;
  TGSMCom = class;

  TMobileRecordStates = (mrsNone,mrsRead,mrsSend);

  TGSMSetState = (gsIdle,gsInvalid,gsBusy, gsOutTime, gsUnknown);

  TGSMFeeState = (gfUnkown,gfNormal,gfTooLow);

  TGSMAction = (gaActive,gaActived, gaSending, gaSended, gaDestroy,
    gaDestroyed, gaReActive,gaPause, gaSendFail, gaKeep, gaDial,gaHangup,
    gaDialError,gaDialTime);

  TGSMAfterCheckEvent = procedure (Index: Integer; state: TGSMSetState) of object;
  TGSMBeforeCheckEvent = procedure (Index: Integer) of object;

  TGSMNoneGSMRunEvent = procedure of Object;
  TGSMActionEvent = procedure(Sender: TGSMCom; Action: TGSMAction; DestMobile: String;MSG: String) of object;


  ///////////////////////////////////////////
  //TSendItem to Store the Send Information
  ///////////////////////////////////////////
  TGSMMode = (gsmMessage,gsmDial);


  TGSMSendItem = Class
  private
    FGSMMode: TGSMMode;
    FMobileNo: String;
    procedure SetGSMMode(const Value: TGSMMode);
    procedure SetMobileNo(const Value: String);
  public
    Constructor Create;
    function Clone: TGSMSendItem; virtual;
    Property GSMMode: TGSMMode read FGSMMode write SetGSMMode;
    property MobileNo: String read FMobileNo write SetMobileNo;
  end;

  TGSMMessageItem = class(TGSMSendItem)
  private
    FSMSMessage: String;
    procedure SetSMSMessage(const Value: String);
  public
    Constructor Create;
    function Clone: TGSMSendItem; Override;
    property SMSMessage: String read FSMSMessage write SetSMSMessage;
  end;

  TGSMDialItem = Class(TGSMSendItem)
  private
    FisRepeat: Boolean;
    FRepeatCount: Integer;
    FDialTime: Integer;
    procedure SetisRepeat(const Value: Boolean);
    procedure SetRepeatCount(const Value: Integer);
    procedure SetDialTime(const Value: Integer);
  public
    Constructor Create;
    function Clone: TGSMSendItem; Override;
    property isRepeat: Boolean read FisRepeat write SetisRepeat;
    property RepeatCount: Integer read FRepeatCount write SetRepeatCount;
    property DialTime: Integer read FDialTime write SetDialTime;
  end;

  ////////////////////////////////////////
  //Collection of SendItem
  ////////////////////////////////////////
  TSendItems = Class(TThreadList)
  private
    FMSG: String;
    FPosition: Integer;
    procedure SetMSG(const Value: String);
    procedure SetPosition(const Value: Integer);
  public
    constructor Create;
    function AddFromSendItem(ASendItem: TGSMSendItem): TGSMSendItem;
    procedure Delete(Index: Integer);
    property MSG: String read FMSG write SetMSG;
    property Position: Integer read FPosition write SetPosition;
  end;

  ////////////////////////////////////////////////
  //TGSMSet to Store One GSMCom Port Information
  ////////////////////////////////////////////////
  TGSMSet  = class
  private
    FPort: Integer;
    Fstate: TGSMSetState;
    FInThread: Boolean;
    FGSMCom: TGSMCom;
    FTask: TGSMTask;
    FFailCount: Integer;
    FSendCount: Integer;
    FGSMSets: TGSMSets;
    FKeepIT: Boolean;
    FFee: Currency;
    FLastCheckFeeDate: TDate;
    FFeeState: TGSMFeeState;
    FFeeLowLevel: Currency;
    procedure SetPort(const Value: Integer);
    procedure Setstate(const Value: TGSMSetState);
    procedure SetInThread(const Value: Boolean);
    function getGSMCom: TGSMCom;
    procedure SetTask(const Value: TGSMTask);
    procedure SetFailCount(const Value: Integer);
    procedure SetSendCount(const Value: Integer);
    function getIndex: Integer;
    procedure SetKeepIT(const Value: Boolean);
    procedure SetFee(const Value: Currency);
    procedure SetLastCheckFeeDate(const Value: TDate);
    procedure SetFeeState(const Value: TGSMFeeState);
    procedure SetFeeLowLevel(const Value: Currency);
  public
    Constructor Create(AGSMSets:TGSMSets);
    procedure DoActive;
    procedure ReActive;
    procedure DoPause;
    procedure DoResume;
    procedure DoTerminate;
    procedure DoFee(SendAdress,SendMessage,ReceiveAdress,FeeTemplate: String);
    property state: TGSMSetState read Fstate write Setstate;
    property InThread: Boolean read FInThread write SetInThread;
    property Port: Integer read FPort write SetPort;
    property GSMCom: TGSMCom read getGSMCom;
    property Task: TGSMTask read FTask write SetTask;
    property SendCount: Integer read FSendCount write SetSendCount;
    property FailCount: Integer read FFailCount write SetFailCount;
    property Index: Integer read getIndex;
    property KeepIT: Boolean read FKeepIT write SetKeepIT;
    property Fee: Currency read FFee write SetFee;
    property LastCheckFeeDate: TDate read FLastCheckFeeDate write SetLastCheckFeeDate;
    Property FeeState: TGSMFeeState read FFeeState write SetFeeState;
    Property FeeLowLevel: Currency read FFeeLowLevel write SetFeeLowLevel;
  end;

  ////////////////////////////////////////////
  //Collection of TGSMSet
  ////////////////////////////////////////////

  TGSMSets = class(TList)
  private
    FApdComPort: TApdComPort;
    FApdGSMPhone: TApdGSMPhone;
    FPortString: String;
    FOnGSMAfterCheck: TGSMAfterCheckEvent;
    FOnGSMBeforeCheck: TGSMBeforeCheckEvent;
    function GetGSMSet(Index: Integer): TGSMSet;
    procedure SetPortString(const Value: String);
    function GetInThreadCount: Integer;
  protected
    procedure InterParserPort;
  public
    procedure ForceSetPort(Str: String);
    procedure TestGSMDevice(Index: Integer);
    procedure TestDevice;
    function FindGSMSetByPortNo(PortNo: Integer): TGSMSet;
    property PortString: String read FPortString write SetPortString;
    property GSMSet[Index: Integer]: TGSMSet read GetGSMSet;
    property OnGSMAfterCheck : TGSMAfterCheckEvent
      read FOnGSMAfterCheck write FOnGSMAfterCheck;
    property OnGSMBeforeCheck : TGSMBeforeCheckEvent
      read FOnGSMBeforeCheck write FOnGSMBeforeCheck;
    property InThreadCount: Integer read GetInThreadCount;
  end;

  TGSMFee = record
    SendAdress: String;
    SendMessage: String;
    ReceveAdress: String;
    FeeTemplate: String;
  end;

  //////////////////////////////////
  //Thread Object, Send The Message
  //By GSM Module
  /////////////////////////////////
  TGSMCom = Class(TThread)
  private
    FPortNo: Integer;
    FApdComPort: TApdComPort;
    FApdGSMPhone: TApdGSMPhone;
//    FSendedList: TList;
    FGSMSet: TGSMSet;
    FLastTestTime: TDateTime;
    FExpired: Integer;
    FIsReady: Boolean;
    FIsSended: Boolean;
    FPause: Boolean;
    FMobileNo, FMSG: String;
    FGSMDialingTime: Integer;
//    FRetry: Integer;
    procedure SetComPort(const Value: Integer);
    function GetComPort: Integer;
    procedure GSMPhoneNextMessage(Pager: TApdCustomGSMPhone;
      ErrorCode: Integer; var NextMessageReady: Boolean);
    procedure GSMPhoneGSMComplete(Pager: TApdCustomGSMPhone;
      State: TGSMStates; ErrorCode: Integer);
    function GetIsReady: Boolean;
    Function CheckGSM: Boolean;
    procedure SetPause(const Value: Boolean);
    procedure UpdateGSMComState(action: TGSMAction; MobileNo: String; MSG: String);

    procedure UpdateDialState;
    procedure UpdateHangupState;
    procedure UpdateSendingState;
    procedure UpdateSendedState;
    procedure UpdateSendFailState;
    procedure UpdateResetState;
    procedure UpdateActivedState;
    procedure UpdateActiveState;
    procedure UpdatePauseState;
    procedure UpdateStopState;
    procedure UpdateStoppedState;
    procedure UpdateDialTimeState;
    procedure UpdateDialErrorState;
  protected

    function DoDial(WaitItem: TGSMDialItem): Boolean;
    function DoMessage(WaitItem: TGSMMessageItem): Boolean;
    procedure DoPause;

    function DoInitGSM: Boolean;
  public
    constructor Create(ASet: TGSMSet; PortNo: Integer;CreateSuspended: Boolean);
    procedure InitGSMPhone;
    destructor Destroy; override;
    procedure FreeGSMPhone;
    procedure ActiveGSM;
    procedure Execute; override;
    procedure SendGSMMessage(MobileNo: String; MSG: String);
    property ComPort: Integer read GetComPort write SetComPort;
    property LastTestTime: TDateTime read FLastTestTime;
    property Expired: Integer read FExpired write FExpired;
    property IsReady: Boolean read GetIsReady;
    property Pause: Boolean read FPause write SetPause;
  end;

  TGSMFeeCom = class(TGSMCom)
  private
    FGSMFee: TGSMFee;
    FLastFeeTime: TDateTime;
    FLastFeeString: String;
    procedure UpdateFeeState;
    procedure UpdateFeeListState;
    procedure UpdateFeeListError;
    procedure UpdateFeeClearState;
    procedure UpdateFeeCheckState;
    Procedure UpdateFeeError;
  protected
    function parserFee(ReceveMessage,FeeModule: String): Currency;
    function SendFeeRequest: Boolean;
    function ListAllMessage: Boolean;
    procedure ClearAllMessage;
    function CheckFeeMessage(var FeeMessage: String): Boolean;

    function RequestFee: boolean;
  public
    Procedure Execute; override;
    procedure SetFeeInfo(SendAdress,SendMessage,ReceiveAddress,FeeTemplate: String);
    property GSMFee: TGSMFee read FGSMFee;
  end;


  /////////////////////////////////////////
  //Server To Container the GSMList and
  //GSMSets, Init the GSMCom
  /////////////////////////////////////////
  TGSMServer = Class
  private
    FGSMSets: TGSMSets;
  public
    constructor Create;
    Destructor Destroy; override;
    property GSMSets: TGSMSets read FGSMSets;
  end;


  //////////////////////////////////////////
  //Collection of Task
  /////////////////////////////////////////
  TGSMTasks = Class(TList)
  private
    FGSMServer: TGSMServer;
    FCurrentTask: TGSMTask;
    procedure SetCurrentTask(const Value: TGSMTask);
    function GetTask(Index: Integer): TGSMTask;
    procedure SetTask(Index: Integer; const Value: TGSMTask);
    Procedure KillAllGSM;
    Function CreateListCDST: TClientDataSet;
  protected
    procedure RequestGSMServer(var GSMServer: TGSMServer);
    procedure StartNextTask;
  public
    constructor Create(GSMServer: TGSMServer);
    destructor Destroy; override;
    procedure SaveToIniFile(IniFile: TIniFile);
    procedure LoadFromIniFile(IniFile: TIniFile);
    function AddTask: TGSMTask;
    procedure DeleteTask(Index: Integer);
    Property CurrentTask: TGSMTask read FCurrentTask write SetCurrentTask;
    property Task[Index: Integer]: TGSMTask read GetTask write SetTask;
  end;

  TUpdateType = (utDelete,utUpdate);
  TDataBaseInfo = class
    ConnectionString: String;
    TableName: String;
    FieldName: String;
    KeyFieldName: String;
    StateFieldName: String;
    MSGFieldName: String;
    UpdateCount: Integer;
    UpdateType: TUpdateType;
    MsgMode: Integer;
  end;

  //////////////////////////////////////////
  //Store A Task Information
  ///////////////////////////////////////// 
  TGSMTask = class
  private
    FGSMTasks: TGSMTasks;
    FTaskStartTime: TDateTime;
    FTaskTime: TDateTime;
    FTaskName: String;
    FTaskEndTime: TDateTime;
    FSendedItems: TSendItems;
    FWaitSendItems: TSendItems;
    FSMSMessage: String;
    FStarted: Boolean;
    FInSequence: Boolean;
    FFinished: Boolean;
    FDataBaseInfo: TDataBaseInfo;
    FUseDataBase: boolean;
    FDynamicDataBase: boolean;
    FWaitCDSTName: String;
    FSendCDSTName: String;
    FisFix: Boolean;
    FDynamicText: Boolean;
    FTextFile: String;
    FReadLnCount: Integer;
    FSendedCount: Integer;
    procedure SetSendedItems(const Value: TSendItems);
    procedure SetTaskEndTime(const Value: TDateTime);
    procedure SetTaskName(const Value: String);
    procedure SetTaskStartTime(const Value: TDateTime);
    procedure SetTaskTime(const Value: TDateTime);
    procedure SetWaitSendItems(const Value: TSendItems);
    procedure SetSMSMessage(const Value: String);
    procedure SetInSequence(const Value: Boolean);
    procedure SetFinished(const Value: Boolean);
    function GetWaitSendCount: Integer;
    procedure SetDataBaseInfo(const Value: TDataBaseInfo);
    procedure SetDynamicDataBase(const Value: boolean);
    procedure SetUseDataBase(const Value: boolean);
    procedure SetSendCDSTName(const Value: String);
    procedure SetWaitCDSTName(const Value: String);
    function GetSendedCount: Integer;
    function getIndex: Integer;
    procedure SetisFix(const Value: Boolean);
    procedure SetDynamicText(const Value: Boolean);
    procedure SetReadLnCount(const Value: Integer);
  public
    function GetOneItem: TGSMSendItem;
    constructor Create(GSMTasks: TGSMTasks);
    destructor Destroy; override;
    procedure Start;
    procedure Stop;
    procedure SaveSendedData;
    property WaitSendCount: Integer read GetWaitSendCount;
    property SendedCount: Integer read GetSendedCount;
    Property WaitSendItems: TSendItems read FWaitSendItems write SetWaitSendItems;
    property SendedItems: TSendItems read FSendedItems write SetSendedItems;
    property TaskName: String read FTaskName write SetTaskName;
    Property TaskTime: TDateTime read FTaskTime write SetTaskTime;
    Property TaskStartTime: TDateTime read FTaskStartTime write SetTaskStartTime;
    property TaskEndTime: TDateTime read FTaskEndTime write SetTaskEndTime;
    property SMSMessage: String read FSMSMessage write SetSMSMessage;
    property Started: Boolean read FStarted;
    property InSequence: Boolean read FInSequence write SetInSequence;
    property Finished: Boolean read FFinished write SetFinished;
    property DataBaseInfo: TDataBaseInfo read FDataBaseInfo write SetDataBaseInfo;
    property UseDataBase: boolean read FUseDataBase write SetUseDataBase;
    property DynamicDataBase: boolean read FDynamicDataBase write SetDynamicDataBase;
    property WaitCDSTName: String read FWaitCDSTName write SetWaitCDSTName;
    property SendCDSTName: String read FSendCDSTName write SetSendCDSTName;
    property Index: Integer read getIndex;
    property isFix: Boolean read FisFix write SetisFix;
  end;


  ////////////////////////////////////
  //TMultiMessage to splite  Message
  ///////////////////////////////////
  TMultiMessage = Class
  private
    FCount: Integer;
    FMSG: WideString;
    FSuffix: String;
    FPrefix: String;
    FMessagLength: Integer;
    function GetMSG(Index: Integer): String;
    procedure SetPrefix(const Value: String);
    procedure SetSuffix(const Value: String);
    procedure SetMessagLength(const Value: Integer);
    procedure ResetCount;
  public
    Constructor Create(AMes: String);
    property Count: Integer read FCount;
    property MSG[Index: Integer]: String read GetMSG;
    property Prefix: String read FPrefix write SetPrefix;
    property Suffix: String read FSuffix write SetSuffix;
    property MessagLength: Integer read FMessagLength write SetMessagLength;
  end;

Procedure ParsePortListFromStr(Str: String; PortList:TStringList);
Procedure RefreshListView(ListView: TListView; SendItems: TSendItems; ForceRefresh: Boolean);
Procedure RefreshWaitSendListView(ListView: TListView; SendItems: TSendItems);

procedure SimpleWait(Milliseconds:Cardinal);

var
  GlobDialLowSpeed: Boolean;
  GlobDialDelayTime: Integer;


implementation

uses DateUtils, GSMWizUnit;


procedure ListItemString(AListItem: TListItem; State,MobileNo,MSG,Fee: String);
begin
//  if State<>'' then
    AListItem.SubItems.Strings[0] := State;
//  if MobileNo<>'' then
    AListItem.SubItems.Strings[1] := MobileNo;
//  if MSG <>'' then
    AListItem.SubItems.Strings[4] := MSG;
//AListItem.SubItems.Strings[5] := Fee;
end;


procedure SimpleWait(Milliseconds:Cardinal);
var
  Tick: Cardinal;
begin
  Tick:=GetTickCount;
  while GetTickCount-Tick<Milliseconds do
  begin
    Application.ProcessMessages;
    Application.ProcessMessages;
    Application.ProcessMessages;
    Application.ProcessMessages;
    sleep(100);
    Application.ProcessMessages;
    Application.ProcessMessages;
    Application.ProcessMessages;
    Application.ProcessMessages;
  end;
end;

Procedure ParsePortListFromStr(Str: String; PortList: TStringList);
var
  sl: TStringlist;
  sl1: TStringList;
  s: String;
  i,j: integer;