SMS编程代码

来源：互联网发布：字符串指针数组编辑：程序博客网时间：2024/05/03 22:59

SMS编程代码

码：没有写完收信的部分，需要CPORT控件这个单元是PDU编码的单元，主要不是我写的，是别人写的，有点问题，我完善了一下。肯定能用。花了我好多短消息费用的！：）
unit PhoneShare;

interface

uses
SysUtils,Math;

type
TPDUFormatRec = Record
    CenterLen:Array[0..1] of Char;                 //短信息中心地址长度
    CenterType:Array[0..1] of Char;                //短信息中心号码类型，91是TON/NPI
    CenterNumber:Array[0..13] of Char;             //所在地GSM短信息中心的号码
    FileHeader:Array[0..1] of Char;                //指正常地发送短信息
    SMType:Array[0..1] of Char;                    //信息类型
    PhoneLength:Array[0..1] of Char;               //被叫号码长度
    AddressType:Array[0..1] of Char;               //被叫号码类型
    CalledNumber:Array[0..13] of Char;             //被叫号码
    TPPID:Array[0..1] of Char;                     //PID
    TPDCS:Array[0..1] of Char;                     //短信息编码类型：08=U 00=b7 15=b8
    TPValidityPeriod:Array[0..1] of Char;          //有效期
    SMLen:Array[0..1] of Char;                     //短信息长度
end;

TPDUSendRec = Record
    SMSCLength:Array[0..1] of Char;                //短信息中心地址长度忽略为00
    FirstOctet:Array[0..1] of Char;                //FO
    MessageReference:Array[0..1] of Char;          //TP-MR
    PhoneLength:Array[0..1] of Char;               //被叫号码长度
    AddressType:Array[0..1] of Char;               //被叫号码类型
    Phone:Array[0..13] of Char;                    //被叫号码？？？
    TPPID:Array[0..1] of Char;                     //PID
    TPDCS:Array[0..1] of Char;                     //=SMCodeType
    TPValidityPeriod:Array[0..1] of Char;          //有效期
    SMLen:Array[0..1] of Char;
    //TPUserData
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;

TSMType=(stBit7,stBit8,stUniCode);

function HexToInt(HexStr:String):Integer;
function ChangeOrder(OriStr:String;TotalLen:Integer):String;
function ResumeOrder(OriStr:String):String;

function EncodeEnglish(s:String):String;
function DecodeEnglish(s:String):String;

function Encode8Bits(s:String):String;
function Decode8Bits(s:String):String;

function EncodeUniCode(s:WideString):String;
function DecodeUniCode(s:String):WideString;

function DecodeTime(s:String):string;

Function Mix2PDU(CenterNumber,CalledNumber,ShortMsg:String;var Len:integer):String;
function MixSendPDU(Phone,ShortMsg:String;SMType:TSMType;var Len:integer):String;
function DisposeReadPDU(PDUData:String;Var Phone,MsgContent,SendTime:String):Integer;

implementation

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 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 Mix2PDU(CenterNumber,CalledNumber,ShortMsg:String;var Len:integer):String;
var
TempStr,MsgContent:String;
PDURec:TPDUFormatRec;
HeadLen:integer;
begin
PDURec.CenterLen := '08';
PDURec.CenterType := '91';
TempStr := ChangeOrder(CenterNumber,14);
Move(TempStr[1],PDURec.CenterNumber[0],14);
HeadLen:=2+Length(TempStr) div 2;

PDURec.FileHeader := '31';
PDURec.SMType := '00';
PDURec.PhoneLength := '0D';
PDURec.AddressType := '91';

TempStr := ChangeOrder(CalledNumber,14);
Move(TempStr[1],PDURec.CalledNumber[0],14);

PDURec.TPPID:='00';
PDURec.TPValidityPeriod := 'A7';

PDURec.TPDCS:='08';
MsgContent := EnCodeUniCode(ShortMsg);
Move(IntToHex(Length(MsgContent) div 2,2)[1],PDURec.SMLen[0],2);

SetLength(Result,SizeOf(PDURec));
Move(PDURec,Result[1],SizeOf(PDURec));
Result:=Result+MsgContent;
Len:=Length(Result) div 2;
Len:=Len-HeadLen;
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]);
    Result:=Result+IntToHex(Cur,4);
    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;

//wk_knife修改
function MixSendPDU(Phone,ShortMsg:String;SMType:TSMType;var Len:integer):String;
var
PDUSendRec:TPDUSendRec;
TempStr:String;
begin
PDUSendRec.SMSCLength := '00';
PDUSendRec.FirstOctet := '11';
PDUSendRec.MessageReference := '00';
PDUSendRec.PhoneLength := '0D';
PDUSendRec.AddressType := '91';

TempStr:=ChangeOrder(Phone,14);
Move(TempStr[1],PDUSendRec.Phone[0],14);

PDUSendRec.TPPID := '00';

