fsmsthread.pas

一个不错的短信控件！具体使用方法请仔细研究。

//******************************************
//一个短信收发的控件
//Garfield
//2006
//[e-mail]
//如果分发，请保留这些信息，谢谢
//******************************************
unit FSMSThread;

interface

uses
  Classes, Messages,OoMisc, AdPort,Windows,forms,Contnrs,FSMSCommFun,ExtCtrls,SysUtils;

type
  TSMSReceiveDataEvent = procedure (StrReceive,Comm:String) of object;
  TSMSNewMsgEvent = procedure (PhoneNO,Msg,Comm:String;MsgTime:TDateTime) of
          object;
  TSMSSendResultEvent = procedure (ID:Integer;PhoneNO,Msg,MsgTime,Comm:String;
          SendResult:Boolean) of object;
  TSMSExcuteCommandResultEvent = procedure (Command:String;ReturnMsg,
          Comm:String; ExcuteResult:Integer) of object;
  TCallEvent = procedure (PhoneNO,MsgTime,Comm:String) of object;
  TSMSQueue = class(TObject)
  private
    Content: string;
    ID: Integer;
    InTime: TDateTime;
    PhoneNO: string;
    SendTime: TDateTime;
  end;
  
  TSMSCommandQueue = class(TObject)
  private
    ATCommand: string;
  end;
  
type
  TSMSThread = class(TThread)
  private
    ApdCom: TApdComPort;
    CurrentAnswer: string;
    CurrentCommand: string;
    FAutoDeleteMsg: Boolean;
    FCallState: Boolean;
    FCheckCommandTime: LongInt;
    FCommandResult: Integer;
    FCommNumber: Integer;
    FEnableTimeOut: Boolean;
    FMsgHandle: THandle;
    FOnCallEvent: TCallEvent;
    FOnExcuteCommandEvent: TSMSExcuteCommandResultEvent;
    FOnReceiveData: TSMSReceiveDataEvent;
    FOnSMSNewMsgEvent: TSMSNewMsgEvent;
    FOnSMSSend: TSMSSendResultEvent;
    FReadExistMSG: Boolean;
    FSMSCenterNO: string;
    FSMSCommandQueue: TObjectQueue;
    FSMSDelay: Integer;
    FSMSQueue: TObjectQueue;
    FTag: Integer;
    FTimeoutCount: LongInt;
    FTriggerERROR: Integer;
    FTriggerNewMsg: Word;
    FTriggerOK: Word;
    FTriggerReturn: Word;
    FTriggerSendReadyMsg: Word;
    FTryNumber: Integer;
    function AnalyseReceiveData: Boolean;
    procedure PostSMSMsg(Msg: shortstring);
    procedure TriggerAvail(CP : TObject; Count : Word);
    procedure TriggerData(CP : TObject; TriggerHandle : Word);
  protected
    function DeleteSMS(ID:Integer): Boolean;
    procedure Execute; override;
    function GetCall: Boolean;
    procedure GetCallInfo(ReceiveMSG:String;var CallID,CallTime:String);
    function GetMSG(ReceiveMSG:String;var PhoneNO,MsgContent:String;var
            MSGDateTime:string): Integer;
    function ManageCall(CallHandle:Boolean): Boolean;
    procedure ManageQueue;
    procedure ManagerListMsg(Str:String);
    procedure ReadSMS(ID:Integer);
  public
    constructor Create(CreateSuspended: Boolean);
    destructor Destroy;
    procedure CloseComm;
    function ExcuteCommand(Command:String;var CommandResult:String): Integer;
    function GetCommandQueueCount: Integer;
    function GetSendQueueCount: Integer;
    procedure InitSMS;
    function IsOpen: Boolean;
    procedure OpenComm;
    procedure PushCommand(AT:String);
    procedure PushSMS(SMSID:Integer;SMSPhoneNO,SMSMsg:String;
            SMSSendTime:TDatetime);
    procedure PutString(AT:String);
    function SendSMS(PhoneNO:String;Msg:String): Boolean;
    procedure SetAutoOpen(AutoOpen:Boolean);
    procedure SetBaud(Baud:Integer);
    procedure SetComNum(Comm:Integer);
  published
    property AutoDeleteMsg: Boolean read FAutoDeleteMsg write FAutoDeleteMsg;
    property CheckCommandTime: LongInt read FCheckCommandTime write
            FCheckCommandTime;
    property CommNumber: Integer read FCommNumber write FCommNumber;
    property EnableTimeOut: Boolean read FEnableTimeOut write FEnableTimeOut;
    property MsgHandle: THandle read FMsgHandle write FMsgHandle;
    property OnCallEvent: TCallEvent read FOnCallEvent write FOnCallEvent;
    property OnExcuteCommandEvent: TSMSExcuteCommandResultEvent read
            FOnExcuteCommandEvent write FOnExcuteCommandEvent;
    property OnReceiveData: TSMSReceiveDataEvent read FOnReceiveData write
            FOnReceiveData;
    property OnSMSNewMsgEvent: TSMSNewMsgEvent read FOnSMSNewMsgEvent write
            FOnSMSNewMsgEvent;
    property OnSMSSend: TSMSSendResultEvent read FOnSMSSend write FOnSMSSend;
    property ReadExistMSG: Boolean read FReadExistMSG write FReadExistMSG;
    property SMSCenterNO: string read FSMSCenterNO write FSMSCenterNO;
    property SMSDelay: Integer read FSMSDelay write FSMSDelay;
    property Tag: Integer read FTag write FTag;
    property TimeoutCount: LongInt read FTimeoutCount write FTimeoutCount;
    property TryNumber: Integer read FTryNumber write FTryNumber;
  end;
  

