smsform.pas

delphi开发

unit smsform;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, TFlatColorComboBoxUnit, TFlatComboBoxUnit,
  ComCtrls, ExtCtrls, XP_CheckBox, OleCtrls, SHDocVw, Grids, TFlatPanelUnit,
  TFlatMemoUnit,inifiles,comobj,shlobj,shellapi,activex;

type
  Tsmsfrm = class(TForm)
    SpeedButton1: TSpeedButton;
    gb: TGroupBox;
    Label3: TLabel;
    myphonebook: TFlatComboBox;
    Label4: TLabel;
    memomsg: TMemo;
    btnsend: TSpeedButton;
    Panel1: TPanel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    mypwd: TEdit;
    mycode: TFlatComboBox;
    btntimesend: TSpeedButton;
    Shape1: TShape;
    Shape2: TShape;
    Panel2: TPanel;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    CheckBox1: TXP_CheckBox;
    TabSheet3: TTabSheet;
    Web: TWebBrowser;
    Edit1: TEdit;
    Panel3: TPanel;
    tv: TTreeView;
    sp: TSplitter;
    sg: TStringGrid;
    memosms: TFlatPanel;
    Label10: TLabel;
    Panel4: TPanel;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    GroupBox1: TGroupBox;
    edtname: TLabeledEdit;
    Label11: TLabel;
    rb1: TRadioButton;
    rb2: TRadioButton;
    edtphone: TLabeledEdit;
    Label12: TLabel;
    Memo1: TMemo;
    sg2: TStringGrid;
    frendcode: TFlatComboBox;
    Shape4: TShape;
    Shape3: TShape;
    Shape5: TShape;
    Shape6: TShape;
    Shape7: TShape;
    Shape8: TShape;
    Shape9: TShape;
    Shape10: TShape;
    Shape11: TShape;
    Shape12: TShape;
    Shape13: TShape;
    Shape14: TShape;
    Label14: TLabel;
    cbcenter: TFlatComboBox;
    Shape15: TShape;
    Shape16: TShape;
    pp1: TFlatPanel;
    pp: TPanel;
    Shape17: TShape;
    SpeedButton5: TSpeedButton;
    Shape18: TShape;
    procedure SpeedButton1Click(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure CheckBox1Click(Sender: TObject);
    procedure PageControl1Change(Sender: TObject);
    procedure WebDocumentComplete(Sender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    procedure FormCreate(Sender: TObject);
    procedure btnsendClick(Sender: TObject);
    procedure WebBeforeNavigate2(Sender: TObject; const pDisp: IDispatch;
      var URL, Flags, TargetFrameName, PostData, Headers: OleVariant;
      var Cancel: WordBool);
    procedure mycodeClick(Sender: TObject);
    procedure mypwdClick(Sender: TObject);
    procedure frendcodeClick(Sender: TObject);
    procedure memomsgChange(Sender: TObject);
    procedure spMoved(Sender: TObject);
    procedure tvClick(Sender: TObject);
    procedure sgMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure tvMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure sgDblClick(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure sg2MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure SpeedButton4Click(Sender: TObject);
    procedure sg2Click(Sender: TObject);
    procedure myphonebookChange(Sender: TObject);
    procedure edtnameKeyPress(Sender: TObject; var Key: Char);
    procedure edtphoneKeyPress(Sender: TObject; var Key: Char);
    procedure SpeedButton3Click(Sender: TObject);
    procedure sg2DblClick(Sender: TObject);
    procedure Shape10MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure btntimesendClick(Sender: TObject);
    procedure memomsgKeyPress(Sender: TObject; var Key: Char);
    procedure cbcenterChange(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure Shape17MouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  smsfrm: Tsmsfrm;
  c,r:integer;
  cr,cr1:integer;
  url:string;
  procedure sendsms(sender:tobject;tmpurl:string);
  procedure sendsohu(sender:tobject;tmpurl:string);
  procedure sendsina(sender:tobject;tmpurl:string);
  procedure sendchina(sender:tobject;tmpurl:string);
  procedure createico(s:string;s1:string);
implementation
  uses smsdll, loginform, modiform, regform, sendform;
{$R *.dfm}
procedure createico(s:string;s1:string);//s:程序名称　s1:快捷方式名称
var
   tmo:iunknown;
   tms:ishelllink;
   tmpf:ipersistfile;
   pidl:pitemidlist;
   sd:array[0..max_path] of char;
   sf,ss:string;
   linkf:widestring;//must use shlobj,comobj,activex in uses unit
begin
  sf:=s;
  tmo:=createcomobject(clsid_shelllink);
  tms:=tmo as ishelllink;
  tmpf:=tmo as ipersistfile;
  s:=extractfilepath(s);
  tms.SetPath(pchar(sf));
  tms.setworkingdirectory(pchar(s));
  shgetspecialfolderlocation(0,csidl_desktopdirectory,pidl);
  shgetpathfromidlist(pidl,sd);
  ss:=sd;
  ss:=ss+'\'+(s1)+'.lnk';
  linkf:=ss;
  tmpf.save(pwchar(linkf),false);
end;

procedure sendsina(sender:tobject;tmpurl:string);
var
   i,j,ok:integer;
   doc:olevariant;
begin
   ok:=0;
   doc:=(sender as twebbrowser).document;
   j:=doc.all.length;
   with smsfrm do
   begin
   for i:=0 to j-1 do
   begin
     if (doc.all.item(i).tagname='INPUT')or
        (doc.all.item(i).tagname='TEXTAREA') then
     begin
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='text')and
          (doc.all.item(i).name='mob1') then //对方手机号
       begin
           inc(ok);  //=1
           doc.all.item(i).value:=frendcode.Text;
       end;
       if(doc.all.item(i).tagname='TEXTAREA')and
         (doc.all.item(i).name='msg') then//内容
       begin
           inc(ok);  //=2
           doc.all.item(i).value:=memomsg.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='text')and
          (doc.all.item(i).name='user') then //我的手机号
       begin
           inc(ok);//=3
           doc.all.item(i).value:=mycode.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='password') and
          (doc.all.item(i).name='passwd') then //密码
       begin
           inc(ok); //=4
           //if ok>4 then
             doc.all.item(i).value:=mypwd.Text;
       end;
       if (doc.all.item(i).tagname='INPUT') and
          (doc.all.item(i).type='checkbox') and
          (doc.all.item(i).name='time') then
       begin
           inc(ok);//=5
           doc.all.item(i).checked:=false;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='submit')and
          (doc.all.item(i).value=' 发送 ') then //发送按钮
       begin
           inc(ok);//=6
           if ok=6 then
             doc.all.item(i).click;
       end;
     end;
   end;
  end;