Case SMType of
    stBit7://Englsih
      PDUSendRec.TPDCS := '00';
    stBit8://8Bits
      PDUSendRec.TPDCS := '04';
    else //Chinese
      PDUSendRec.TPDCS := '08';
end;

PDUSendRec.TPValidityPeriod := 'AA';

Case SMType of
    stBit7://Englsih
    begin
      Move(IntToHex(Length(ShortMsg),2)[1],PDUSendRec.SMLen[0],2);
      SetLength(Result,SizeOf(PDUSendRec));
      Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
      Result:=Result+EncodeEnglish(ShorTMsg);
      Len:=(Length(Result)-2) Div 2;
    end;

    stBit8://8Bits
    begin
      Move(IntToHex(Length(ShortMsg),2)[1],PDUSendRec.SMLen[0],2);
      SetLength(Result,SizeOf(PDUSendRec));
      Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
      Result:=Result+Encode8Bits(ShorTMsg);
      Len:=(Length(Result)-2) Div 2;
    end;

    else //Chinese
    begin
      TempStr:=EnCodeUniCode(ShortMsg);

      Move(IntToHex(Length(TempStr) Div 2,2)[1],PDUSendRec.SMLen[0],2);
      SetLength(Result,SizeOf(PDUSendRec));
      Move(PDUSendRec,Result[1],SizeOf(PDUSendRec));
      Result:=Result+TempStr;
      Len:=(Length(Result)-2) Div 2;
    end;
end;
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 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 DisposeReadPDU(PDUData:String;Var Phone,MsgContent,SendTime:String):Integer;//wk_knife修改
var
TempInt,Len:Integer;
FirstReadRec:TPDUFirstReadRec;
SecondReadRec:TPDUSecondReadRec;
TempStr:String;
begin
Move(PDUData[1],FirstReadRec,SizeOf(FirstReadRec));
TempInt:=HexToInt(FirstReadRec.SendPhoneLength);
if (TempInt mod 2 = 1) then
    Inc(TempInt);

Phone:=Copy(PDUData,SizeOf(FirstReadRec)+1,TempInt);
Phone:=ResumeOrder(Phone);

Move(PDUData[SizeOf(FirstReadRec)+TempInt+1],SecondReadRec,SizeOf(SecondReadRec));

Len:=HexToInt(SecondReadRec.TPUserDataLength)*2;

SendTime:=SecondReadRec.TimeStamp;
SendTime:=DecodeTime(SendTime);
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 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 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 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;
//wk_knife添加
function DecodeTime(s:String):string;
begin
Result:=ResumeOrder(s);
Result:=s[2]+s[1]+'-'+s[4]+s[3]+'-'+s[6]+s[5]+' '+
          s[8]+s[7]+'-'+s[10]+s[9]+'-'+s[12]+s[11]+' '+
          'GSM'+'+'+IntTostr(strToInt(s[14]+s[13])*15 div 60);
end;

end.

2006-4-18 15:14:00    这个单元是我写的，希望继续完善。完善了发我一份，我不用来挣钱的，工作中用！没有写收信部分

unit PhoneControl;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, CPort,Forms, SMSList, ExtCtrls, Dialogs;

type
TReadATValueNotifyEvent=procedure (Sender:TObject;Value:string) of Object;
TGetNewSMSNotifyEvent=procedure(Sender:TObject;ASMSInfo:TSMSInfo) of object;

TPhoneControl = class(TComponent)
private
    FGetNewSMS: TGetNewSMSNotifyEvent;
    FGetValue: TReadATValueNotifyEvent;
    FQuerySignalInteval: integer;
    FSignal: integer;
    FUseRxCharEvent: boolean;
    function AnswerAt:Boolean; //测试AT命令是否可以通过
    function AnswerCSQ(MSG: string):Integer;    //得到信号强度被GETCSQ和GETCSQA调用
    function AskReadMsg(Index: integer): TSMSInfo; //通过短消息索引获得短消息的内容
    function GetBaudRate: TBaudRate;
    function GetComm: string;
    function GetCSQ: integer;   //得到信号强度的两个版本
    function GetReadInterval: integer;
    procedure SetBaudRate(const Value: TBaudRate);
    function SetCNMI(const Value: string):Boolean;   //设置短消息模式
    procedure SetComm(const Value: string);
    function SetCSMS(const Value: integer):Boolean;   //设置短消息服务
    procedure SetQuerySignalInteval(const Value: integer);
    procedure SetReadInterval(const Value: integer);
    procedure SetSignal(const Value: integer);
    procedure SetRxCharEvent(const Value: boolean);
protected
    procedure DoGetValue(Sender:TObject;Value:string);dynamic;
    procedure RXChar(Sender: TObject; Count: integer);dynamic;