procedure Register;

const
  MsgSMS = WM_USER + 100; //定义消息

implementation

{ Important: Methods and properties of objects in visual components can only be
  used in a method called using Synchronize, for example,

      Synchronize(UpdateCaption);

  and UpdateCaption could look like,

    procedure SMSTread.UpdateCaption;
    begin
      Form1.Caption := 'Updated in a thread';
    end; }

{ SMSTread }

procedure Register;
begin
end;

{
********************************** TSMSThread **********************************
}
constructor TSMSThread.Create(CreateSuspended: Boolean);
begin
  ApdCom:=TApdComPort.create(nil);
  ApdCom.ComNumber:=1;
  ApdCom.Baud:=9600;
  //ApdCom.AutoOpen:=True;
  
  ApdCom.OnTriggerAvail:=TriggerAvail;
  ApdCom.OnTriggerData:=TriggerData;
  
  //收到新短信
  //FTriggerNewMsg:=ApdCom.AddDataTrigger('+CMTI', False);
  //发送短信指令准备就续
  FTriggerSendReadyMsg:=ApdCom.AddDataTrigger('>', False);
  //命令执行成功
  FTriggerOK:=ApdCom.AddDataTrigger('OK', False);
  //命令执行失败
  FTriggerERROR:=ApdCom.AddDataTrigger('ERROR', False);
  //回车
  FTriggerReturn:=ApdCom.AddDataTrigger(#13, False);
  
  
  TryNumber:=3;  //重试次数,缺省为3
  FCheckCommandTime:=5000;
  FCallState:=False;
  FReadExistMSG:=True;
  
  FSMSQueue:=TObjectQueue.Create;  //创建短信队列
  FSMSCommandQueue:=TObjectQueue.Create;     //创建命令队列
  
  FreeOnTerminate := True;
  inherited Create(CreateSuspended);
end;

destructor TSMSThread.Destroy;
begin
  // 在销毁等待Com口关闭
  FSMSQueue.Free;
  FSMSCommandQueue.Free;
  FreeOnTerminate:= true;
end;

function TSMSThread.AnalyseReceiveData: Boolean;
var
  CallID, CallTime: string;
  SMSIndex, PhoneNO, Msg, MsgTime: string;
begin
  //*************************************************************************
  //收到OK
  //*************************************************************************
  // 当前的指令是 'AT+CSCA?'+#13
  if UpperCase(CurrentAnswer)='AT+CSCA' then
    FSMSCenterNO:=Copy(CurrentAnswer,Pos('"',CurrentAnswer)+2,13);
  
  //列出短信
  if Pos('AT+CMGL',UpperCase(CurrentCommand))>0 then
    ManagerListMsg(CurrentAnswer);
  
  //读短信
  if Pos('AT+CMGR',UpperCase(CurrentAnswer))>0 then
  begin
    GetMSG(CurrentAnswer,PhoneNO,Msg,MsgTime);
    if Assigned(FOnSMSNewMsgEvent) then
        FOnSMSNewMsgEvent(PhoneNO,Msg,IntToStr(FCommNumber),StrToDateTime(MsgTime));
        //FOnSMSNewMsgEvent(PhoneNO,Msg,IntToStr(FCommNumber),Now);
  end;
  
  //读来电号码
  if Pos('AT+CLCC',UpperCase(CurrentAnswer))>0 then
  begin
    FCallState:=False;
    GetCallInfo(CurrentAnswer,CallID,CallTime);
    if Assigned(FOnCallEvent) then
        FOnCallEvent(CallID,CallTime,IntToStr(FCommNumber));
  end;
  
  //清空接收信息
  CurrentAnswer:='';
end;

procedure TSMSThread.CloseComm;
begin
  ApdCom.Open:=False;
end;

function TSMSThread.DeleteSMS(ID:Integer): Boolean;
var
  s: string;
begin
  s:='AT+CMGD='+IntToStr(ID)+#13;
  PushCommand(s);
end;

function TSMSThread.ExcuteCommand(Command:String;var CommandResult:String):
        Integer;
var
  StartTickCount: DWORD;
  ET: EventTimer;
begin
  CurrentCommand:=Command;
  FCommandResult:=-1;
  
  //写入命令
  ApdCom.PutString(Command);
  
  //************************************************************
  NewTimer(ET,Secs2Ticks(FTimeOutCount));
  repeat
    //ApdCom.ProcessCommunications;
    Application.ProcessMessages;
  until (FCommandResult>=0) or TimerExpired(ET);
  
  //**********************************************************************
  //-1:不确定 0:失败 1：成功  2：发送短信待命
  //**********************************************************************
  
  Result:=FCommandResult;
  
  CommandResult:=CurrentAnswer;
  
  //引发执行命令事件
  if Assigned(FOnExcuteCommandEvent) then
         FOnExcuteCommandEvent(CurrentCommand,CommandResult,IntToStr(FCommNumber),FCommandResult);
end;

procedure TSMSThread.Execute;
begin
  { Place thread code here }
  repeat
      //接收和处理数据
      Application.ProcessMessages;
      Synchronize(ManageQueue);
      sleep(10);
  until self.Terminated;
end;

function TSMSThread.GetCall: Boolean;
var
  s: string;
begin
  //取电话号码
  s:='AT+CLCC'+#13;
  //WriteCommDataAT(s);
  PushCommand(s);
  Result:=True;
  //Result:=ExcuteCommand(s,r);
end;

procedure TSMSThread.GetCallInfo(ReceiveMSG:String;var CallID,CallTime:String);
var
  StartPos, EndPos: Integer;
  vTemp: string;
begin
  //TODO:处理电话号码和时间
  {
  AT+CLCC
  
  +CLCC: 1,1,4,0,0,"13336395017",129
  
  OK
  }
  vTemp:=CurrentAnswer;
  StartPos:=Pos('"',vTemp);
  delete(vTemp,StartPos,1);
  EndPos:=Pos('"',vTemp);
  CallID:=Copy(vTemp,StartPos,EndPos-StartPos);
  CallTime:=FormatDatetime('yyyy-mm-dd hh:mm:ss',Now);
end;

function TSMSThread.GetCommandQueueCount: Integer;
begin
  Result:=FSMSCommandQueue.Count;
end;

function TSMSThread.GetMSG(ReceiveMSG:String;var PhoneNO,MsgContent:String;var
        MSGDateTime:string): Integer;
var
  P: PChar;
  TempStr: string;
  Len: Integer;
begin
  p:=StrScan(PChar(ReceiveMSG),',');
  if p<>Nil then
  begin
    p:=StrScan(p,#10)+1;
    Len:=StrScan(p,#13)-p;
    TempStr:=p;
    TempStr:=Copy(TempStr,1,Len);
  
    Case MyDisposeReadPDU(TempStr,PhoneNO,MsgContent,MSGDateTime) of
  //    Case DisposeReadPDU(TempStr,PhoneNO,MsgContent) of
      1:Result:=1;    //'type Error');
      2:Result:=2;       //ShowMessage('Msg Length Error');
    else
      Result:=0;
    end;
  end
  else
    Result:=1;
end;

function TSMSThread.GetSendQueueCount: Integer;
begin
  try
     if Assigned(FSMSQueue) then
        Result:=FSMSQueue.Count
     else
        Result:=0;
  except
  end;
end;

procedure TSMSThread.InitSMS;
var
  AT, Str, CenterNO, TempStr: string;
  CommandResult: Boolean;
begin
  //短信服务器指令参考
  //端口监视获得
  {