fsmscommfun.pas

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

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.