下面是我使用的，没有问题，我用它开发完成了一个多端口的短信服务器，我的网站上有下载，免费使用:http://www.tinstec.com,下面给你这方面的代码：
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-1do
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-1do
begin
TempStr:=Copy(s,i*2+1,2);
TempIntArray:=HexToInt(TempStr);
end;
//j 用于移位计数
i:=0;
j:=0;
while i<=len-1do
begin
if i<>0 then
//数据变换
cur:=((TempIntArray shl j) and $7f) or (TempIntArray[i-1] shr (8-j))
else
cur:=(TempIntArray shl j) and $7f;
Result:=Result+Chr(cur);
//移位计数达到7位的特别处理
j:=(j+1) mod 7;
if j=0 then
begin
cur:=TempIntArray 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-1do
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),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<=lendo
begin
if i<len then
//数据变换
cur:=(ord(s) shr j) or ((ord(s[i+1]) shl (7-j)) and $ff)
else
cur:=(ord(s) 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<=lendo
begin
cur:=ord(s);
//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 jdo
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)do
wnto 1do
begin
if HexStr in ['0'..'9'] then
TempInt:=StrToInt(HexStr)
else
TempInt:=Ord(HexStr)-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) - 1do
// 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 <= lendo
begin
cur := ord(ws);
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-1do
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-1do
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.
