轉自：
http://blog.csdn.net/masterjames/archive/2009/07/16/4354013.aspx
=====================================
DELPHI發送超長短信的類（一）
unit imSMSUtils;
{*******************************************************
masterjames
*******************************************************}
interface
uses
Math,Classes,SysUtils;
type
TimSMSUtils = class
private
FSigalHead : string;
function SetSigal(x, y: integer): string;
public
constructor Create;
function StrToUCS2(vInput:WideString): WideString;
function USC2ToStr(vInput:WideString): WideString;
function GetMobilePDU(vStr:string) : string;
function GetMsgLenPDU(vMsg:string) : string; overload;
function GetMsgLenPDU(vLen:integer) : string; overload;
function GetSMSHeadPDU(vTotal,vCurr: integer) : string;
function GetATCMGSLen(vPDU:string): integer;
end;
implementation
function TimSMSUtils.StrToUCS2(vInput:WideString): WideString;
var
i: Integer;
begin
Result := '';
for i := 1 to Length(vInput) do
Result := Result + Format('%4.4X',[ord(vInput[i])]);
end;
function TimSMSUtils.GetMobilePDU(vStr:string) : string;
var
TempPchar : Pchar;
i : integer;
Str : string;
begin
if(Copy(vStr,1,1)='+')then vStr := Copy(vStr,2,Length(vStr)-1); //去掉手機號碼中的’+’
if((Length(vStr) mod 2)=1) then vStr := vStr + 'F';
TempPchar := Pchar(vStr);
i := 0;
Str := '';
while i < Length(TempPchar) do begin
Str := Str + TempPchar[i+1] + TempPchar[i];
i := i + 2;
end;
Result := Str;
end;
function TimSMSUtils.GetMsgLenPDU(vMsg:string): string;
var
Tmp : integer;
Str : string;
begin
Tmp:= Length(StrToUCS2(vMsg)) div 2;
Str := format('%X',[tmp]);
if Length(Str) < 2 then Str:= '0' + Str;
Result := Str;
end;
function TimSMSUtils.GetMsgLenPDU(vLen: integer): string;
var
Str : string;
begin
vLen := vLen *2;
Str := format('%X',[vLen]);
if Length(Str) < 2 then Str:= '0' + Str;
Result := Str;
end;
function TimSMSUtils.GetSMSHeadPDU(vTotal,vCurr: integer): string;
begin
Result := '0500030'+FSigalHead+IntToStr(vTotal)+ '0'+IntToStr(vCurr+1);
end;
function TimSMSUtils.SetSigal(x, y: integer): string;
const
BitA : array[0..5] of string =('A','B','C','D','E','F');
var
z,BitB : integer;
vStrA,vStrB,vResult : string;
begin
x := random(10);
y := random(10);
z := random(10);
asm
MOV EAX,x
MOV ECX,y
ADD EAX,ECX
MOV BitB,EAX
end;
if z > 5 then z := 5 ;
vStrA := BitA[z];
case Length(IntToStr(BitB)) of
0 : vStrB := '0';
1 : vStrB := IntToStr(BitB);
2 : vStrB := '5';
end;
vResult := Trim(vStrA + vStrB);
if Length(vResult) > 2 then vResult := 'A0';
Result := vResult;
end;
function TimSMSUtils.GetATCMGSLen(vPDU:string): integer;
var
ByteCount : integer;
begin
ByteCount :=(Length(vPDU)-2) div 2;
Result := ByteCount;
end;
function TimSMSUtils.USC2ToStr(vInput: WideString): WideString;
var
vWideStr : WideString;
begin
Result := vWideStr;
end;
constructor TimSMSUtils.Create;
begin
FSigalHead := SetSigal(2,5);
end;
end.
=====================================
DELPHI發送超長短信的類（二）
unit imSMS;
{*******************************************************
masterjames
*******************************************************}
interface
uses
Classes,imSMSUtils,SysUtils,StrUtils,Dialogs,AdPort,OoMisc;
const
SMS_SEND_OK = 0 ;
SMS_SEND_ERR = 1;
SMS_CENTER_CODE ='00';
SMS_MOBILE_HEAD = '0D9168';
SMS_SINGLE_LEN = 140 ;
SMS_UNICODE_LEN = 70;
SMS_UNICODE_HEADLEN = 3 ;
SMS_USER_BODYLEN = 67;
SMS_AUTO_BODYLEN = 70;
SMS_MAX_COUNT = 3;
SMS_ERR_OVERCOUNT = 0;
SMS_TYPE_USER = 1 ;
SMS_TYPE_AUTO = 2;
SMS_TIME_DELAY = 3000;
SMS_SORT_ASC = 1 ;
SMS_SORT_DESC = 2;
SMS_SET_PDU_ERR = 8001;
SMS_SEND_READY_ERR = 8002;
SMS_SEND_ERR_ERR = 8003 ;
SMS_SINGLE_THREAD = 1 ;
SMS_MUTIL_THREAD = 2;
SMS_CMD_CGMI = 0 ;
SMS_CMD_CMGF = 1;
SMS_DEL_ALL = 999999;
type
TimSMS = class
private
TSMS_PDU_HEAD : record
SMSCenter : string;
FirstOcter : string; //
TP_MR : string; //消息參考
SMSRMobile : string; //
TP_PID : string; //協議標識
TP_DCS : string; // PUD
TP_SCTS : string; //有效期間
TP_DHL : string; //數據長度
end;
FPDUStr : string;
FSMSCenter : string;
FMobile : string;
FMsgStr : string;
FSMSUtils : TimSMSUtils;
FApdComPort : TApdComport;
FPDUHeadLists : TStrings;
FPDUBodyLists : TStrings;
FCount : integer ;
FSendType : integer;
FSort : integer;
FComResult : string;
FInfo : string;
public
constructor Create;
destructor Destory;
procedure SetSend(vCenter,vMobile,vMsg : string;
vType:integer);
procedure SetPDUHead ;
procedure SetPDUBody ;
procedure EncodePDU;
procedure OnRecCom(CP: TObject; Count: Word);
procedure SetPDULists(vHeadList,vBodyList,vTotalList:TStrings);overload;
procedure SetPDULists(vTotalList:TStrings);overload;
function GetInfo : string;
function SendSMS(vThread:integer) : integer;overload;
function SendSMS(vPDUStr:string):integer;overload;
procedure DelSMS(vIndex:integer);
function ReadSMS(vNum:integer): string;
function TestComm : boolean;
procedure InitComm(vPort, vRate: integer);
published
end;
type
TimSMSInf = class
private
FTotal : TStrings;
FSMS : TimSMS;
public
constructor Create;
destructor Destory;
procedure SendSMS(vCenter,vMobile,vMsg : string;
vType:integer);
function ReadSMS(vIndex:integer) : string;
procedure DelSms(vIndex:integer);
function TestComm : boolean;
procedure InitComm(vPort, vRate: integer);
end;
implementation
{ TimSMS }
constructor TimSMS.Create;
begin
FSMSUtils := TimSMSUtils.Create;
FPDUBodyLists := TStringList.Create;
FPDUHeadLists := TStringList.Create;
FApdComPort := TApdComport.Create(nil);
FApdComPort.AutoOpen := False;
FApdComport.ComNumber := 1;
FApdComport.Baud := 9600;
FApdComport.OnTriggerAvail := OnRecCom;
end;
destructor TimSMS.Destory;
begin
FSMSUtils.Free;
FPDUBodyLists.Free;
FPDUHeadLists.Free;
FApdComport.Free;
end;
procedure TimSMS.SetPDUHead ;
var
SMS_PDU_HEAD : string;
vLen : integer;
vWideStr : WideString;
i : integer;
begin
FPDUHeadLists.Clear;
TSMS_PDU_HEAD.SMSCenter := SMS_CENTER_CODE;
case FSendType of
SMS_TYPE_USER :
begin
if FSendType = SMS_TYPE_USER then begin
if FCount > 1 then
TSMS_PDU_HEAD.FirstOcter := '51'
else
TSMS_PDU_HEAD.FirstOcter := '11';
end;
end;
SMS_TYPE_AUTO :
begin
TSMS_PDU_HEAD.FirstOcter := '11';
end;
end;
TSMS_PDU_HEAD.TP_MR := '00';
TSMS_PDU_HEAD.SMSRMobile := SMS_MOBILE_HEAD + FSMSUtils.GetMobilePDU(FMobile);
TSMS_PDU_HEAD.TP_PID := '00';
TSMS_PDU_HEAD.TP_DCS := '08';
TSMS_PDU_HEAD.TP_SCTS := 'A7';
vLen := 0;
vWideStr := FMsgStr;
for i := 1 to FCount do begin
if (i<>FCount) then begin
vLen := SMS_UNICODE_LEN;
end else begin
case FSendType of
SMS_TYPE_USER : begin
vLen := (Length(vWideStr) - (i-1)*SMS_USER_BODYLEN) + 3;
end;
SMS_TYPE_AUTO : begin
vLen := (Length(vWideStr) - (i-1)*SMS_AUTO_BODYLEN);
end;
end;
end;
TSMS_PDU_HEAD.TP_DHL := FSMSUtils.GetMsgLenPDU(vLen);
SMS_PDU_HEAD := TSMS_PDU_HEAD.SMSCenter + TSMS_PDU_HEAD.FirstOcter +
TSMS_PDU_HEAD.TP_MR + TSMS_PDU_HEAD.SMSRMobile +
TSMS_PDU_HEAD.TP_PID + TSMS_PDU_HEAD.TP_DCS +
TSMS_PDU_HEAD.TP_SCTS + TSMS_PDU_HEAD.TP_DHL ;
FPDUHeadLists.Add(SMS_PDU_HEAD);
end;
end;
procedure TimSMS.SetPDUBody ;
var
Str : string;
i: integer;
vList : TStrings;
vWideStr : WideString;
vWideLen : integer;
begin
FPDUBodyLists.Clear;
vList := TStringList.Create;
vWideStr := FMsgStr ;
if FCount > SMS_MAX_COUNT then Exit;
vWideLen := Length(vWideStr);
case FSendType of
SMS_TYPE_USER :
begin
for i := 0 to FCount - 1 do begin
if(i<>FCount - 1) then begin
Str := Copy(vWideStr,i*(SMS_USER_BODYLEN)+1,SMS_USER_BODYLEN);
end else begin
Str := Copy(vWideStr,i*(SMS_USER_BODYLEN)+1,vWideLen-i*(SMS_USER_BODYLEN));
end;
vList.Add(Str);
end;
for i :=0 to vList.Count -1 do begin
if FCount = 1 then begin
FPDUBodyLists.Add(FSMSUtils.StrToUCS2(vList[i]));
end else begin
FPDUBodyLists.Add(FSMSUtils.GetSMSHeadPDU(FCount,i)+
FSMSUtils.StrToUCS2(vList[i]));
end;
end;
end;
SMS_TYPE_AUTO :
begin
for i := 0 to FCount - 1 do begin
if(i<>FCount - 1) then begin
Str := Copy(vWideStr,i*(SMS_AUTO_BODYLEN)+1,SMS_AUTO_BODYLEN);
end else begin
Str := Copy(vWideStr,i*(SMS_AUTO_BODYLEN)+1,vWideLen-i*(SMS_AUTO_BODYLEN));
end;
vList.Add(Str);
end;
for i :=0 to vList.Count -1 do FPDUBodyLists.Add(FSMSUtils.StrToUCS2(vList[i]));
end;//
end;//END CASE
vList.Free;
end;
procedure TimSMS.SetSend(vCenter, vMobile, vMsg: string; vType: integer);
begin
FSMSCenter := vCenter ;
FMobile := vMobile;
FMsgStr := Trim(vMsg);
FSendType := vType;
if FSendType = SMS_TYPE_AUTO then begin
FCount := Length(FMsgStr) div SMS_SINGLE_LEN;
Inc(FCount);
end else begin
FCount := Length(FMsgStr) div SMS_USER_BODYLEN;
if FCount = 0 then FCount := 1;
FSort := SMS_SORT_ASC;
end;
if FCount = 1 then FSendType := 2;
EncodePDU;
end;
function TimSMS.SendSMS(vThread:integer): integer;
var
i : integer;
vPDUStr,vStrLen : string ;
begin
if vThread = SMS_SINGLE_THREAD then begin
for i :=0 to FPDUHeadLists.Count - 1 do begin
vPDUStr := FPDUHeadLists[i] + FPDUBodyLists[i] ;
try
FApdComPort.Open := True;
FApdComPort.Output := 'AT+CMGF=0'#13;
DelayTicks(7,True);
vStrLen := IntToStr(FSMSUtils.GetATCMGSLen(vPDUStr));
FApdComPort.Output := 'AT+CMGS='+vStrLen+#13;
DelayTicks(7,True);
FApdComPort.Output := vPDUStr+^Z;
DelayTicks(9,True);
FApdComPort.Open := False;
Sleep(SMS_TIME_DELAY);
finally
FApdComPort.Open := False;
end;
end;
end;
if vThread = SMS_MUTIL_THREAD then begin
end;
Result := SMS_SEND_OK;
end;
function TimSMS.SendSMS(vPDUStr: string): integer;
var
vStrLen : string ;
begin
FPDUStr := vPDUStr;
try
FApdComPort.Open := True;
FApdComPort.Output := 'AT+CMGF=0'#13;
DelayTicks(7,True);
vStrLen := IntToStr(FSMSUtils.GetATCMGSLen(vPDUStr));
FApdComPort.Output := 'AT+CMGS='+vStrLen+#13;
DelayTicks(7,True);
FApdComPort.Output := vPDUStr+^Z;
DelayTicks(9,True);
FApdComPort.Open := False;
Sleep(SMS_TIME_DELAY);
finally
FApdComPort.Open := False;
end;
Result := SMS_SEND_OK;
end;
procedure TimSMS.SetPDULists(vHeadList, vBodyList, vTotalList: TStrings);
var
vList : TStrings;
i : integer;
begin
vList := TStringList.Create;
if vHeadList<>nil then vHeadList.AddStrings(FPDUHeadLists);
if vBodyList<>nil then vBodyList.AddStrings(FPDUBodyLists);
for i := 0 to FPDUHeadLists.Count - 1 do vList.Add(FPDUHeadLists[i]+FPDUBodyLists[i]);
vTotalList.AddStrings(vList);
vList.Free;
end;
procedure TimSMS.SetPDULists(vTotalList: TStrings);
var
vList : TStrings;
i : integer;
begin
vList := TStringList.Create;
for i := 0 to FPDUHeadLists.Count - 1 do vList.Add(FPDUHeadLists[i]+FPDUBodyLists[i]);
vTotalList.AddStrings(vList);
vList.Free;
end;
procedure TimSMS.EncodePDU;
begin
SetPDUHead;
SetPDUBody;
end;
function TimSMS.GetInfo: string;
begin
Result := FInfo;
end;
function TimSMS.ReadSMS(vNum: integer): string;
begin
try
FApdComPort.Open := True;
FApdComPort.Output := 'AT+CMGR=1'#13;
DelayTicks(7,True);
finally
FApdComPort.Open := False;
end;
end;
procedure TimSMS.DelSMS(vIndex: integer);
begin
if vIndex = SMS_DEL_ALL then begin
try
FApdComPort.Open := True;
FApdComPort.Output := 'AT+CMGD=1,3'+#13;
DelayTicks(7,True);
finally
FApdComPort.Open := False;
end;
end else begin
try
FApdComPort.Open := True;
FApdComPort.Output := 'AT+CMGD='+IntToStr(vIndex)+#13;
DelayTicks(7,True);
finally
FApdComPort.Open := False;
end;
end;
end;
procedure TimSMS.OnRecCom(CP: TObject; Count: Word);
var
i : Word;
Str: string;
begin
for i := 1 to Count do Str := Str + FApdComPort.GetChar;
FComResult := UpperCase(Str);
end;
function TimSMS.TestComm: boolean;
var
vResult : boolean;
begin
try
try
FApdComPort.Open := True;
//FApdComPort.Output := 'AT'#13;
vResult := True;
except
vResult := False;
end;
finally
FApdComPort.Open := False;
end;
Result := vResult ;
end;
procedure TimSMS.InitComm(vPort,vRate:integer);
begin
FApdComPort.ComNumber := vPort ;
FApdComPort.Baud := vRate;
end;
{ TimSMSInf }
constructor TimSMSInf.Create;
begin
FSMS := TimSMS.Create;
FTotal := TStringList.Create;
end;
procedure TimSMSInf.DelSms(vIndex: integer);
begin
FSMS.DelSMS(vIndex);
end;
destructor TimSMSInf.Destory;
begin
FTotal.Free;
FSMS.Free;
end;
procedure TimSMSInf.InitComm(vPort, vRate: integer);
begin
FSms.InitComm(vPort,vRate);
end;
function TimSMSInf.ReadSMS(vIndex: integer): string;
begin
FSMS.ReadSMS(vIndex);
end;
procedure TimSMSInf.SendSMS(vCenter, vMobile, vMsg: string;
vType: integer);
var
i : integer;
begin
FSMS.SetSend(vCenter, vMobile, vMsg, vType);
FSMS.SetPDULists(FTotal);
for i := 0 to FTotal.Count - 1 do FSMS.SendSMS(FTotal[i]);
end;
function TimSMSInf.TestComm: boolean;
begin
Result := FSMS.TestComm;
end;
end.