unit1.pas

利用delphi编写的手机短信发送程序

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, AdPort, OoMisc, ADTrmEmu, ComCtrls, ExtCtrls,
  DB, ADODB, Grids, DBGrids, ToolWin,inifiles,shellapi, ScktComp,
  IdBaseComponent, IdComponent, IdTCPServer, Menus;
const
  WM_TRAYNOTIFY = WM_USER+100;
type
  TForm1 = class(TForm)
    ApdComPort1: TApdComPort;
    Button1: TButton;
    AdTerminal1: TAdTerminal;
    Memo1: TMemo;
    Memo2: TMemo;
    StatusBar1: TStatusBar;
    Label1: TLabel;
    Label2: TLabel;
    Button2: TButton;
    ComboBox1: TComboBox;
    ComboBox2: TComboBox;
    AdTTYEmulator1: TAdTTYEmulator;
    ComboBox3: TComboBox;
    Label3: TLabel;
    Timer1: TTimer;
    DataSource1: TDataSource;
    ADODataSet1: TADODataSet;
    ADODataSet2: TADODataSet;
    DataSource2: TDataSource;
    Timer2: TTimer;
    Label4: TLabel;
    Panel1: TPanel;
    Button3: TButton;
    Button4: TButton;
    Button5: TButton;
    Button6: TButton;
    Label5: TLabel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    DBGrid1: TDBGrid;
    DBGrid2: TDBGrid;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    ADOQuery1: TADOQuery;
    PopupMenu2: TPopupMenu;
    N2: TMenuItem;
    procedure Button1Click(Sender: TObject);
    procedure ApdComPort1TriggerAvail(CP: TObject; Count: Word);
    procedure ApdComPort1TriggerData(CP: TObject; TriggerHandle: Word);
    procedure Button2Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure ToolButton4Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure update_status ( i : integer; j : integer );
    procedure Button5Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure Button6Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure ServerSocket1ClientRead(Sender: TObject;
      Socket: TCustomWinSocket);
    //procedure IdTCPServer1Execute(AThread: TIdPeerThread);
    procedure DBGrid1MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure N1Click(Sender: TObject);
    //procedure Insert_rec ( s : string );
    procedure qc1Click(Sender: TObject);
    procedure N2Click(Sender: TObject);
    procedure DBGrid2MouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);

  private
    procedure TrayNotifyMessage(var Sender: TMessage);
    message WM_TRAYNOTIFY;
    procedure MarkTaskBarIcon(Sender: TObject);

    { Private declarations }
  public
    { Public declarations }
  end;
  

var
  Form1: TForm1;
  inif : Tinifile;
  tnd: TNOTIFYICONDATA;

implementation
uses unit2, Unit3;
{$R *.dfm}

var
  CRTrig, Sbegin : WORD;
  s : string = '';
  s_btn : integer = 0;
  s_issend : integer = 0;
  send_text, send_num : string;
  cur_id : integer;
  port : integer;
  baud : integer;
  trys : integer;
  e : integer = 0;
  
procedure TForm1.MarkTaskBarIcon(Sender: TObject);
begin
  Form1.Visible := False;
  tnd.cbSize := sizeof(tnd);
  tnd.Wnd := Handle;
  tnd.uID := 128;
  tnd.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
  tnd.uCallbackMessage := WM_TRAYNOTIFY;
  tnd.hIcon := Application.Icon.Handle;
  StrPCopy(tnd.szTip,Application.Title);
  Shell_NotifyIcon(NIM_ADD,@tnd);
end;

procedure TForm1.TrayNotifyMessage(var Sender: TMessage);
begin
  if Sender.LParam = WM_LBUTTONDBLCLK then  begin
    if form1.Visible = false then begin
      Form1.Visible := True;
      Application.Restore;
      Application.BringToFront;
    end else begin
      Form1.Visible := false;
    end;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  self.ApdComPort1.Open := true;
  T_send ( ApdComPort1, self.ComboBox1.Text, self.Memo1.Text );
end;

procedure TForm1.ApdComPort1TriggerData(CP: TObject; TriggerHandle: Word);
var sss : string ; 
begin
  if TriggerHandle = CRTrig then begin
    sss := UpperCase ( s );
    //if ( StrPos ( pchar(s), Pchar( 'OK' ) ) <> NIL ) and ( s_status = 1 ) then begin
    if ( StrPos ( pchar(sss), Pchar( 'SIEMENS' ) ) <> NIL ) and ( s_status = 1 ) then begin
      timer1.Enabled := false;
      screen.Cursor := crArrow;
      //ShowMessage ( '检测到手机连接。' );
      self.StatusBar1.Panels[2].Text := '检测到手机连接。';
      s_status := 2;
    end;
    if ( StrPos ( pchar(sss), Pchar( 'OK' ) ) <> NIL ) and ( s_status = 12 ) then begin
      //ShowMessage ( '短信发送成功.' );
      update_status ( cur_id, 0 );
      s_status := 2;
      e := 0;
      send_num := '';
      send_text := '';
      sleep ( 3500 );
      s_issend := 0;
    end;
    if ( StrPos ( pchar(sss), Pchar( 'ERROR' ) ) <> NIL ) and ( s_status > 10 ) then begin
      if e = trys then begin
        update_status ( cur_id, 1 );
        e := 0;
        send_num := '';
        send_text := '';
        s_issend := 0;
      end else begin
        e := e + 1;
        s_issend := 0;
      end;
      s_status := 2;
    end;
    self.Memo2.Text := Memo2.Text + s;
    s := '';
    sss := '';
  end;

  if TriggerHandle = Sbegin then begin
     self.Memo2.Text := Memo2.Text + s;
     if s_status = 11 then begin
       send_msg_second ( form1.ApdComPort1);
       s_status := 12;
     end;
  end;