public
    PortControl:TComPort; //串口控制
    constructor Create(AOwner:TComponent);override;
    destructor Destroy;override;
    procedure AskSendMsg(ASMSInfo:TSMSInfo); //发送一条短消息
    procedure CloseComm;
    procedure GetCSQA;          //通过ONRXCHAR得到值
    function GetSMSC: string;    //得到短消息中心
    function InitComm:integer;
    function OpenComm:Boolean;
    procedure ReadAllMSgInSIM;   //得到SIM中的所有短信
    property BaudRate:TBaudRate read GetBaudRate write SetBaudRate;
    property Comm:string read GetComm write SetComm;
    property OnGetNewSMS:TGetNewSMSNotifyEvent read FGetNewSMS write FGetNewSMS;
    property OnGetValue: TReadATValueNotifyEvent read FGetValue write FGetValue;
    property QuerySignalInteval:integer read FQuerySignalInteval write SetQuerySignalInteval default 120000;
    property ReadInterval:integer read GetReadInterval write SetReadInterval;
    property Signal:integer read FSignal write SetSignal;
    property UseRxCharEvent:boolean read FUseRxCharEvent write SetRxCharEvent;
end;

procedure Delay(Msecs: Cardinal);

function MatchPattern(InpStr,Pattern :PChar) :Boolean;

implementation

procedure Delay(Msecs:Cardinal);
var
BeginTime:Cardinal;
begin
BeginTime:=GetTickCount;
repeat
    Application.ProcessMessages;
until (GetTickCount-BeginTime-MSecs)<2;
end;

