unit1.~pas

Delphi编写的短信发送程序

unit Unit1;

interface

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

type
  TForm1 = class(TForm)
    GroupBox1: TGroupBox;
    CoboxDkh: TComboBox;
    CoboxBtl: TComboBox;
    CoboxSjw: TComboBox;
    CoboxTzw: TComboBox;
    CoboxXyw: TComboBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    ComboBox6: TComboBox;
    ButComOpen: TButton;
    ButComClose: TButton;
    Shape1: TShape;
    Shape2: TShape;
    Shape3: TShape;
    MSComm1: TMSComm;
    GroupBox2: TGroupBox;
    EditZxhm: TEdit;
    Label6: TLabel;
    ButZxhmQr: TButton;
    Timer1: TTimer;
    Label7: TLabel;
    EditZxhmDqh: TEdit;
    ButZxhmDq: TButton;
    GroupBox3: TGroupBox;
    Label8: TLabel;
    EditJszhm: TEdit;
    GroupBox4: TGroupBox;
    ButDxSend: TButton;
    REditDxnr: TRichEdit;
    GroupBox5: TGroupBox;
    RichEdit1: TRichEdit;
    procedure FormCreate(Sender: TObject);
    procedure ButComOpenClick(Sender: TObject);
    procedure ButComCloseClick(Sender: TObject);
    procedure ButZxhmQrClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure ButZxhmDqClick(Sender: TObject);
    procedure ButDxSendClick(Sender: TObject);

  
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
//延时
procedure Delay(MSecs: Longint);
//延时函数，MSecs单位为毫秒(千分之1秒)
var
  FirstTickCount, Now: Longint;
begin
  FirstTickCount := GetTickCount();
  repeat
    Application.ProcessMessages;
    Now := GetTickCount();
  until (Now - FirstTickCount >= MSecs) or (Now < FirstTickCount);