end;

procedure sendchina(sender:tobject;tmpurl:string);
var
   i,j,ok:integer;
   doc:olevariant;
begin
   ok:=0;
   doc:=(sender as twebbrowser).document;
   j:=doc.all.length;
   with smsfrm do
   begin
   for i:=0 to j-1 do
   begin
     if (doc.all.item(i).tagname='INPUT')or
        (doc.all.item(i).tagname='TEXTAREA') then
     begin
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).name='to_mobile') then //对方手机号
       begin
           inc(ok);  //=1
           doc.all.item(i).value:=frendcode.Text;
       end;
       if(doc.all.item(i).tagname='TEXTAREA')and
         (doc.all.item(i).name='message') then//内容
       begin
           inc(ok);  //=2
           doc.all.item(i).value:=memomsg.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).name='mymobile') then //我的手机号
       begin
           inc(ok);//=3
           doc.all.item(i).value:=mycode.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='password') and
          (doc.all.item(i).name='mypasswd') then //密码
       begin
           inc(ok); //=4
           //if ok>4 then
             doc.all.item(i).value:=mypwd.Text;
       end;
//       if (doc.all.item(i).tagname='INPUT') and
//          (doc.all.item(i).type='checkbox') and
//          (doc.all.item(i).name='isflash') then
//       begin
//           inc(ok);//=5
//           doc.all.item(i).checked:=false;
//       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='image')and
          (pos('left_009.gif',doc.all.item(i).src)>0) then //发送按钮
       begin
           inc(ok);//=5
           if ok=5 then
             doc.all.item(i).click;
       end;
     end;
   end;
  end;
end;

procedure sendsohu(sender:tobject;tmpurl:string);
var
   i,j,ok:integer;
   doc:olevariant;
begin
   ok:=0;
   doc:=(sender as twebbrowser).document;
   j:=doc.all.length;
   with smsfrm do
   begin
   for i:=0 to j-1 do
   begin
     if (doc.all.item(i).tagname='INPUT')or
        (doc.all.item(i).tagname='TEXTAREA') then
     begin
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='text')and
          (doc.all.item(i).name='tonumber') then //对方手机号
       begin
           inc(ok);  //=1
           doc.all.item(i).value:=frendcode.Text;
       end;
       if(doc.all.item(i).tagname='TEXTAREA')and
         (doc.all.item(i).name='message') then//内容
       begin
           inc(ok);  //=2
           doc.all.item(i).value:=memomsg.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='text')and
          (doc.all.item(i).name='usernumber') then //我的手机号
       begin
           inc(ok);//=3
           doc.all.item(i).value:=mycode.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='password') and
          (doc.all.item(i).name='password') then //密码
       begin
           inc(ok); //=4
           if ok>4 then
             doc.all.item(i).value:=mypwd.Text;
       end;
       if (doc.all.item(i).tagname='INPUT') and
          (doc.all.item(i).type='checkbox') and
          (doc.all.item(i).name='isflash') then
       begin
           inc(ok);//=5
           doc.all.item(i).checked:=false;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='submit')and
          (doc.all.item(i).value='发送') then //发送按钮
       begin
           inc(ok);//=6
           if ok=7 then
             doc.all.item(i).click;
       end;
     end;
   end;
  end;
end;


procedure sendsms(sender:tobject;tmpurl:string);
var
   i,j,ok:integer;
   doc:olevariant;
begin
   ok:=0;
   doc:=(sender as twebbrowser).document;
   j:=doc.all.length;
  if pos('WWW.SMSCHINA.COM',uppercase(tmpurl))>0 then
  begin
   with smsfrm do
   begin
   for i:=0 to j-1 do
   begin
     if (doc.all.item(i).tagname='INPUT')or
        (doc.all.item(i).tagname='TEXTAREA') then
     begin
          if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='text')and
          (doc.all.item(i).name='phone') then //对方手机号
       begin
           inc(ok);  //=1
           doc.all.item(i).value:=frendcode.Text;
       end;
       if(doc.all.item(i).tagname='TEXTAREA')and
         (doc.all.item(i).name='content') then//内容
       begin
           inc(ok);  //=2
           doc.all.item(i).value:=memomsg.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='text')and
          (doc.all.item(i).name='mycode') then //我的手机号
       begin
           inc(ok);//=3
           doc.all.item(i).value:=mycode.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and
          (doc.all.item(i).type='password') and
          (doc.all.item(i).name='mypw') then //密码
       begin
           inc(ok); //=4
           doc.all.item(i).value:=mypwd.Text;
       end;
       if (doc.all.item(i).tagname='INPUT')and