function MatchPattern(InpStr,Pattern :PChar) :Boolean;
begin
Result:=False;
while(True) do
begin
    case Pattern[0] of
      #0 :begin //End of pattern reached.
            Result := (InpStr[0] = #0); //TRUE if end of InpStr.
            Exit;
          end;

      '*':begin //Match zero or more occurances of any char.
            if(Pattern[1] = #0)then
            begin //Match any number of trailing chars.
              Result := True;
              Exit;
            end else Inc(Pattern);

            while(InpStr[0] <> #0)do
            begin //Try to match any substring of InpStr.
              if(MatchPattern(InpStr,Pattern))then
              begin
                Result := True;
                Exit;
              end;

              //Continue testing next char...
              Inc(InpStr);
            end;
          end;

      '?':begin //Match any one char.
            if(InpStr[0] = #0)then
            begin
              Result := False;
              Exit;
            end;

            //Continue testing next char...
            Inc(InpStr);
            Inc(Pattern);
          end;

      '[':begin //Match given set of chars.
            if(Pattern[1] in [#0,'[',']']) then
            begin //Invalid Set - So no match.
              Result := False;
              Exit;
            end;

            if(Pattern[1] = '^')then
            begin //Match for exclusion of given set...
              Inc(Pattern,2);
              Result := True;
              while(Pattern[0] <> ']')do
              begin
                if(Pattern[1] = '-')then
                begin //Match char exclusion range.
                  if(InpStr[0] >= Pattern[0])and(InpStr[0] <= Pattern[2])then
                  begin //Given char failed set exclusion range.
                    Result := False;
                    Break;
                  end else Inc(Pattern,3);
                end else
                begin //Match individual char exclusion.
                  if(InpStr[0] = Pattern[0])then
                  begin //Given char failed set element exclusion.
                    Result := False;
                    Break;
                  end else Inc(Pattern);
                end;
              end;
            end else
            begin //Match for inclusion of given set...
              Inc(Pattern);
              Result := False;
              while(Pattern[0] <> ']')do
              begin
                if(Pattern[1] = '-')then
                begin //Match char inclusion range.
                  if(InpStr[0] >= Pattern[0])and(InpStr[0] <= Pattern[2])then
                  begin //Given char matched set range inclusion. Continue testing...
                    Result := True;
                    Break;
                  end else Inc(Pattern,3);
                end else
                begin //Match individual char inclusion.
                  if(InpStr[0] = Pattern[0])then
                  begin //Given char matched set element inclusion. Continue testing...
                    Result := True;
                    Break;
                  end else Inc(Pattern);
                end;
              end;
            end;

            if(Result)then
            begin //Match was found. Continue further.
              Inc(InpStr);

              //Position Pattern to char after "]"
              while(Pattern[0] <> ']')and(Pattern[0] <> #0)do Inc(Pattern);

              if(Pattern[0] = #0)then
              begin //Invalid Pattern - missing "]"
                  Result := False;
                  Exit;
              end else Inc(Pattern);
            end else Exit;
          end;

     else begin //Match given single char.
            if(InpStr[0] <> Pattern[0])then
            begin
              Result := False;
              Break;
            end;

            //Continue testing next char...
            Inc(InpStr);
            Inc(Pattern);
          end;
    end;
end;
end;

{ TPhoneControl }

constructor TPhoneControl.Create(AOwner: TComponent);
begin
inherited;
PortControl:=TComPort.Create(self);
PortControl.FlowControl.FlowControl:=fcHardware;
PortControl.BaudRate:=br19200;
PortControl.OnRxChar:=nil;
FUseRxCharEvent:=False;
end;

destructor TPhoneControl.Destroy;
begin
PortControl.Free;
inherited;
end;

function TPhoneControl.AnswerAt: Boolean;
var
ATString:string;
begin
ATString:='AT'+#13;
PortControl.WriteStr(AtString);
//Delay(50);
PortControl.ReadStr(AtString,1024);
if Pos('OK',AtString)>0 then
    Result:=True
else
    Result:=False;
DoGetValue(self,AtString);
end;

function TPhoneControl.AnswerCSQ(MSG: string): Integer;
var
TempStr:string;
i:integer;
begin
TempStr:=MSG;
i:=Pos('+CSQ:',TempStr);
if i>0 then
    Delete(TempStr,1,i+4);
Trim(TempStr);
TempStr:=Copy(Tempstr,1,Pos(',',TempStr)-1);
Result:=StrToInt(TempStr);
end;

function TPhoneControl.AskReadMsg(Index: integer): TSMSInfo;
function StrToSMSInfo(str:string):TSMSInfo;
    var
      TempStr:string;
    begin
      Result:=nil;
      TempStr:=Str;
      if MatchPattern(PChar(TempStr),'*+CMGR:*OK') then
      begin
        Delete(TempStr,1,Pos('+CMGR:',TempStr)+5);
        Delete(TempStr,1,Pos(#13#10,TempStr)+1);
        TempStr:=Copy(TempStr,1,Pos(#13#10,TempStr)-1);
        Result:=TSMSInfo.Create(TempStr);
      end;
    end;
var
Atstring:String;
begin
Atstring:=Format(ReadMSGStr,[Index]);
PortControl.WriteStr(AtString);
//Delay(50);
PortControl.ReadStr(AtString,1024);
Result:=StrToSMSInfo(AtString);
DoGetValue(self,AtString);
end;

procedure TPhoneControl.AskSendMsg(ASMSInfo: TSMSInfo);
var
ATString:string;
begin
PortControl.Tag:=1;
ATString:=Format(SendPDULen,[ASMSInfo.Len]);
PortControl.WriteStr(AtString);
Delay(50);
ATString:=ASMSInfo.PDU+#26;
PortControl.WriteStr(AtString);
//Delay(1000);
//PortControl.ReadStr(AtString,1024);
end;

procedure TPhoneControl.CloseComm;
begin
PortControl.Close;
end;

procedure TPhoneControl.DoGetValue(Sender: TObject; Value: string);
var
AtString:String;
ASMSInfo:TSMSInfo;
begin
AtString:=Value;
while MatchPattern(PChar(AtString),Pchar('*+CMT:*,*'+#13#10)) do
begin
    Delete(AtString,1,Pos('+CMT:',AtString)+4);
    Delete(AtString,1,Pos(#13#10,AtString)+1);
    ATString:=Copy(AtString,1,Pos(#13#10,AtString)-1);
    ASMSInfo:=TSMSInfo.Create(AtString);
    if Assigned(FGetNewSMS) then
      FGetNewSMS(self,ASMSInfo);
    Delete(Atstring,1,Pos(#13#10,AtString)+1);
end;
if Assigned(FGetValue) then
    FGetValue(self,Value);
end;

function TPhoneControl.GetBaudRate: TBaudRate;
begin
Result:=PortControl.BaudRate;
end;

function TPhoneControl.GetComm: string;
begin
Result:=PortControl.Port;
end;

function TPhoneControl.GetCSQ: integer;
var
ATString:string;
begin
Result:=99;
ATString:='AT+CSQ'+#13;
PortControl.WriteStr(AtString);
//Delay(50);
PortControl.ReadStr(AtString,1024);
if Pos('+CSQ:',AtString)>0 then
    Result:=AnswerCSQ(AtString);
DoGetValue(self,AtString);
end;

procedure TPhoneControl.GetCSQA;
var
ATString:string;
begin
PortControl.Tag:=0;
ATString:='AT+CSQ'+#13;
PortControl.WriteStr(AtString);
Delay(100);
end;

function TPhoneControl.GetReadInterval: integer;
begin
Result:=PortControl.Timeouts.ReadInterval;
end;

function TPhoneControl.GetSMSC: string;
function AnswerCSCA(MSG:String):string;
var
    TempStr:string;
    i:integer;
begin
    Result:='';
    TempStr:=MSG;
    i:=Pos('"',TempStr);
    if i>0 then
      Delete(TempStr,1,i);
    i:=Pos('"',TempStr);
    if i>0 then
      TempStr:=Copy(TempStr,1,i-1);
    if Pos('+',Tempstr)>0 then
      Result:=Copy(TempStr,Pos('+',Tempstr)+1,Length(TempStr)-Pos('+',Tempstr));
end;
var
ATString:string;
begin
Result:='';
ATString:='at+csca?'+#13;
PortControl.WriteStr(AtString);
//Sleep(200);
PortControl.ReadStr(AtString,1024);
if Pos('+CSCA:',AtString)>0 then
    Result:=AnswerCSCA(AtString);
DoGetValue(self,AtString);
end;

function TPhoneControl.InitComm: integer;
var
CSQ:integer;
begin
Result:=0;
if not AnswerAT then begin
    Result:=1;
    Exit;
end;
if not SetCSMS(1) then
    if not SetCSMS(0) then
    begin
      Result:=2;
      Exit;
    end;

CSQ:=GetCSQ;
if (CSQ<0) or (CSQ>31) then
begin
    Result:=3;
    Exit;
end;

if not SetCNMI('2,2,0,1,1') then
begin
    Result:=4;
    Exit;
end;
end;

function TPhoneControl.OpenComm: Boolean;
var
i:integer;
begin
Result:=True;
try
    PortControl.Open;
except
    Result:=False;
end;
//initComm;
PortControl.OnRxChar:=nil;
case InitComm of
    1:begin
        i:=0;
        repeat
          if AnswerAT then
          begin
            Result:=True;
            Break;
          end;
          inc(i);
        until (i<=5);
        if not Result then
        begin
          ShowMessage('居然不响应命令哎！COOL MODEM');
          Exit;
        end;
      end;
    2:begin
        ShowMessage('COOL MODEM，居然不支持GSM MODEM AT！！！');
        Result:=False;
        Exit;
      end;
    3:begin
        ShowMessage('没信号，就是No Signal！！！！');
        Result:=False;
        Exit;
      end;
    4:begin
        ShowMessage('设置不对？头大了！！！');
        Result:=False;
        Exit;
      end;
end;
//ReadAllMSgInSIM;
PortControl.OnRxChar:=RxChar; //赶紧定义这个函数，我需要一个解析函数
Result:=True;
end;

procedure TPhoneControl.ReadAllMSgInSIM;
//子处理过程开始//////////////////
type
    TCpms=record
      Site:string;
      Used,Total:integer;
    end;

function AskStrogeSite:String;
var
    ATString:string;
begin
    AtString:='AT+CPMS?'+#13;
    PortControl.WriteStr(AtString);
    delay(50);
    PortControl.ReadStr(AtString,1024);
    if Pos('+CPMS:',AtString)>0 then
    begin
      Delete(AtString,1,Pos('+CPMS:',AtString)+5);
      AtString:=StringReplace(AtString,' ','',[rfReplaceAll, rfIgnoreCase]);
      AtString:=StringReplace(Atstring,',',#13#10,[rfReplaceAll, rfIgnoreCase]);
    end;
    Result:=Atstring;
    DoGetValue(self,AtString);
end;
procedure AskReadMsgs(ACmps:TCpms);
var
    ASMSInfo:TSMSInfo;
    I:integer;
begin
    for i:=1 to ACmps.Used do
    begin
      ASMSInfo:=AskReadMsg(i);
      if Assigned(FGetNewSMS) then
        FGetNewSMS(self,ASMSInfo);
    end;
end;

function SetCPMS(Value:String):Boolean;
var
    AtString:String;
begin
    AtString:='AT+CPMS='+Value+#13;
    PortControl.WriteStr(AtString);
    delay(50);
    PortControl.ReadStr(AtString,1024);
    if Pos('OK',AtString)>0 then
      Result:=True
    else
      Result:=False;
    DoGetValue(self,AtString);
end;
//子处理过程结束//////////////////////
var
Count,i,j:integer;
A:TStrings;
ACpms,BCpms:array of TCpms;
NoEqual:Boolean;
AtString:string;
begin
A:=TStringList.Create;
A.Text:=AskStrogeSite;
for i:=1 to A.Count div 3 do
begin
    SetLength(ACpms,i);
    ACpms[i-1].Site:=A.Strings[i*3-3];
    ACpms[i-1].Used:=StrToInt(A.Strings[i*3-2]);
    ACpms[i-1].Total:=StrToInt(A.Strings[i*3-1]);
end;
if High(ACpms)>0 then
begin
    Count:=1;

    SetLength(BCpms,Count);
    BCpms[0]:=Acpms[0];
    for i:=Low(ACpms) to High(ACpms)-1 do
    begin
      NoEqual:=True;
      for j:=Low(BCpms) to High(BCpms) do
        if BCpms[j].site<>Acpms[i].Site then
        begin
          NoEqual:=False;
          Break;
        end;
      if not NoEqual then
      begin
        SetLength(BCpms,Count+1);
        BCpms[Count]:=ACpms[i];
        inc(Count);
      end;
    end;
end;
for i:=Low(BCpms) to High(BCpms) do
    if BCpms[i].Site<>'' then
    begin
      if SetCPMS(BCpms[i].Site) then
        AskReadMsgs(BCpms[i]);
    end;
A.Free;

Atstring:=Format(DeleteMSG,[2]);
PortControl.WriteStr(AtString);
PortControl.ReadStr(AtString,1024);
DoGetValue(self,AtString);
end;

procedure TPhoneControl.SetBaudRate(const Value: TBaudRate);
begin
if PortControl.BaudRate=Value then Exit;
PortControl.BaudRate:=Value;
end;

function TPhoneControl.SetCNMI(const Value: string): Boolean;
var
ATString:string;
begin
Result:=False;
ATString:=Format(SelectSMSSaveMode,[Value]);
PortControl.WriteStr(AtString);
//Delay(50);
PortControl.ReadStr(AtString,1024);
if Pos('OK',AtString)>0 then
    Result:=True;
DoGetValue(self,AtString);
end;

procedure TPhoneControl.SetComm(const Value: string);
begin
if PortControl.Port=Value then Exit;
PortControl.Port:=Value;
end;

function TPhoneControl.SetCSMS(const Value: integer): Boolean;
var
AtString:string;
begin
Result:=False;
AtString:=Format('AT+CSMS=%d'+#13,[Value]);
PortControl.WriteStr(Atstring);
//Delay(50);
PortControl.ReadStr(AtString,1024);
if Pos('+CSMS:',Atstring)>0 then
    Result:=True;
DoGetValue(self,AtString);
end;

procedure TPhoneControl.SetQuerySignalInteval(const Value: integer);
begin
FQuerySignalInteval := Value;
end;

procedure TPhoneControl.SetReadInterval(const Value: integer);
begin
if PortControl.Timeouts.ReadInterval=Value then Exit;
PortControl.Timeouts.ReadInterval:=Value;
end;

procedure TPhoneControl.SetSignal(const Value: integer);
begin
FSignal := Value;
end;

procedure TPhoneControl.RXChar(Sender: TObject; Count: integer);
var
AtString:string;
begin
SetLength(AtString,Count);
PortControl.ReadStr(AtString,Count);
FSignal:=AnswerCSQ(AtString);
{case PortControl.Tag of
    0:begin
        FSignal:=AnswerCSQ(AtString);
        //FContinue:=(FSignal>0) and (FSignal<31);
      end;
    1:begin
        if MatchPattern(PChar(AtString),PChar('+CMGS:*OK')) then
        begin
          //ASMSInfo:=SendingList.Items[0]; ??????????????
          //Sendinglist.DeleteRec(0);     ??????????????
        end;
        DoGetValue(self,AtString);
      end;
    else begin   }
DoGetValue(self,AtString);
{ end;
end;   }
end;

procedure TPhoneControl.SetRxCharEvent(const Value: boolean);
begin
if FUseRxCharEvent = Value then Exit;
FUseRxCharEvent := Value;
if FUseRxCharEvent then
    PortControl.OnRxChar:=RXChar
else
    PortControl.OnRxChar:=nil;
end;

end.

2006-4-18 15:15:30    unit SMSList仅供参考
unit SMSList;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Controls, RTLConsts, PhoneShare, SPCOMM;

Const
CSQStr='At+CSQ'+#13; //tag=0,信号强度
COPSStr='AT+COPS?'+#13; //tag=1,是否被网络接受
SelectSMSService='AT+CSMS=1'+#13; //选择短消息服务
SelectSMSSaveMode='AT+CNMI=%s'+#13;//选择短消息存取模式
SelectSMSMode='at+cmgf=%d'+#13; //选择短消息模式，文本还是PDU
SendPDULen='at+cmgs=%d'+#13;
ReadMSGStr='at+cmgr=%d'+#13;
DeleteMSG='at+cmgd=1,%d'+#13;

type
TActStyle=(asAdd,asInSert,asDelete);

TChangeNotifyEvent=procedure (Sender:TObject;ActStyle:TActStyle) of Object;

TSMSInfo =class(TPersistent)
private
    FPDULen: integer;
    FPhone: string;
    FText: string;
    FSendTime: string;
    FMessageCenter: string;
    FPDU: string;
    FReceivedTime: string;
    FDCS: TSMType;
    FLen:integer;
    procedure SetMessageCenter(const Value: string);
    procedure SetDCS(const Value: TSMType);
    procedure SetPhone(const Value: string);
    procedure SetSendTime(const Value: string);
protected
    procedure EncodePDU(ADCS:TSMType;APhone,AText:string;AMessageCenter:string='');dynamic;
    procedure UncodePDU(APDU:String);dynamic;
public
    constructor Create(const ADCS:TSMType;const APhone,AText:string;AMessageCenter:string='');overLoad;virtual;
    constructor Create(const APDU:string);reintroduce;overLoad;virtual;
    destructor Destroy;override;
    procedure Assign(Source:TPersistent);override;
published
    property MessageCenter:string read FMessageCenter write SetMessageCenter;
    property Phone:string read FPhone write SetPhone;
    property SendTime:string read FSendTime write SetSendTime;
    property ReceivedTime:string read FReceivedTime;
    property Text:string read FText;
    property PDULen:integer read FPDULen;
    property PDU:string read FPDU;
    property DCS:TSMType read FDCS write SetDCS;
    property Len:integer read FLen;
end;

TSMSList=class(TObject)
private
    FList: TList;
    //FLock: TRTLCriticalSection;
    //FDuplicates: TDuplicates;
    FChange: TChangeNotifyEvent;
    //function GetFirstSMS: TSMSInfo;
    function GetItem(index: integer): TSMSInfo;
    procedure InsertRec(ASMSInfo: TSMSInfo);
    //function LockList: TList;
    procedure SetItem(index: integer; const Value: TSMSInfo);
    function GetCount: integer;
    //procedure UnlockList;
public
    constructor Create;
    destructor Destroy;override;
    procedure AddRec(ASMSInfo:TSMSInfo);
    //procedure InsertRec(ASMSInfo:TSMSInfo);
    procedure DeleteRec(index:integer);
    procedure RemoveRec(ASMSInfo:TSMSInfo);
    procedure ClearRec;

    property Items[index:integer]:TSMSInfo read GetItem write SetItem;
    //function LockList: TList;
    //procedure UnlockList;
    //function GetFirstSMS:TSMSInfo;
    property Count:integer read GetCount;
    //property Duplicates: TDuplicates read FDuplicates write FDuplicates;

    procedure SaveToStream(AStream:TStream);
    procedure LoadFromStream(AStream:TStream);

    property OnChange:TChangeNotifyEvent read FChange write FChange;
end;

implementation

uses TypInfo;

{ TSMSList }

procedure TSMSList.AddRec(ASMSInfo: TSMSInfo);
begin

//LockList;
//try
    //if (Duplicates = dupAccept) or
       //(FList.IndexOf(ASMSInfo) = -1) then
    //begin
      FList.Add(ASMSInfo);
      if Assigned(FChange) then
        FChange(ASMSInfo,asAdd);
    //end
    //else if Duplicates = dupError then
      //FList.Error(@SDuplicateItem, Integer(ASMSInfo));
//finally
    //UnlockList;
// end;
end;

procedure TSMSList.ClearRec;
var
ASMSInfo:TSMSInfo;
begin
//LockList;
//try
    while FList.Count>0 do
    begin
      //ASMSInfo:=TSMSInfo(FList.Items[0]);
      FList.Delete(0);
      if Assigned(FChange) then
        FChange(ASMSInfo,asDelete);
    end;
// finally
    //UnlockList;
//end;
end;

constructor TSMSList.Create;
begin
inherited Create;
//InitializeCriticalSection(FLock);
FList := TList.Create;
//FDuplicates := dupIgnore;
end;

procedure TSMSList.DeleteRec(index:integer);
var
ASMSInfo:TSMSInfo;
begin
//LockList;
//try
    //if (Duplicates = dupAccept) or
       //(FList.IndexOf(ASMSInfo) = -1) then
    //begin
      ASMSInfo:=TSMSInfo(FList.Items[index]);
      FList.Delete(index);
      if Assigned(FChange) then
        FChange(ASMSInfo,asDelete);
    //end
    //else if Duplicates = dupError then
     // FList.Error(@SDuplicateItem, Integer(ASMSInfo));
//finally
   // UnlockList;
// end;
end;

destructor TSMSList.Destroy;
begin
//LockList;    // Make sure nobody else is inside the list.
//try
    FList.Free;
    inherited Destroy;
//finally
   // UnlockList;
    //DeleteCriticalSection(FLock);
//end;
end;

{function TSMSList.GetFirstSMS: TSMSInfo;
begin
Result:=nil;
LockList;    // Make sure nobody else is inside the list.
try
    if Flist.Count>0 then
      Result:=TSMSInfo(FList.Items[0]);
finally
    UnlockList;
end;
end; }

function TSMSList.GetCount: integer;
begin
Result:=FList.Count;
end;

function TSMSList.GetItem(index: integer): TSMSInfo;
begin
Result:=TSMSInfo(FList.Items[0]);
end;

procedure TSMSList.InsertRec(ASMSInfo: TSMSInfo);
begin
//LockList;
//try
    //if (Duplicates = dupAccept) then
    //begin
      if (FList.Count>1) then
        FList.Insert(1,ASMSInfo)
      else
        FList.Add(ASMSInfo);
      if Assigned(FChange) then
        FChange(ASMSInfo,asInsert);
    //end
    //else if Duplicates = dupError then
      //FList.Error(@SDuplicateItem, Integer(ASMSInfo));
//finally
    //UnlockList;
// end;
end;

procedure TSMSList.LoadFromStream(AStream: TStream);
var
Reader:TReader;
i,Count:integer;
ASMSInfo:TSMSInfo;
begin
//LockList;
//try
    Reader:=TReader.Create(AStream,1024);
    try
      FList.Clear;
      Count:=Reader.ReadInteger;
      for i:=0 to Count-1 do
      begin
        ASMSInfo:=TSMSInfo.Create;
        ASMSInfo.FPDULen:=Reader.ReadInteger;
        ASMSInfo.FPhone:=Reader.ReadString;
        ASMSInfo.FText:=Reader.ReadString;
        ASMSInfo.FSendTime:=Reader.ReadString;
        ASMSInfo.FMessageCenter:=Reader.ReadString;
        ASMSInfo.FPDU:=Reader.ReadString;
        ASMSInfo.FReceivedTime:=Reader.ReadString;
        SetOrdProp(ASMSInfo,'DCS',Reader.ReadInteger);
        FList.Add(ASMSInfo);
        if Assigned(FChange) then
        FChange(ASMSInfo,asAdd);
      end;
    finally
      Reader.Free;
    end;
//finally
   // UnlockList;
//end;
end;
{
function TSMSList.LockList: TList;
begin
//EnterCriticalSection(FLock);
//Result := FList;
end;   }

procedure TSMSList.RemoveRec(ASMSInfo: TSMSInfo);
begin
FList.Remove(ASMSInfo);
end;

procedure TSMSList.SaveToStream(AStream: TStream);
var
Writer:TWriter;
i:integer;
ASMSInfo:TSMSInfo;
begin
//LockList;
//try
    Writer:=TWriter.Create(AStream,1024);
    try
      Writer.WriteInteger(FList.Count);
      for i:=0 to FList.Count-1 do
      begin
        ASMSInfo:=TSMSInfo(FList.Items[i]);
        Writer.WriteInteger(ASMSInfo.PDULen);
        Writer.WriteString(ASMSInfo.FPhone);
        Writer.WriteString(ASMSInfo.FText);
        Writer.WriteString(ASMSInfo.FSendTime);
        Writer.WriteString(ASMSInfo.FMessageCenter);
        Writer.WriteString(ASMSInfo.FPDU);
        Writer.WriteString(ASMSInfo.FReceivedTime);
        Writer.WriteInteger(GetOrdProp(ASMSInfo,'DCS'));
      end;
    finally
      Writer.Free;
    end;
//finally
    //UnlockList;
//end;
end;

procedure TSMSList.SetItem(index: integer; const Value: TSMSInfo);
begin
FList.Items[index]:=Value;
end;
{
procedure TSMSList.UnlockList;
begin
LeaveCriticalSection(FLock);
end;
}
{ TSMSInfo }

procedure TSMSInfo.Assign(Source: TPersistent);
var
A:TSMSInfo;
begin
if Source is TSMSInfo then
begin
    A:=TSMSInfo(Source);
    //FPDULen:=A.PDULen ;
    FPhone:=A.Phone;
    FText:=A.Text;
    FSendTime:=A.SendTime;
    FMessageCenter:=A.MessageCenter;
    FPDU:=A.PDU;
    FReceivedTime:=A.FReceivedTime;
    FDCS:=A.DCS;
end
else
    inherited;
end;

constructor TSMSInfo.Create(const APDU: string);
begin
inherited Create;
FPDU:=APDU;
UncodePDU(FPDU);
end;

constructor TSMSInfo.Create(const ADCS:TSMType;const APhone,AText:string;AMessageCenter:string='');
begin
inherited Create;
FMessageCenter:=AMessageCenter;
FPhone:=APhone;
FText:=AText;
FDCS:=ADCS;
EncodePDU(ADCS,APhone,AText,AMessageCenter);
end;

destructor TSMSInfo.Destroy;
begin

inherited;
end;

procedure TSMSInfo.EncodePDU(ADCS:TSMType;APhone,AText:string;AMessageCenter:string='');
begin
   if AMessageCenter='' then
     FPDU:=MixSendPDU(APhone,AText,ADCS,FLen)
   else
     FPDU:=Mix2PDU(AMessageCenter,APhone,AText,FLen);
end;

procedure TSMSInfo.SetDCS(const Value: TSMType);
begin
if FDCS = Value then Exit;
FDCS:=Value;
EncodePDU(FDCS,FPhone,FText,FMessageCenter);
end;

procedure TSMSInfo.SetMessageCenter(const Value: string);
begin
if FMessageCenter=Value then Exit;
FMessageCenter:=Value;
EncodePDU(FDCS,FPhone,FText,FMessageCenter);
end;

procedure TSMSInfo.SetPhone(const Value: string);
begin
if FPhone = Value then Exit;
FPhone := Value;
EncodePDU(FDCS,FPhone,FText,FMessageCenter);
end;

procedure TSMSInfo.SetSendTime(const Value: string);
begin
if FSendTime = Value then Exit;
FSendTime := Value;
end;

procedure TSMSInfo.UncodePDU(APDU: String);
var
Phone,MsgContent,SendTime:string;
begin
DisposeReadPDU(APDU,Phone,MsgContent,SendTime);
FPhone:=Phone;
FText:=Msgcontent;
FReceivedTime:=SendTime;
end;

end.