end;

procedure TForm1.ApdComPort1TriggerAvail(CP: TObject; Count: Word);
var
  I : Word;
begin
  for I := 1 to Count do
    S := S + ApdComPort1.GetChar;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
 if s_btn = 0 then begin
   if self.ApdComPort1.Open = true then begin
      self.ApdComPort1.Open := false;
      sleep ( 1000 );
   end;
   self.ApdComPort1.Baud := strtoint ( self.ComboBox2.Text );
   self.ApdComPort1.ComNumber := strtoint ( self.ComboBox3.Text );
   try
      self.ApdComPort1.Open := true;
      self.ApdComPort1.PromptForPort := true;
      CRTrig := ApdComPort1.AddDataTrigger(#13, False);
      Sbegin := ApdComPort1.AddDataTrigger('>', False);
   except
      on E: Exception do begin
        showMessage (  '串口打开失败:'+ #13+#10+ E.Message );
        exit;
        end;
   end;
   screen.Cursor := crHourGlass;
   self.Button2.Caption := '断开';
   sleep ( 5000 );
   init_port_test_0 (ApdComPort1);

   timer1.Interval := 4000;
   timer1.Enabled := true;
   s_btn := 1;
 end else begin
   screen.Cursor := crHourGlass;
   self.Button2.Caption := '连接';
   self.ApdComPort1.RemoveAllTriggers ;
   self.ApdComPort1.Open := false;
   self.ApdComPort1.DonePort ;
   sleep ( 1000 );
   screen.Cursor := crArrow;
   s_btn := 0;
 end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  if s_status = 1 then begin
    timer1.Enabled := false;
    s_status := 100;
    screen.Cursor := crArrow;
    //'ShowMessage ( '未检测到手机连接。');
    self.StatusBar1.Panels[2].text := '未检测到手机连接。';
    timer2.Enabled := false;
  end;
end;

procedure TForm1.Button3Click(Sender: TObject);
begin
   //self.ApdComPort1.Baud := strtoint ( self.ComboBox2.Text );
   //self.ApdComPort1.ComNumber := strtoint ( self.ComboBox3.Text );
   //init_port_test_0 (ApdComPort1);
   form3.ShowModal ;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  s , s1, s2 :string;
begin
  //showMessage ( FloatToStr ( now() ) );
  screen.Cursor := crHourGlass;
  s :=  application.ExeName ;
  s := copy ( s, 1,  Length(s) - 7 );

  s1 := s + 'sms0.ini';
  s2 := s + 'SM0.mdb';

  inif := Tinifile.Create( s1 );
  port := inif.ReadInteger ( 'sms0', 'port', 1);
  if port > 2 then begin
    port := 1;
  end;
  baud := 19200; //inif.ReadInteger ( 'sms0', 'baud', 19200);
  trys := inif.ReadInteger ( 'sms0', 'trys', 3);
  inif.Destroy ;

  self.ADODataSet1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
         s2 + ';Persist Security Info=False';
  self.ADODataSet1.Active := true;
  self.ADODataSet2.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
         s2 + ';Persist Security Info=False';
  self.ADODataSet2.Active := true;

  self.ADOQuery1.ConnectionString := 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=' +
         s2 + ';Persist Security Info=False';
  //self.ADOQuery1.Active := true;

  Application.OnMinimize := MarkTaskBarIcon;
  MarkTaskBarIcon(Sender);


   if self.ApdComPort1.Open = true then begin
      self.ApdComPort1.Open := false;
      sleep ( 1000 );
   end;
   self.ApdComPort1.Baud := baud;
   self.ApdComPort1.ComNumber := port;
   try
      self.ApdComPort1.Open := true;
      self.ApdComPort1.PromptForPort := true;
      CRTrig := ApdComPort1.AddDataTrigger(#13, False);
      Sbegin := ApdComPort1.AddDataTrigger('>', False);
   except
      on E: Exception do begin
        self.StatusBar1.Panels[2].Text := '串口打开失败:'+ E.Message ;
        showMessage (  '串口打开失败:'+ #13+#10+ E.Message );
        screen.Cursor := crArrow;
        exit;