SMS编程代码
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. |