DELPHI发送超长短信的类_apdcomport-CSDN博客

转自：

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;