main.pas

一个简单的SMS短信接收程序

  {本程序只支持发送PDU模式的短信
  作者：陈耀攀（happycyp）
  日期：2005-11
   您可以随意转载，但请注明作者
  }
unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, OleCtrls, MSCommLib_TLB, ComCtrls, ExtCtrls, Buttons;


  
type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label2: TLabel;
    Label4: TLabel;
    Memo1: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    Label6: TLabel;
    Panel1: TPanel;
    Label5: TLabel;
    Edit2: TEdit;
    Label1: TLabel;
    Edit1: TEdit;
    Edit3: TEdit;
    Label7: TLabel;
    Button1: TButton;
    Button2: TButton;
    Label8: TLabel;
    Edit4: TEdit;
    Label9: TLabel;
    BtnOpen: TButton;
    BtnClose: TButton;
    Memo5: TMemo;
    Label10: TLabel;
    Label11: TLabel;
    Memo6: TMemo;
    BtnSendTxt: TButton;
    BitBtn1: TBitBtn;
    Label12: TLabel;
    MSComm1: TMSComm;
    procedure BtnSendClick(Sender: TObject);
    procedure BtnOpenClick(Sender: TObject);
    procedure BtnCloseClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure BtnSendTxtClick(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function StrtoPDU(CentreNO,RcvNO: string):String;
    function InCodePDUSMS(Mess:Widestring):String;
  end;

var
  Form1: TForm1;
   CenNO,MessContent,SMSlen: string;
   PDUMess,MessLen,TPDU:String;
implementation

{$R *.dfm}

procedure TForm1.BtnSendClick(Sender: TObject);
begin
Memo3.Clear ;
CenNO:='[phone]';
if MScomm1.PortOpen =true then
 begin
 {用PDU方式发送短信不用AT指令设置短消息中心号码也可以发送成功，设置短信中心，返加Error，也能发送成功}
  //MSComm1.Output :='AT+CSCA="[phone]"'+#13#10;  //设置短信中心号码
 // sleep(300);
   MSComm1.Output :='AT+CMGF=0'+#13#10;  //设置为PDU模式
    sleep(300);
   MSComm1.Output := 'AT+CSCS="UCS2"'+#13#10;   //设置短消息中心时应使用PDU的UCS2编码方式，否则ERROR！
     sleep(300);
   MSComm1.Output := 'AT'+#13#10;
   sleep(300);
   MSComm1.Output :='AT+CMGS='+SMSlen+#13#10;
   sleep(300);
  // MSComm1.Output :='"'+MessContent+'"'+char(26); //加双引号发不出去，错误。
   MSComm1.Output :=MessContent+char(26);
   sleep(300);
   Memo3.Lines.Add(MSComm1.Input);
 end
else
 showmessage('打开串口失败');
end;

procedure TForm1.BtnOpenClick(Sender: TObject);
var
 setting: string;
begin
if MScomm1.PortOpen then
 MScomm1.PortOpen :=false;
setting:=trim(edit4.Text)+',n,8,1';
MSComm1.Settings :=setting;
MSComm1.OutBufferSize:=1;
MSComm1.InBufferCount := 0; //清除接收缓冲区
MSComm1.OutBufferCount := 0;   //清除发送缓冲区
MScomm1.CommPort :=strtoint(edit2.Text);
//MScomm1.SThreshold := 1;
MSComm1.InputLen := 0;
MScomm1.PortOpen :=true;
 if  MScomm1.PortOpen =true then
  begin
   showmessage('打开串口成功！');
  end  else begin
   showmessage('打开串口失败！');
  end;
MSComm1.Input;   //先预读缓冲区以清除残留数据
Mscomm1.DTREnable :=true; // 数据终端准备好
Mscomm1.RTSEnable :=true; // 请求发送

end;

procedure TForm1.BtnCloseClick(Sender: TObject);
begin
MScomm1.PortOpen :=false;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
Memo3.Clear ;
end;

procedure TForm1.Button2Click(Sender: TObject);

begin
PDUMess:=InCodePDUSMS(WideString(Memo1.Text));
MessLen:=InttoHex(length(PDUMess) div 2,2) ;
TPDU:=StrtoPDU(trim(edit3.Text ),Trim(edit1.Text))+MessLen+PDUMess;
Memo4.Text :=TPDU;
end;

function TForm1.StrtoPDU(CentreNO,RcvNO: string): string;
var
 StrTemp,PDURcvNo:String;
 i,m,StrLen:integer;
begin
  StrTemp:='';
  PDURcvNo:='';
 //解析短消息中中心号码
  StrLen:=Length(CentreNO);
  if (StrLen mod 2)<>0 then    //如果是奇数
    begin
      CentreNO:=CentreNO+'F';
      StrLen:=StrLen+1;
    end;
  i:=1;
   while i<=Strlen do
    begin
    StrTemp:=StrTemp+CentreNO[i+1]+CentreNO[i];     //  交换奇数位和偶数位
    inc(i,2);
   end;
  StrTemp:='91'+StrTemp;   //将短信息中心号码前面加上字符91，91是国际化的意思
  StrLen:=Length(StrTemp);
  m:=(StrLen div 2);
  StrTemp:=inttohex(m,2)+StrTemp;
 //解析完短消息中中心号码

 //解析收信人号码
  if copy(RcvNo,1,2)='13' then RcvNo:='86'+RcvNo;   //手机号前面加13
  if copy(RcvNo,1,1)='0' then RcvNo:='106'+RcvNo;   //小灵通前面加106

   if copy(RcvNo,1,2)='86' then  StrTemp := StrTemp + '11000D91';    //手机91, 0D表示电话长度(13位)，用16进制表示。
  if copy(RcvNo,1,3)='106' then
    begin
      if Length(RcvNo)=15 then StrTemp := StrTemp + '11000F81';   //小灵通81, 0F表示电话长度(15位)，用16进制表示。
      if Length(RcvNo)=14 then StrTemp := StrTemp + '11000E81';
    end;

  StrLen:=Length(RcvNO);
   if (StrLen mod 2)<>0 then    //如果是奇数
    begin
      RcvNO:=RcvNO+'F';
      StrLen:=StrLen+1;
    end;
   i:=1;
   while i<=Strlen do
    begin
    PDURcvNo:=PDURcvNo+RcvNO[i+1]+RcvNO[i];     //  交换奇数位和偶数位
    inc(i,2);
   end;
  PDURcvNo:=PDURcvNO+'0008A7';
  Result:=StrTemp+PDURcvNo;
end;

function TForm1.InCodePDUSMS(Mess: WideString): String;
var
  sLen,cur,i:integer;
  strTmp:string;
begin
  result := '';
  sLen := length(Mess);
  i := 1;
  while i <= sLen do
  begin
    cur := ord(Mess[i]);                          //先返回序数值
    FmtStr(strTmp,'%4.4X',[cur]);              //格式化序数值（BCD转换）
    result := result + strTmp;
    inc(i);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
Memo3.Clear ;
MessLen:=InttoHex((length(PDUMess) div 2),2);
if MScomm1.PortOpen =true then
 begin
 {用PDU方式发送短信不用AT指令设置短消息中心号码也可以发送成功，设置短信中心，返加Error，也能发送成功}
 // MSComm1.Output :='AT+CSCA="[phone]"'+char(13);  //设置短信中心号码
 // sleep(300);
   MSComm1.Output :='AT+CMGF=0'+char(13);  //设置为PDU模式
    sleep(300);
   MSComm1.Output := 'AT+CSCS="UCS2"'+char(13);
   //设置短消息中心时应使用PDU的UCS2编码方式,WaveCom是HEX，否则ERROR！
     sleep(300);
   MSComm1.Output := 'AT'+char(13);  //用#13#10，对ＷaveCom不行。
   sleep(300);
   MSComm1.Output :='AT+CMGS='+inttostr((length(TPDU)-18) div 2)+char(13);
   sleep(300);
  MSComm1.Output :=TPDU+char(26);
   sleep(300);
   Memo3.Lines.Add(MSComm1.Input);
 end
else
 showmessage('打开串口失败');
end;

procedure TForm1.BtnSendTxtClick(Sender: TObject);
var
  RMobile:string;
begin
  RMobile:=trim(edit1.Text); //接收人的手机号。
  if copy(RMobile,1,2)='13' then RMobile:='86'+RMobile;   //手机号前面加13
  if copy(RMobile,1,1)='0' then RMobile:='106'+RMobile;   //小灵通前面加106
  MSComm1.Input;  //先预读缓冲区以清除残留数据
  MSComm1.Output :='AT+CSCA="[phone]"'+char(13);  //设置短信中心号码
  sleep(300);
  MSComm1.Output :='AT+CMGF=1'+#13#10;  //设置为text模式
  sleep(300);
 // MSComm1.Output := 'AT+CSCS=""'+#13#10;   //设置短消息中心时应使用PDU的UCS2编码方式，否则ERROR！
 //  sleep(300);
  MSComm1.Output := 'AT'+#13#10;
  sleep(300);
  MSComm1.Output :='AT+CMGS="'+ RMobile+'"'+#13#10;
  sleep(500);
  MSComm1.Output := Memo5.Text+Char(26);
  sleep(100);
  Memo6.Text :=MSComm1.Input;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
application.Terminate ;
end;

end.