unit1.pas

用串口通信实现手机短信的收发的例子(带源码)

unit Unit1;

interface

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

type
  TFormSms = class(TForm)
    ButtonSend: TButton;
    ButtonExit: TButton;
    ButtonReceive: TButton;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label4: TLabel;
    EditPhone: TEdit;
    EditCenter: TEdit;
    Comm: TComm;
    MemoSendContent: TMemo;
    GroupBox2: TGroupBox;
    Label5: TLabel;
    MemoReceiveSms: TMemo;
    MemoReceiveData: TMemo;
    ButtonDeCode: TButton;
    procedure ButtonSendClick(Sender: TObject);
    procedure ButtonExitClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure CommReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ButtonReceiveClick(Sender: TObject);
    procedure ButtonDeCodeClick(Sender: TObject);
  private
    { Private declarations }
  public
     SendFlag:string;
     procedure DecodePUD(s: string);
     function str_Gb2UniCode( text: string ):String; 
     function TextToPdu( sCenter, sPhone, sMsg: String ): String;
     function ConvertL2R( sMsg: String ): String;
     function ResumeOrder(OriStr:String):String;
     function gsmDecode7bit(pSrc:string; nSrcLength:Integer):string;
     function UniCodeToGB5(s:String):WideString;
  end;

var
  FormSms: TFormSms;

implementation

{$R *.dfm}


procedure TFormSms.ButtonSendClick(Sender: TObject);
var
  s:String;
begin
  SendFlag  :='send';
  if length(MeMoSendContent.Text)>100 then begin
    application.MessageBox('请将信息控制在50字以内!','提示',mb_iconinformation);
    MeMoSendContent.SetFocus;
    exit;
  end;
  s:=TextToPdu(EditCenter.Text,EditPhone.Text,trim(MeMoSendContent.Text));
  if (EditPhone.Text<>'')and(EditCenter.Text<>'')then
     comm.WriteCommData(pchar(s),length(s));
end;

procedure TFormSms.ButtonExitClick(Sender: TObject);
begin
  close;
end;

procedure TFormSms.FormCreate(Sender: TObject);
begin
  try
    Comm.StartComm;
  except
    application.MessageBox('错误的端口！','提示',mb_iconerror);
    ButtonSend.Enabled    :=false;
    ButtonReceive.Enabled :=false;
  end;