end;
//将中文转换为UniCode,
function AnsiToUnicode(Ansi: string):string;
var
s:string;
i:integer;
j,k:string[2];
a:array [1..1000] of char;
begin
s:='';
StringToWideChar(Ansi,@(a[1]),500);
i:=1;
while ((a[i]<>#0) or (a[i+1]<>#0)) do begin
j:=IntToHex(Integer(a[i]),2);
k:=IntToHex(Integer(a[i+1]),2);
s:=s+k+j;
i:=i+2;
end;
Result:=s;
end;
function TextLen(const S: string): integer;
begin
Result:=Length(WideString(S));
end;
function nomberPDU(const nomberstr: string): string;
var
i:integer;
s:string;
begin
s:='';
for i:=1 to 5 do
begin
s:=s+midstr(nomberstr,i*2,1)+midstr(nomberstr,(i*2)-1,1);
end;
s:=s+'F';
s:=s+midstr(nomberstr,11,1);
Result:=s;
end;
var
str:string;
nomber:string;
info:string;
infolen:integer;
leng:integer;
{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
richedit1.Text:='';
REditDxnr.Text :='请在此编写短信内容' ;
ButComClose.Enabled:=false;
ButComOpen.Enabled:=true;
ButZxhmQr.Enabled :=false;
ButZxhmDq.Enabled :=false;
CoboxDkh.Items.Clear;
CoboxDkh.Items.Add('COM1');
CoboxDkh.Items.Add('COM2');
CoboxDkh.Items.Add('COM3');
CoboxDkh.Items.Add('COM4');
CoboxBtl.Items.Clear ;
CoboxBtl.Items.Add('600');
CoboxBtl.Items.Add('1200');
CoboxBtl.Items.Add('2400');
CoboxBtl.Items.Add('4800');
CoboxBtl.Items.Add('9600');
CoboxBtl.Items.Add('19200');
CoboxBtl.Items.Add('38400');
CoboxBtl.Items.Add('43000');
CoboxBtl.Items.Add('56000');
CoboxBtl.Items.Add('57600');
CoboxBtl.Items.Add('115200');
CoboxSjw.Items.Add('5');
CoboxSjw.Items.Add('6');
CoboxSjw.Items.Add('7');
CoboxSjw.Items.Add('8');
CoboxTzw.Items.Add('1');
CoboxTzw.Items.Add('1.5');
CoboxTzw.Items.Add('2');
CoboxXyw.Items.Add('NONE');
CoboxXyw.Items.Add('ODD');
CoboxXyw.Items.Add('EVEN');
shape1.Brush.Color :=clred;
shape2.Brush.color:=clred;
shape3.Brush.Color:=clred;
EditZxhmDqh.Text:='末知'
end;

procedure TForm1.ButComOpenClick(Sender: TObject);
begin
if CoboxDkh.Text=''then
begin
showmessage('参数有空!');
exit;
end;
if not mscomm1.PortOpen then
mscomm1.CommPort:=StrToInt( midstr( CoboxDkh.Text ,4,1) );
mscomm1.Settings :=CoboxBtl.Text+',n,'+CoboxSjw.Text+','+CoboxTzw.Text ;
CoboxDkh.Enabled :=false;
CoboxBtl.Enabled :=false;
CoboxSjw.Enabled :=false;
CoboxTzw.Enabled :=false;
CoboxXyw.Enabled :=false;
mscomm1.PortOpen :=true;
ButZxhmQr.Enabled :=true;
ButZxhmDq.Enabled :=true;
mscomm1.Output:=chr(26);
delay(500);
str:=mscomm1.Input ;
str:='';

//timer1.Enabled :=true;
begin
ButComOpen.Enabled:=false;
ButComClose.Enabled:=true;
shape1.Brush.Color :=clyellow;
shape2.Brush.color:=clyellow;
shape3.Brush.Color:=clyellow;
end;
end;

procedure TForm1.ButComCloseClick(Sender: TObject);
begin
//timer1.Enabled :=false;
ButZxhmQr.Enabled :=false;
ButZxhmDq.Enabled :=false;
mscomm1.PortOpen :=false;
CoboxDkh.Enabled :=true;
CoboxBtl.Enabled :=true;
CoboxSjw.Enabled :=true;
CoboxTzw.Enabled :=true;
CoboxXyw.Enabled :=true;
ButComClose.Enabled:=false;
ButComOpen.Enabled:=true;
shape1.Brush.Color :=clred;
shape2.Brush.color:=clred;
shape3.Brush.Color:=clred;
end;

procedure TForm1.ButZxhmQrClick(Sender: TObject);
var
i:integer;
j:integer;
begin
if mscomm1.PortOpen =false then                                                 //判断串口是否打开
begin
showmessage('串口末打开' );
exit;
end;
mscomm1.Output:='AT+CSCA="'+EditZxhm.Text+'"'+chr(13)+chr(10);
ButZxhmQr.Enabled :=false;
delay(1000);
str:=mscomm1.Input ;
richedit1.Text:=richedit1.Text+str;
if (str='AT+CSCA="'+EditZxhm.Text +'"'+chr(13)+chr(13)+chr(10)+'OK'+chr(13)+chr(10)) then
    begin
    mscomm1.Output :='AT+CSCA ?'+chr(13)+chr(13);
    delay(1000);
    str:=mscomm1.Input ;
    if EditZxhm.Text=MidStr(str,21,14) then
    begin
    EditZxhmDqh.Text:=midstr(str,21,14);
    ButZxhmQr.Enabled :=true;
    showmessage('设置成功');
    exit;
    end;
    end;
beep();
showmessage('设置失败');
ButZxhmQr.Enabled :=true;
    str:='';
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
beep();
str:='';

    str:=mscomm1.Input;
 timer1.Enabled :=false;
end;

procedure TForm1.ButZxhmDqClick(Sender: TObject);
begin
if mscomm1.PortOpen =false then                                                 //判断串口是否打开
begin
showmessage('串口末打开' );
exit;
end;
ButZxhmDq.Enabled :=false;
mscomm1.Output :='AT+CSCA ?'+chr(13)+chr(13);
delay(1500);
str :=mscomm1.Input ;
EditZxhmDqh.Text :=midstr(str,21,14);
ButZxhmDq.Enabled :=true;
end;
procedure TForm1.ButDxSendClick(Sender: TObject);
var
strtemp:string;
begin
if mscomm1.PortOpen =false then                                                 //判断串口是否打开
begin
showmessage('串口末打开' );
exit;
end;
mscomm1.Output :=chr(26);                                                       //发送^Z
delay(200);                                                                     //延时200毫秒
str:=mscomm1.Input ;
str:='';                                                                        //清空输入缓冲区
delay(100);
infolen:=(textlen(REditDxnr.Text)*2);
strtemp:='AT+CMGS='+inttostr(infolen+14);                                        //计算信息长度
mscomm1.Output :=strtemp+chr(13)+chr(10);                                       //发送“AT+CMGS”命令
delay(100);
str:=mscomm1.Input ;                                                            //读串口到STR
richedit1.Text :=richedit1.Text+str;
if not(str=(strtemp+chr(13)+chr(13)+chr(10)+'>'+chr(32)))then                   //判断返回值是否正确
begin
beep();
showmessage('发送失败');
exit;
end;
nomber:=nomberPDU(EditJszhm.Text );
info:=inttohex(infolen,2)+AnsiToUnicode(REditDxnr.Text );
mscomm1.Output :='0011000B81'+nomber+'000800'+info+chr(26);
leng:=length('0011000B81'+nomber+'000800'+info+chr(26));
delay(10000);
str:=mscomm1.input;
richedit1.Text:=richedit1.Text+str;
if midstr(str,leng+17,2)='OK'then
begin
showmessage('发送成功');
end;
richedit1.Text:=richedit1.Text+midstr(str,leng+17,2);
end;

end.