pc+

PC机与GSM短信模块串口通信程序设计

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, OleCtrls, MSCommLib_TLB, DB, ADODB, StrUtils,
  CheckLst, Menus;

type
  TForm1 = class(TForm)
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    TabSheet3: TTabSheet;
    TabSheet4: TTabSheet;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    RichEdit1: TRichEdit;
    RichEdit2: TRichEdit;
    GroupBox3: TGroupBox;
    Label1: TLabel;
    ComboBox1: TComboBox;
    Label2: TLabel;
    ComboBox2: TComboBox;
    Label3: TLabel;
    Edit1: TEdit;
    Label4: TLabel;
    GroupBox4: TGroupBox;
    Label5: TLabel;
    Edit2: TEdit;
    Button1: TButton;
    GroupBox5: TGroupBox;
    Edit3: TEdit;
    Button2: TButton;
    GroupBox6: TGroupBox;
    Label6: TLabel;
    Edit4: TEdit;
    Button3: TButton;
    RichEdit3: TRichEdit;
    Label7: TLabel;
    Label8: TLabel;
    Edit5: TEdit;
    Edit6: TEdit;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Label9: TLabel;
    Edit7: TEdit;
    Button4: TButton;
    Button5: TButton;
    mycon: TADOConnection;
    ADOQuery1: TADOQuery;
    ADOTable1: TADOTable;
    Button6: TButton;
    CheckListBox1: TCheckListBox;
    MSComm1: TMSComm;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    //procedure ListBox1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure MSComm1Comm(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure ComboBox1Click(Sender: TObject);
    procedure ComboBox2Click(Sender: TObject);
    procedure RichEdit1Change(Sender: TObject);
    procedure RichEdit2Change(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure CheckListBox1Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
  private
    { Private declarations }
    procedure settest();
    procedure openconntion();
    procedure senddata();
    procedure viewsendword();
    procedure viewreciveword();
    function  readtext(tempstr:widestring):widestring;
    function  readunicode(tempstr:widestring):widestring;
    function  getunicode(tempstr:widestring):widestring;
   // procedure getunicode();
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  pduorder:boolean;
  recivestr:string;
  sendstr,senddatastr:string;
  sendsca:string; //服务中心电话
  sendphone:string;  //发送电话
  revicephone:string;  //接收电话
  txtletterlen:integer; //发送数据字节
  strunicode:string;   //发送的unicode码
  phonearray:array[0..10000]  of string;  //群发短信时的接收电话数组
  autoreceive:Integer; //设置自动接收还是手动接收短信息，0为手动，1为自动
  {Dim MyCon As New ADODB.Connection
  Dim MyRecordset As New ADODB.Recordset
  Dim Mycmd As New ADODB.Command 不知道什么意思}
  mulitsend:boolean;
  mulitsendstop:boolean;  //群发中的暂停
  readshortletter:boolean;  //读短信
  {Private Declare Function GetTickCount Lib "kernel32" () As Long}



implementation

{$R *.dfm}

//初始化
procedure TForm1.FormCreate(Sender: TObject);
begin
  autoreceive:=0;
  if MSComm1.PortOpen  then
     MSComm1.PortOpen :=false;
  MSComm1.CommPort :=1;
  MSComm1.Settings :='9600,n,8,1';
  MSComm1.InputMode :=0;
  MSComm1.PortOpen :=true;
  MSComm1.RThreshold :=1;
  sendsca:=combobox1.text;
  settest();
  MSComm1.Output := 'AT+CNMI=2,1,,1'+chr(13);  //提供新信息提示，以及传送回报的功能
  openconntion();
  mulitsend:=false;
  mulitsendstop:=false;
  {if  combobox2.text='PDU' then
      pduorder:=true
  else
      pduorder:=false;  }
  //richedit1.Text:=''
end;

//网络信号测试
procedure TForm1.settest();
var
 temp:string;
begin
  readshortletter:=false;
  temp:=MSComm1.Input ;
  MSComm1.Output :='AT+CSQ'+chr(13);
  recivestr:='';
  sendstr:='AT+CSQ'+chr(13);
  viewsendword();
end;

//访问数据库，获取短信中心号码、电话号码
procedure TForm1.openconntion();
var
  //strconntion:string;
  //mydatapath:string;
  i:integer;
begin
  mycon.ConnectionString :='provider=microsoft.jet.oledb.4.0;data source='+extractfilepath(application.ExeName)+'mydb.mdb;persist security info=false';  mycon.Open;
  //加载短信中心号码
 //openrecordset('select * from 服务中心表',mydaset.Recordset);
  with adoquery1 do
    begin
      sql.clear;
      sql.Add('select * from 服务中心表');
      open;
      first;
      for i:=0 to recordcount-1 do
        begin
         combobox1.items.add(fieldbyname('服务号码').asstring);
         next;
        end;
      close;
    end;
  combobox1.Text:=combobox1.items[0];

  //加载群发短信的接收电话
  //openrecordset('select * from 电话号码表',mydaset.Recordset);
   with adoquery1 do
    begin
      sql.clear;
      sql.Add('select * from 电话号码表');
      open;
      first;
      for i:=0 to recordcount-1 do
        begin

         checklistbox1.items.add(fieldbyname('电话号码').asstring);
         next;
        end;
      close;
    end;
    edit2.Text:='';
end;

//添加群发电话号码
procedure TForm1.Button1Click(Sender: TObject);
var
  strphone:string;
  i:longint;
begin
  strphone:=edit2.Text;
  case length(trim(strphone)) of
    7,11:
      begin
        for i:=1 to checklistbox1.Count-1 do
         if trim(strphone)=checklistbox1.Items[i] then
           begin
             showmessage('您要添加的电话在电话薄中已存在!');
             exit;
           end;
       checklistbox1.Items.Add(trim(strphone));
      //openrecordset('select * from 电话号码表',mydaset.Recordset);  //数据库调用
       with adoquery1 do
         begin
           sql.Clear;
           sql.add('insert into 电话号码表(电话号码) values(:电话号码)');
           parameters.ParamByName('电话号码').Value:=edit2.Text;
           execsql
         end;
      end;
    0:exit;
    else showmessage('您要添加的电话号码可能有误,请查证!');
  end;
end;

//拨打电话
procedure TForm1.Button4Click(Sender: TObject);
begin
  sendphone:=trim(edit7.text);
  readshortletter:=false;
  MSComm1.Output:='ATD'+' '+sendphone+';'+chr(13);

end;

//挂断电话
procedure TForm1.Button5Click(Sender: TObject);
begin
  readshortletter:=false;
  MSComm1.Output:='ATH'+chr(13);
end;


//短信发送（群发）
procedure TForm1.Button2Click(Sender: TObject);
var
  i,j,pcount:longint;
  temp:string;
begin
  mulitsend:=true;
  pcount:=0;
  for i:=0 to checklistbox1.Items.Count-1 do
    if checklistbox1.checked[i] then
      begin
        //setlength(phonearray,pcount);
        phonearray[pcount]:=checklistbox1.Items[i];
        pcount:=pcount+1;
      end;
  for j:=0 to pcount-1 do
    begin
      recivestr:='';
      mulitsendstop:=true;
      sendphone:=trim(phonearray[j]);
      senddatastr:=trim(edit3.text);
      temp:=MSComm1.Input;
      readshortletter:=false;
      if pduorder then
        begin
          strunicode:=getunicode(senddatastr);
          MSComm1.Output:='AT+CMGS='+trim(inttostr(txtletterlen))+chr(13);
          sendstr:='AT+CMGS='+trim(inttostr(txtletterlen));
        end
      else
        begin
          MSComm1.Output :='AT+CMGS='+sendphone+chr(13);
          sendstr:='AT+CMGS='+sendphone;
        end;
      viewsendword();
     { while mulitsendstop do
        DoEvents;}
    end;
end;

//读取短信
procedure TForm1.Button3Click(Sender: TObject);
var
  temp:string;
  rno:string;
begin
  readshortletter:=true;
  temp:=MScomm1.Input;
  rno:=edit4.Text;
  if (rno='') or (rno='0') then
     exit;
  MSComm1.Output :='AT+CMGR='+ ''+rno+chr(13);
  recivestr:='';
  sendstr:='AT+CMGR='+rno+chr(13);
  viewsendword();
end;

//触发收发事件
procedure TForm1.MSComm1Comm(Sender: TObject);
var
  intno:integer;
  temp:string;
  rno:string;
begin
  if MSComm1.CommEvent =2 then
    begin
      recivestr:=recivestr+MSComm1.Input ;
      if pos('>',recivestr)<>0 then
        begin
          viewreciveword();
          senddata();
        end;