end;
{-----------------------------------------------------------
 GB 代码转 UniCode
-----------------------------------------------------------
//功能:中文字符串变化到Unicode字符串
//输入: txt-中文字符串
//输出: 转化成Unicode的字符串 }
function TFormSms.str_Gb2UniCode( text: string ): String;
var
  i,j,len:Integer;
  cur:Integer;
  t:String;
  ws:WideString;
begin
  Result:='';
  ws := text;
  len := Length(ws);
  i := 1;
  j := 0;
  while i <= len do begin
      cur := ord(ws[i]);
      FmtStr(t,'%4.4X',[cur]);  //BCD转换
    Result := Result+t;
    inc(i);
    //移位计数达到7位的特别处理
    j := (j+1) mod 7;
  end;
end;

//将一个字符串在位置上进行奇数位与偶数位的交换，字符串长度为奇数位时自动补F
//如果12345转换后为 2143F5
function TFormSms.ConvertL2R( sMsg: String ): String;
var i: Integer;
    cTmp: Char;
    sRe: String;
begin
    sRe := Trim( sMsg );
    i := Length( sRe );
    if i = 0 then begin
        Result := '';
        Exit;
    end;

    if i mod 2 = 1 then sRe := sRe + 'F';

    i := 1;
    while i < Length( sRe ) do begin
        cTmp := sRe[ i ];
        sRe[ i ] := sRe[ i+1 ];
        sRe[ i+1 ] := cTmp;
        i := i + 2;
    end;
    
    Result := sRe;
end;

//txt转换为pdu格式
//不带加号短信息中心号码、手机号码、短信内容
//如 sms := TextToPdu( '8613800755500', '13682570067', '你好' );
//返回可直接发送的字符串代码
function TFormSms.TextToPdu( sCenter, sPhone, sMsg: String ): String;
var sAddr, sBody: String;
    LCenter, LMsg, LBody: String;
begin
    sCenter := '91' + ConvertL2R( sCenter );
    FmtStr( LCenter, '%2.2X', [ Length( sCenter ) div 2 ] );
    sAddr   := LCenter + sCenter;
    sPhone  := ConvertL2R( sPhone );
    sMsg    := str_Gb2UniCode( sMsg );
    FmtStr( LMsg, '%2.2X', [ Length( sMsg ) div 2 ] );
    sBody   := '11000D9168' + sPhone + '000800' + LMsg + sMsg;
    FmtStr( LBody, '%2.2D', [ Length( sBody ) div 2 ] );
    Result  := 'AT' + #13#10 + 'AT+CMGF=0' + #13#10 + 'AT+CMGS='+ LBody + #13 + sAddr + sBody + #26 + #13 + #10;
end;

procedure TFormSms.DecodePUD(s: string);
var
  smsclen,PhoneIDLen,InfoLen:integer;
  tmp:string;
  cpos:Integer;
  mSMSC,mPhoneID,mInfo:string;
  mGTime,mType:string;
begin
  mSMSC:='';
  mPhoneID:='';
  mInfo:='';
  //08 地址信息的长度 个八位字节(包括91)
  cpos:=1;
  //消息中心长度
  smsclen:=StrToInt('$'+MidStr(s,cpos,2));
  //91 SMSC地址格式(TON/NPI) 用国际格式号码(在前面加‘+’)
  //68 31 08 20 05 05 F0 SMSC地址 8613800250500，补‘F’凑成偶数个
  if smsclen=0 then
    cpos:=cpos+2
  else begin
    cpos:=cpos+4;   //略去91;
    tmp:=MidStr(s,cpos,smsclen*2-2);
    mSMSC:=ResumeOrder(tmp);
    cpos:=cpos+smsclen*2-2;
  end;
  //84 基本参数(TP-MTI/MMS/RP) 接收，无更多消息，有回复地址
  cpos:=cpos+2;
  //0D 回复地址数字个数 共13个十进制数(不包括91和‘F’)
  PhoneIDLen:=StrToInt('$'+MidStr(s,cpos,2));
  if (PhoneIDLen mod 2)>0 then Inc(PhoneIDLen);
  cpos:=cpos+2;
  //91 回复地址格式(TON/NPI) 用国际格式号码(在前面加‘+’)
  //68 31 58 81 27 64 F8 回复地址(TP-RA) 8613851872468，补‘F’凑成偶数个
  if PhoneIDLen=0 then
    cpos:=cpos+2
  else begin
    cpos:=cpos+2;
    tmp:=MidStr(s,cpos,PhoneIDLen);
    mPhoneID:=ResumeOrder(tmp);
    cpos:=cpos+PhoneIDLen;
  end;
  //00 协议标识(TP-PID) 是普通GSM类型，点到点方式
  cpos:=cpos+2;
  //08 用户信息编码方式(TP-DCS) UCS2编码
  case StrToInt(MidStr(s,cpos,2)) of
    0:mType:= 'td7_Bit';
    8:mtype:= 'tdUCS2';
    15:mType:='td8_Bit';
  end;
  cpos:=cpos+2;
  //30 30 21 80 63 54 80 时间戳(TP-SCTS) 2003-3-12 08:36:45  +8时区
  tmp:=MidStr(s,cpos,14);
  //tmp:=ChangeLeftAndRight(tmp);
  tmp:=ResumeOrder(tmp);
  mGTime:=(MidStr(tmp,1,2)+'-'+MidStr(tmp,3,2)+'-'+MidStr(tmp,5,2));
  mGTime:=mGTime+ (' '+MidStr(tmp,7,2)+':'+MidStr(tmp,9,2)+':'+MidStr(tmp,11,2));
  
  cpos:=cpos+14;
  //06 用户信息长度(TP-UDL) 实际长度6个字节
  InfoLen:=StrToInt('$'+MidStr(s,cpos,2));
  cpos:=cpos+2;
  //4F 60 59 7D 00 21 用户信息(TP-UD) “你好!”
  if InfoLen>0 then begin
    tmp:=MidStr(s,cpos,InfoLen*2);
    if mType='td7_Bit' then mInfo:=gsmDecode7bit(tmp,InfoLen*2);
    if mType='td8_Bit' then ;
    if mType='tdUCS2'  then  mInfo:=UniCodeToGB5(tmp);
  end;
  MemoReceiveSms.Lines.Add('短信中心: '+msmsc);
  MemoReceiveSms.Lines.Add('短信号码: '+mphoneid);
  MemoReceiveSms.Lines.Add('短信内容: '+minfo);
  MemoReceiveSms.Lines.Add('发送时间: '+mgtime);
  MemoReceiveSms.Lines.Add('-----------------------------'); 
end;

//******************************************************************************
// Function/Procedure : UniCodeToGB5
// Purpose            : 把十六进制的字符数组转换成UNICODE字符
// Inputs             : 十六进制的字符数组
// Return             : UNICODE字符
//******************************************************************************
function tFormSms.UniCodeToGB5(s:String):WideString;
var
  P:PWord;
  I,RealLen:Integer;
  sStr:WideChar;
begin
  New(p);
  RealLen:=Length(s) div 4; //计算UNICODE真实长度
  for I:=0 to RealLen - 1 do begin
    P^:=StrToInt('$'+Copy(s,4*I+1,4));
    Move(P^,sStr,2);
    Result:=Result+sStr;
  end;
  Dispose(P);
end;

function tFormSms.ResumeOrder(OriStr:String):String;
var
  I:Integer;
  sStr:String;
begin
  sStr:='';
  for i:=1 to (Length(OriStr) Div 2) do
      sStr:=sStr+OriStr[I*2]+OriStr[I*2-1];
  Result:=StringReplace(sStr,'F','',[rfReplaceAll]);
end;

function tFormSms.gsmDecode7bit(pSrc:string; nSrcLength:Integer):string;
var
  nSrc:Integer; // 源字符串的计数值
  nByte:Integer; // 当前正在处理的组内字节的序号，范围是0-6
  nLeft:Byte; // 上一字节残余的数据
  tmpChar:Byte;
  pDst:string;
begin
  // 计数值初始化
  nSrc := 1;
  // 组内字节序号和残余数据初始化
  nByte := 0;
  nLeft := 0;
  pdst := '';
  // 将源数据每7个字节分为一组，解压缩成8个字节
  // 循环该处理过程，直至源数据被处理完
  // 如果分组不到7字节，也能正确处理
  while (nSrc < nSrcLength) do begin
    tmpChar := byte(StrToInt('$' + pSrc[nsrc] + pSrc[nsrc + 1]));
    // 将源字节右边部分与残余数据相加，去掉最高位，得到一个目标解码字节
    pDst := pDst + Char(((tmpchar shl nByte) or nLeft) and $7F);
    // 将该字节剩下的左边部分，作为残余数据保存起来
    nLeft := tmpChar shr (7 - nByte);
    // 修改字节计数值
    Inc(nByte);
    // 到了一组的最后一个字节
    if (nByte = 7) then begin
      // 额外得到一个目标解码字节
      pdst := pDst + Char(nLeft);
      // 组内字节序号和残余数据初始化
      nByte := 0;
      nLeft := 0;
    end;
    // 修改源串的指针和计数值
    nSrc := nSrc + 2;
  end;
  // 返回目标串长度
  result := pdst;
end;              

procedure TFormSms.CommReceiveData(Sender: TObject; Buffer: Pointer;BufferLength: Word);
var s:string;i:integer;
begin
  s:=pchar(buffer);
  for i:=1 to length(s) do
    s[i]:=upcase(s[i]);
  MemoReceiveData.Lines.Add(s);
  //if AnsiContainsStr(pchar(buffer),'OK')and(SendFlag='list')then     timer1.Enabled:=true;
end;

procedure TFormSms.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  comm.StopComm;
end;

procedure TFormSms.ButtonReceiveClick(Sender: TObject);
begin
  SendFlag:='list';
  MemoReceiveData.Clear;
  Comm.WriteCommData('at+cmgl=1'+#13,length('at+cmgl=1'+#13));
  ButtonDeCode.Enabled:=True;
end;

procedure TFormSms.ButtonDeCodeClick(Sender: TObject);
var i,j:integer;s:string;
begin
  if MemoReceiveData.Text<>'' then begin
      s:='';
      for i:=2 to MemoReceiveData.Lines.Count-1 do
        if leftbstr(MemoReceiveData.Lines.Strings[i],5)='+CMGL' then
          for j:=i+1 to MemoReceiveData.Lines.Count-1 do
            if  (not AnsiContainsStr(MemoReceiveData.Lines.Strings[j],'+CMGL'))and
                (not AnsiContainsStr(MemoReceiveData.Lines.Strings[j],','))and
                (not AnsiContainsStr(MemoReceiveData.Lines.Strings[j],'OK'))  then begin
              s:=s+trim(MemoReceiveData.Lines.Strings[j]);
            end else begin
              try
                if s<>'' then DecodePUD(s);
              except
                s:='';
                break;
              end;
              s:='';
              break;
            end;
      SendFlag:='';
  end;
end;

end.