很早以前写的,程序还有点问题,使用了Apro通讯控件,借鉴了网上的一些资源.短信采用了队列管理.
通讯控件也可以使用SPComm.
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
//短信服务器指令参考
//端口监视获得
{
4 Length: 0003, Data: AT
5 Length: 0003, Data: AT
6 Length: 0007, Data: AT+CSQ
信号强度
This command is used to know the received signal strength indication (<rssi>) and the
channel bit error rate (<ber>) with or without any SIM card inserted.
7 Length: 0012, Data: AT+CNMI=1,1
wavecom只支持2,1
8 0010, Data: AT+CMGF=0
}
//初始化短信中心号码at+csca?取短信中心号码
if FSMSCenterNO<>'' then
begin
AT:='AT+CSCA="'+FSMSCenterNO+'"'+#13;
FCommandResult:=ExcuteCommand(AT,Str);
end
else
begin
AT:='AT+CSCA?'+#13;
FCommandResult:=ExcuteCommand(AT,Str);
end;
//设置短信格式为PDU
AT:='AT+CMGF=0'+#13;
FCommandResult:=ExcuteCommand(AT,Str);
//设置短信通知
AT:='AT+CNMI=2,1,0,0,0'+#13;
FCommandResult:=ExcuteCommand(AT,Str);
//读取现有短信
if FReadExistMSG then
begin
AT:='AT+CMGL=4'+#13;
FCommandResult:=ExcuteCommand(AT,Str);
end;
//如果设置为自动删除短信，则发送删除短信指令
//AT+CMGD=1,1
if FAutoDeleteMsg then
begin
AT:='AT+CMGD=1,1'+#13;
FCommandResult:=ExcuteCommand(AT,Str);//删除所有短信
end;
end;
function TSMSThread.IsOpen: Boolean;
begin
Result:=ApdCom.Open;
end;
function TSMSThread.ManageCall(CallHandle:Boolean): Boolean;
var
s: string;
begin
//接听或挂断电话
//接听
if CallHandle then
s:='ATA'+#13
else
s:='ATH'+#13;
//WriteCommDataAT(s);
PushCommand(s);
Result:=True;
//Result:=ExcuteCommand(s,r);
end;
procedure TSMSThread.ManageQueue;
var
TryCount: Integer;
CommandReturn: string;
CommandResult: Boolean;
begin
//**************************************************************************
//如果命令队列中有待发命令
//**************************************************************************
TryCount:=0;
while FSMSCommandQueue.Count>0 do
begin
PostSMSMsg('端口'+IntToStr(FCommNumber)+'队列中有命令数：'+IntToStr(FSMSCommandQueue.Count));
//取末端，即先进入队列的短信
with TSMSCommandQueue(FSMSCommandQueue.Peek) do
begin
if TryCount>=FTryNumber then //超过了重试次数
begin
TSMSCommandQueue(FSMSCommandQueue.Pop).Free; //释放对象
TryCount:=0;
end
else
begin
//命令执行成功或错误
FCommandResult:=ExcuteCommand(ATCommand,CommandReturn);
if FCommandResult>0 then
begin
TSMSCommandQueue(FSMSCommandQueue.Pop).Free; //释放对象
TryCount:=0;//计数复位
end
else
Inc(TryCount); //计数加1
end;
end;
end;
//**************************************************************************
//**************************************************************************
//如果发送短信队列中有待发短信
//**************************************************************************
TryCount:=0;
while FSMSQueue.Count>0 do
begin
PostSMSMsg('端口'+IntToStr(FCommNumber)+'队列中有短信数：'+IntToStr(FSMSQueue.Count));
//取末端，即先进入队列的短信
with TSMSQueue(FSMSQueue.Peek) do
begin
if TryCount>=FTryNumber then //超过了重试次数
begin
//执行失败,引发发送短信事件
if Assigned(FOnSMSSend) then
FOnSMSSend(ID,PhoneNO,Content,formatdatetime('yyyy-mm-dd hh:mm:ss',Date),IntToStr(FCommNumber),False);
TSMSQueue(FSMSQueue.pop).Free; //释放对象
TryCount:=0;
end
else
begin
if SendSMS(PhoneNO,Content) then
begin
with TSMSQueue(FSMSQueue.pop) do
begin
//触发发送短信成功事件
if Assigned(FOnSMSSend) then
FOnSMSSend(ID,PhoneNO,Content,formatdatetime('yyyy-mm-dd hh:mm:ss',Date),IntToStr(FCommNumber),True);
Free; //释放对象
end;
TryCount:=0; //计数复位
//延时
Sleep(FSMSDelay*1000);
end
else
Inc(TryCount);//计数加1
end;
end;
end;
//**************************************************************************
end;
procedure TSMSThread.ManagerListMsg(Str:String);
var
P, P2: PChar;
Msg, TempStr, PhoneNO, MsgContent, MSGDateTime: string;
Len: Integer;
begin
//没有返回短信
if Pos('+CMGL:',Str)<=0 then exit;
p:=PChar(Str);
p:=StrScan(p,#10)+1; //去掉AT+CMGL=4一行
while p<>Nil do
begin
p:=StrScan(p,#10)+1; //第一个换行
TempStr:=p; //转换为String
Len:=StrScan(p,#10)-p; //第二个换行
TempStr:=p;
//结束退出
if Len<10 then break; //????
Msg:=Copy(TempStr,1,Len);
if MyDisposeReadPDU(TempStr,PhoneNO,MsgContent,MSGDateTime)=0 then
if Assigned(FOnSMSNewMsgEvent) then
FOnSMSNewMsgEvent(PhoneNO,MsgContent,IntToStr(FCommNumber),StrToDateTime(MSGDateTime));
p:=StrScan(p,#10)+1; //下一个换行,移到以+CMGL:开头
end;
//如果设置为自动删除短信，则发送删除短信指令
//AT+CMGD=1,1
if FAutoDeleteMsg then PushCommand('AT+CMGD=1,1'+#13); //删除所有短信
end;
procedure TSMSThread.OpenComm;
begin
ApdCom.Open:=True;
Sleep(500);
end;
procedure TSMSThread.PostSMSMsg(Msg: shortstring);
var
Msg1Str: PShortString;
begin
New(Msg1Str);
Msg1Str^ := Msg;
PostMessage(MsgHandle, MsgSMS, Integer(Msg1Str), 0);
end;
procedure TSMSThread.PushCommand(AT:String);
var
NewCommand: TSMSCommandQueue;
begin
//建立新的短信，并将其压入短信队列
NewCommand:=TSMSCommandQueue.create;
with NewCommand do
begin
ATCommand:=AT;
end;
//入队
FSMSCommandQueue.push(NewCommand);
end;
procedure TSMSThread.PushSMS(SMSID:Integer;SMSPhoneNO,SMSMsg:String;
SMSSendTime:TDatetime);
var
NewSMS: TSMSQueue;
begin
//建立新的短信，并将其压入短信队列
NewSMS:=TSMSQueue.create;
with NewSMS do
begin
ID:=SMSID;
PhoneNO:=SMSPhoneNO;
Content:=SMSMsg;
SendTime:=SMSSendTime;
InTime:=Time;
end;
//入队
FSMSQueue.push(NewSMS);
end;
procedure TSMSThread.PutString(AT:String);
begin
CurrentCommand:=AT;
ApdCom.PutString(AT);
end;
procedure TSMSThread.ReadSMS(ID:Integer);
var
s: string;
begin
//读短信
s:='AT+CMGR='+inttostr(ID)+#13;
PushCommand(s);
end;
function TSMSThread.SendSMS(PhoneNO:String;Msg:String): Boolean;
var
I: Integer;
SendStr, MixMsg, Len, ReturnMsg: string;
R: Boolean;
begin
//********************************************
//发送成功返回True,失败返回False
//使用PDU单元
//*********************************************
//取编码
MixMsg:=GetPDUData(FSMSCenterNO,PhoneNO,Msg,Len);
//*********************************************
//**************************************************************************
//先发送发送短信指令，收到">"后再发送短信内容
//**************************************************************************
//发送发短信指令
SendStr:='AT+CMGS='+Len+#13;
if ExcuteCommand(SendStr,ReturnMsg)=2 then
begin
SendStr:=MixMsg+#26;
//判断是否发送成功
if ExcuteCommand(SendStr,ReturnMsg)=1 then
Result:=True
else
Result:=False;
end
else
Result:=False;
//**************************************************************************
end;
procedure TSMSThread.SetAutoOpen(AutoOpen:Boolean);
begin
ApdCom.AutoOpen:=AutoOpen;
end;
procedure TSMSThread.SetBaud(Baud:Integer);
begin
ApdCom.Baud:=Baud;
end;
procedure TSMSThread.SetComNum(Comm:Integer);
begin
FCommNumber:=Comm;
ApdCom.ComNumber:=Comm;
end;
procedure TSMSThread.TriggerAvail(CP : TObject; Count : Word);
var
I: Word;
vReceive: string;
begin
vReceive:='';
for I := 1 to Count do
vReceive:=vReceive + ApdCom.GetChar;
CurrentAnswer := CurrentAnswer + vReceive;
if Assigned(FOnReceiveData) then
FOnReceiveData(vReceive,IntToStr(FCommNumber));
end;
procedure TSMSThread.TriggerData(CP : TObject; TriggerHandle : Word);
var
SMSIndex: string;
begin
//收到回车
if TriggerHandle=FTriggerReturn then
begin
if Pos('+CMTI',CurrentAnswer)>0 then
begin
SMSIndex:=GetString(CurrentAnswer,'"SM",',' ');
CurrentAnswer:='';
//发送读取短信指令，触发收到短信事件
ReadSMS(strtoint(trim(SMSIndex)));
//如果设置为自动删除短信，则发送删除短信指令
if FAutoDeleteMsg then DeleteSMS(strtoint(trim(SMSIndex)));
end;
//*************************************************************************
//收到电话
//*************************************************************************
//TODO:增加电话控制,有重复信息
//在未处理时，反复送RING信息
if POS('RING',UpperCase(CurrentAnswer))>0 then
begin
//如果队列中有挂断电话指令，则不再处理
if not FCallState then
begin
//列出电话号码
GetCall;
//挂断电话或接听电话
//挂断电话
ManageCall(False);
FCallState:=True;
end;
end;
end;
//收到新短信
{
if TriggerHandle = FTriggerNewMsg then
begin
SMSIndex:=GetString(CurrentAnswer,'"SM",',' ');
//发送读取短信指令，触发收到短信事件
ReadSMS(strtoint(trim(SMSIndex)));
//如果设置为自动删除短信，则发送删除短信指令
if FAutoDeleteMsg then DeleteSMS(strtoint(trim(SMSIndex)));
end;
}
//发送短信命令就续
if TriggerHandle = FTriggerSendReadyMsg then
begin
FCommandResult:=2;
end;
//命令执行成功
if TriggerHandle = FTriggerOK then
begin
AnalyseReceiveData;
FCommandResult:=1;
end;
//命令执行失败
if TriggerHandle = FTriggerERROR then
begin
FCommandResult:=0;
end;
end;
end.
//基本函数
unit FSMSCommFun;
interface
uses
SysUtils;
type
TPDUFormatRec = record
CenterLen: Array[0..1] of Char;
CenterType: Array[0..1] of Char;
CenterNumber: Array[0..13] of Char;
FileHeader: Array[0..1] of Char;
SMType: Array[0..1] of Char;
CalledLen: Array[0..1] of Char;
CalledType: Array[0..1] of Char;
CalledNumber: Array[0..11] of Char;
SMCodeType: Array[0..5] of Char;
SMLen: Array[0..1] of Char;
end;
TPDUSendRec = record
SMSCLength: Array[0..1] of Char;
FirstOctet: Array[0..1] of Char;
MessageReference: Array[0..1] of Char;
PhoneLength: Array[0..1] of Char;
AddressType: Array[0..1] of Char;
Phone: Array[0..11] of Char;
TPPID: Array[0..1] of Char;
TPDCS: Array[0..1] of Char;
TPValidityPeriod: Array[0..1] of Char;
TPUserDataLength: Array[0..1] of Char;
end;
TPDUFirstReadRec = record
SMSCLength: Array[0..1] of Char;
AddressType: Array[0..1] of Char;
ServiceCenterNumber: Array[0..13] of Char;
FirstOctet: Array[0..1] of Char;
SendPhoneLength: Array[0..1] of Char;
SendPhoneType: Array[0..1] of Char;
end;
TPDUSecondReadRec = record
TPPID: Array[0..1] of Char;
TPDCS: Array[0..1] of Char;
TimeStamp: Array[0..13] of Char;
TPUserDataLength: Array[0..1] of Char;
end;
function ChangeOrder(OriStr:String;TotalLen:Integer): string;
function Decode8Bits(s:String): string;
function DecodeEnglish(s:String): string;
function DecodeUniCode(s:String): WideString;
function DisposeReadPDU(PDUData:String;Var Phone,MsgContent:String):Integer;
function Encode8Bits(s:String): string;
function EncodeEnglish(s:String): string;
function EncodeUniCode(s:WideString): string;
function GetPDUData(SMSC,DATel,SDU:String;var len:String): string;
function GetString(strSource,strStart,strEnd:String): string;
function HexToInt(HexStr:String): Integer;
function Mix2PDU(CenterNumber,CalledNumber,ShortMsg:String): string;
function MixSendPDU(Phone,ShortMsg:String;Var SendLen:String;SMType:Integer): string;
function MyDisposeReadPDU(PDUData: string; var Phone, MsgContent: string;var MSGTime: string): Integer;
function PDUFmtStr(Val:string): string;
function PDUSMSC(Tel:String;var TelLen:Byte): string;
function PDUTel(Tel:String;var TelLen:Byte): string;
function ResumeOrder(OriStr:String): string;
implementation
function ResumeOrder(OriStr:String): string;
var
i: Integer;
TempStr: string;
begin
TempStr:='';
for i:=1 to (Length(OriStr) Div 2) do
TempStr:=TempStr+OriStr[i*2]+OriStr[i*2-1];
Result:=StringReplace(TempStr,'F','',[rfReplaceAll]);
end;
function ChangeOrder(OriStr:String;TotalLen:Integer): string;
var
i: Integer;
TempStr: string;
begin
OriStr:=OriStr+Copy('FFFFFFFFFF',1,TotalLen-Length(OriStr));
TempStr:='';
for i:=1 to (TotalLen Div 2) do
TempStr:=TempStr+OriStr[i*2]+OriStr[i*2-1];
Result:=TempStr;
end;
function Decode8Bits(s:String): string;
var
i, Len: Integer;
TempStr: string;
begin
Result:='';
Len:=Length(s) Div 2;
for i:=0 to Len-1 do
begin
TempStr:=Copy(s,i*2+1,2);
Result:=Result+Chr(HexToInt(TempStr));
end;
end;
function DecodeEnglish(s:String): string;
var
i, j, len: Integer;
TempIntArray: Array of Integer;
TempStr: string;
cur, Int1: Integer;
begin
len:=Length(s) div 2;
SetLength(TempIntArray,Len);
for i:=0 to Len-1 do
begin
TempStr:=Copy(s,i*2+1,2);
TempIntArray[i]:=HexToInt(TempStr);
end;
//j 用于移位计数
i:=0;
j:=0;
while i<=len-1 do
begin
if i<>0 then
//数据变换
cur:=((TempIntArray[i] shl j) and $7f) or (TempIntArray[i-1] shr (8-j))
else
cur:=(TempIntArray[i] shl j) and $7f;
Result:=Result+Chr(cur);
//移位计数达到7位的特别处理
j:=(j+1) mod 7;
if j=0 then
begin
cur:=TempIntArray[i] shr 1;
Result:=Result+Chr(cur);
end;
inc(i);
end;
end;
function DecodeUniCode(s:String): WideString;
var
p: PWord;
i, len: Integer;
cur: Integer;
TempChar: WideChar;
t: string;
begin
New(p);
Result:='';
len:=Length(s) div 4;
i:=1;
for i:=0 to Len-1 do
begin
t:=Copy(s,4*i+1,4);
p^:=HexToInt(t);
Move(p^,TempChar,2);
Result:=Result+TempChar;
end;
Dispose(p);
end;
function DisposeReadPDU(PDUData:String;Var Phone,
MsgContent:String): Integer;
var
TempInt, Len: Integer;
FirstReadRec: TPDUFirstReadRec;
SecondReadRec: TPDUSecondReadRec;
TempStr: string;
begin
//First Read Record
Move(PDUData[1],FirstReadRec,SizeOf(FirstReadRec));
TempInt:=HexToInt(FirstReadRec.SendPhoneLength);
if (TempInt mod 2 = 1) then
Inc(TempInt);
//Phone
Phone:=Copy(PDUData,SizeOf(FirstReadRec)+1,TempInt);
Phone:=ResumeOrder(Phone);
//Second Read Record
Move(PDUData[SizeOf(FirstReadRec)+TempInt+1],SecondReadRec,SizeOf(SecondReadRec));
//Message Length
Len:=HexToInt(SecondReadRec.TPUserDataLength)*2;
//Short Message Content
TempStr:=Copy(PDUData,SizeOf(FirstReadRec)+TempInt+SizeOf(SecondReadRec)+1,Len);
Case HexToInt(SecondReadRec.TPDCS) of
0..3://7 Bits
begin
MsgContent:=DecodeEnglish(TempStr);
end;
4..7://8 Bits
begin
MsgContent:=Decode8Bits(TempStr);
end;
8..11://UniCode
begin
MsgContent:=DecodeUniCode(TempStr);
end;
else
begin
Result:=1; //type Error
Exit;
end;
end;
end;
function Encode8Bits(s:String): string;
var
i: Integer;
begin
Result:='';
for i:=1 to Length(s) do
Result:=Result+IntToHex(Ord(s[i]),2);
end;
function EncodeEnglish(s:String): string;
var
i, j, len: Integer;
cur, Int1: Integer;
begin
len:=Length(s);
//j 用于移位计数
i:=1;
j:=0;
while i<=len do
begin
if i<len then
//数据变换
cur:=(ord(s[i]) shr j) or ((ord(s[i+1]) shl (7-j)) and $ff)
else
cur:=(ord(s[i]) shr j) and $7f;
Result:=Result+IntToHex(cur,2);
inc(i);
//移位计数达到7位的特别处理
j:=(j+1) mod 7;
if j=0 then inc(i);
end;
end;
function EncodeUniCode(s:WideString): string;
var
i, len: Integer;
cur: Integer;
t: string;
begin
Result:='';
len:=Length(s);
i:=1;
while i<=len do
begin
cur:=ord(s[i]);
//BCD转换
//FmtStr(t,'%4.4X',[cur]);
Result:=Result+IntToHex(Cur,4);
inc(i);
end;
end;
function GetPDUData(SMSC,DATel,SDU:String;var len:String): string;
var
i: Byte;
Data: string;
SMSC_Len, DATel_Len: Byte;
begin
SMSC:=PDUSMSC(SMSC,SMSC_Len);
DATel:=PDUTel('86'+DATel,DATel_Len);
SDU:=PDUFmtStr(SDU);
i:=Length(SDU) div 2;
Data:='';
Data:=Data+'3100';
Data:=Data+DATel;
Data:=Data+'00';
Data:=Data+'08';
Data:=Data+'A7';
Data:=Data+IntToHex(i,2);
Data:=Data+SDU;
len:=IntToStr(2+DATel_Len+4+i);
Result:=SMSC+Data;
end;
function GetString(strSource,strStart,strEnd:String): string;
var
i, j, m: Integer;
s: string;
begin
i:=Pos(strStart,strSource)+length(strStart);
s:='';
for m:=i to j do
if strSource[m] in [' ','0','1','2','3','4','5','6','7','8','9'] then
s:=s+copy(strSource,m,1)
else
break;
result:=s;
end;
function HexToInt(HexStr:String): Integer;
var
i, TempInt, LocalInt: Integer;
begin
HexStr:=UpperCase(HexStr);
LocalInt:=1;
Result:=0;
for i:=Length(HexStr) downto 1 do
begin
if HexStr[i] in ['0'..'9'] then
TempInt:=StrToInt(HexStr[i])
else
TempInt:=Ord(HexStr[i])-Ord('A')+10;
if i=Length(HexStr) then
LocalInt:=1
else
LocalInt:=LocalInt*16;
Result:=Result+TempInt*LocalInt;
end;
end;
function Mix2PDU(CenterNumber,CalledNumber,ShortMsg:String): string;
var
TempStr, MsgContent: string;
PDURec: TPDUFormatRec;
begin
PDURec.CenterLen := '08';
PDURec.CenterType := '91';
TempStr := ChangeOrder(CenterNumber,14);
Move(TempStr[1],PDURec.CenterNumber[0],14);
PDURec.FileHeader := '11';
PDURec.SMType := '00';
PDURec.CalledLen := '0B';
PDURec.CalledType := '81';
TempStr := ChangeOrder(CalledNumber,12);
Move(TempStr[1],PDURec.CalledNumber[0],12);
PDURec.SMCodeType := '0000A7';
MsgContent := EnCodeUniCode(ShortMsg);
Move(IntToHex(Length(ShortMsg),2)[1],PDURec.SMLen[0],2);
SetLength(Result,SizeOf(PDURec));
Move(PDURec,Result[1],SizeOf(PDURec));
Result:=Result+MsgContent;
end;
function MixSendPDU(Phone,ShortMsg:String;Var SendLen:String;
SMType:Integer): string;
var
PDUSendRec: TPDUSendRec;
TempStr: string;
begin
PDUSendRec.SMSCLength := '00';
PDUSendRec.FirstOctet := '11';
PDUSendRec.MessageReference := '00';
PDUSendRec.PhoneLength := '0B';
PDUSendRec.AddressType := '91';
TempStr:=ChangeOrder(Phone,12);
Move(TempStr[1],PDUSendRec.Phone[0],12);
PDUSendRec.TPPID := '00';
Case SMType of
0://Englsih
PDUSendRec.TPDCS := '00';
4://8Bits
PDUSendRec.TPDCS := '04';
else //Chinese
PDUSendRec.TPDCS := '08';
end;
PDUSendRec.TPValidityPeriod := 'AA';
Case SMType of
0://Englsih
begin
Move(IntToHex(Length(ShortMsg),2)[1],PDUSendRec.TPUserDataLength[0],2);
SetLength(Result,SizeOf(PDUSendRec));
Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
Result:=Result+EncodeEnglish(ShorTMsg);
SendLen:=IntToStr((Length(Result)-2) Div 2);
end;
4://8Bits
begin
Move(IntToHex(Length(ShortMsg),2)[1],PDUSendRec.TPUserDataLength[0],2);
SetLength(Result,SizeOf(PDUSendRec));
Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
Result:=Result+Encode8Bits(ShorTMsg);
SendLen:=IntToStr((Length(Result)-2) Div 2);
end;
else //Chinese
begin
TempStr:=EnCodeUniCode(ShortMsg);
Move(IntToHex(Length(TempStr) Div 2,2)[1],PDUSendRec.TPUserDataLength[0],2);
SetLength(Result,SizeOf(PDUSendRec));
Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
Result:=Result+TempStr;
SendLen:=IntToStr((Length(Result)-2) Div 2);
end;
end;
end;
function MyDisposeReadPDU(PDUData: string; var Phone, MsgContent:
string; var MSGTime: string): Integer;
function ReverseStr(s: string): string;
var
i: Integer;
ts: string;
begin
for I := 0 to length(s) - 1 do // Iterate
begin
ts := ts + copy(s, length(s) - i, 1);
end; // for
Result := ts;
end;
var
TempInt, Len: Integer;
FirstReadRec: TPDUFirstReadRec;
SecondReadRec: TPDUSecondReadRec;
TempStr, TmpDate: string;
begin
//First Read Record
Move(PDUData[1], FirstReadRec, SizeOf(FirstReadRec));
TempInt := HexToInt(FirstReadRec.SendPhoneLength);
if (TempInt mod 2 = 1) then
Inc(TempInt);
//Phone
Phone := Copy(PDUData, SizeOf(FirstReadRec) + 1, TempInt);
Phone := ResumeOrder(Phone);
//去掉开头
if copy(phone,1,2)='86' then phone:=copy(phone,3,length(phone)-2);
//Second Read Record
Move(PDUData[SizeOf(FirstReadRec) + TempInt + 1], SecondReadRec,
SizeOf(SecondReadRec));
TmpDate := SecondReadRec.TimeStamp;
(*00017251643323 = SCTS Service Center Time Stamp
2000/10/27 15:46:33 23为时区信息
*)
if Trim(TmpDate)<>'' then
TmpDate := '20' + ReverseStr(copy(TmpDate, 1, 2)) + '-' +
ReverseStr(copy(TmpDate, 3, 2)) + '-' + ReverseStr(copy(TmpDate, 5, 2))
//年月日
+ ' ' + ReverseStr(copy(TmpDate, 7, 2)) + ':' + ReverseStr(copy(TmpDate, 9, 2))
+ ':' + ReverseStr(copy(TmpDate, 11, 2))
else
TmpDate:=formatdatetime('yyyy-mm-dd hh:mm:ss',now);
TmpDate:=formatdatetime('yyyy-mm-dd hh:mm:ss',now);
//MSGTime := strtodatetime(TmpDate);
MSGTime := TmpDate;
//Message Length
Len := HexToInt(SecondReadRec.TPUserDataLength) * 2;
//Short Message Content
TempStr := Copy(PDUData, SizeOf(FirstReadRec) + TempInt + SizeOf(SecondReadRec)
+ 1, Len);
case HexToInt(SecondReadRec.TPDCS) of
0..3: //7 Bits
begin
MsgContent := DecodeEnglish(TempStr);
end;
4..7: //8 Bits
begin
MsgContent := Decode8Bits(TempStr);
end;
8..11: //UniCode
begin
MsgContent := DecodeUniCode(TempStr);
end;
else
begin
Result := 1; //type Error
Exit;
end;
end;
end;
function PDUFmtStr(Val:string): string;
var
i, j, len: Integer;
cur: Integer;
t: string;
ws: WideString;
begin
Result:='';
ws := Val;
len := Length(ws);
i := 1;
j := 0;
while i <= len do
begin
cur := ord(ws[i]);
FmtStr(t,'%4.4X',[cur]);
Result := Result+t;
inc(i);
j := (j+1) mod 7;
end;
end;
function PDUSMSC(Tel:String;var TelLen:Byte): string;
var
i, j: Integer;
str: string;
s1, s2: string;
begin
try
str:='';
TelLen:= Length(Tel);
if (Length(Tel) div 2)<>0 then
Tel:=Tel+'F';
j:=Length(Tel) div 2;
for i:=0 to j-1 do
begin
s1:=Tel[2];
s2:=Tel[1];
delete(Tel,1,2);
str:=str+s1+s2;
end;
j:=Length(Str) div 2+1;
str:=inttohex(j,2)+'91'+str;
TelLen:=j+1;
Result:=str;
except
result:='';
end;
end;
function PDUTel(Tel:String;var TelLen:Byte): string;
var
i, j: Integer;
str: string;
s1, s2: string;
begin
try
str:='';
TelLen:= Length(Tel);
if (Length(Tel) div 2)<>0 then
Tel:=Tel+'F';
j:=Length(Tel) div 2;
for i:=0 to j-1 do
begin
s1:=Tel[2];
s2:=Tel[1];
delete(Tel,1,2);
str:=str+s1+s2;
end;
str:=inttohex(TelLen,2)+'91'+str;
TelLen:=j+2;
Result:=str;
except
result:='';
end;
end;
end.
