⭐ 欢迎来到虫虫下载站！ | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站
📤 上传资源

📄 unit_geturl.pas

📁 菜鸟猜地址(完全源码) DELPHI 源代码 菜鸟猜地址(完全源码) DELPHI 源代码
💻 PAS
📖 第 1 页 / 共 3 页
字号:
🔍
123 
//首先检查物理连接是否正常
if InternetCheckConnection('http://www.baidu.com/', 1, 0)<>True then
begin
    Showmessage('无法联接到 Internet,请检查您的网络设置');
    exit;
end;

ShowMesg:=True;
StatusBar1.Panels[1].Text:='';
if (UrlList.SelCount>0) then
begin
  if(UrlList.SelCount>6) then//如果大于六,选择是否显示提示
    if Application.MessageBox('您选择了超过五个地址进行探测,是否每个都显示提示信息？','提示信息',MB_OKCANCEL)=1 then
      ShowMesg:=true
    else
      ShowMesg:=false;

{//列表中若选中多项,则最下面选中项的index号最小,每删除一个,
列表自动重排一次,ChangeN
主要是搞定这个关系}
  ChangeN:=0;
  for n:=1 to UrlList.SelCount do
  begin
    if CheckURL(UrlList.Items.Strings[UrlList.ItemIndex-ChangeN]) then
    begin
      if ShowMesg then
      showmessage('探测成功'+#13+#10+#13+#10+UrlList.Items.Strings[UrlList.ItemIndex-ChangeN]+#13+#10+'该地址有效!');
    end
    else
    begin
      if ShowMesg then
      begin
        if Application.MessageBox(PChar('深测失败'+#13+#10+#13+#10
            +UrlList.Items.Strings[UrlList.ItemIndex-ChangeN]+#13+#10+#13+#10
            +'是否将该地址从列表中删除？'),'提示信息',MB_OKCANCEL)=1 then
        begin
          UrlList.Items.Delete(UrlList.ItemIndex-ChangeN);
          ChangeN:=ChangeN-1;
        end;
      end
      else
      begin
        UrlList.Items.Delete(UrlList.ItemIndex-ChangeN);
        ChangeN:=ChangeN-1;
      end;
    end;
    ChangeN:=ChangeN+1;
  end;
  StatusBar1.Panels[1].Text:='完成!';
  if not ShowMesg then
  showmessage('探测指定地址完成!');
end
else
    showmessage('没有找到要探测的地址！');
end;

procedure TForm_GetUrl.GetLastUrlClick(Sender: TObject);
begin
      if  self.GetLastUrl.Text='请在这里输入参考地址二(完整的)' then
        self.GetLastUrl.Text:=''
end;

procedure TForm_GetUrl.GetFistUrlClick(Sender: TObject);
begin
  if  self.GetFistUrl.Text='请在这里输入参考地址一(完整的)' then
    self.GetFistUrl.Text:=''
end;
procedure TForm_GetUrl.ShowUrlWinClick(Sender: TObject);
var UrlListStr:string;
var UrlNum:integer;
begin
StatusBar1.Panels[1].Text:='';
  with self.UrlList do
  begin
    if Items.Count>0 then
    begin
    Form_UrlShow.UrlShow.Lines.Clear;
    UrlListStr:='当前地址列表如下：'+#13+#10;
    Form_UrlShow.UrlShow.Lines.Add(UrlListStr);
      for UrlNum:=Items.Count downto 1 do
      begin
        UrlListStr:='';//首先清空
        UrlListStr:=UrlListStr+Items.Strings[UrlNum-1];
        UrlListStr:=UrlListStr+#13+#10;
        Form_UrlShow.UrlShow.Lines.Add(UrlListStr);
      end;
      Form_UrlShow.ShowModal;
    end
    else
    showmessage('清单中没有地址');
  end;
end;

procedure TForm_GetUrl.Button1Click(Sender: TObject);
var n:integer;
begin
StatusBar1.Panels[1].Text:='';
  if (UrlList.SelCount<1) then
  begin
    showmessage('未指定要打开的目标');
    exit;
  end;
  if CheckUrl(UrlList.Items.Strings[UrlList.ItemIndex])<>True then
  begin
    if Application.MessageBox('经探测该地址无效,您确定 打开 它吗?','提示信息',MB_OKCANCEL)<>1 then exit;
  end;
  IEApp:=CreateOLEObject('InternetExplorer.Application') as IWebBrowser2;
  IEApp.Visible:=False;
  IEApp.Navigate(UrlList.Items.Strings[UrlList.ItemIndex]);
end;

//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<附加事件<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<附加事件<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
procedure TForm_GetUrl.GuessAloneClick(Sender: TObject);
begin
  if self.GuessAlone.Checked=True then
    Self.GetLastUrl.Enabled:=False
  else
    Self.GetLastUrl.Enabled:=True;
end;

procedure TForm_GetUrl.GuessBalanceClick(Sender: TObject);
begin
  if self.GuessAlone.Checked=True then
    Self.GetLastUrl.Enabled:=False
  else
    Self.GetLastUrl.Enabled:=True;
end;

procedure TForm_GetUrl.ExploreTheOneMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='点击对选中的地址进行有效性检测,并删除无效地址!';
end;

procedure TForm_GetUrl.GroupBox1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='URL KING----超级偷链工具,使用愉快,^_^';
end;

procedure TForm_GetUrl.ShowUrlWinMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='点击将打开地址列表窗口 ';
end;

procedure TForm_GetUrl.Button1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='打开选中地址!';
end;

procedure TForm_GetUrl.ExploreMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='自动删除无效地址,点击后窗口将最小化,直到操作完成!';
end;

procedure TForm_GetUrl.DelGUrlMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='删除所选中的地址!';
end;

procedure TForm_GetUrl.UrlListMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='共: '+inttostr(UrlList.Items.Count)+' 个地址';
  if AntoDelFinished then
  StatusBar1.Panels[1].Text:=StatusBar1.Panels[1].Text+'  已通过筛选，全部有效!';
end;

procedure TForm_GetUrl.Panel2MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='URL KING----超级偷链工具,使用愉快,^_^';
end;

procedure TForm_GetUrl.RdGp_MaxGsUrlClick(Sender: TObject);
begin
  StatusBar1.Panels[1].Text:='您选择的猜测结果限制为: '+RdGp_MaxGsUrl.Items.Strings[RdGp_MaxGsUrl.Itemindex];
  if JerqueUrl()=True then
    SBGuessStart.Click;
end;

procedure TForm_GetUrl.GuessAloneMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='以地址一为中心,猜测周围与其同属性的地址!'+'数量限制: '+RdGp_MaxGsUrl.Items.Strings[RdGp_MaxGsUrl.Itemindex];
end;

procedure TForm_GetUrl.GuessBalanceMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='将两地址进行对比,根据两者间的差别猜测与其同属性的地址!'
  +'数量限制: '+RdGp_MaxGsUrl.Items.Strings[RdGp_MaxGsUrl.Itemindex];
end;

procedure TForm_GetUrl.GroupBox2MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='对猜测的执行方式进行设置'
end;

procedure TForm_GetUrl.ReMove0MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='将猜测结果中自动补加的零去掉,如: 0012 去掉零后为 12'
end;

procedure TForm_GetUrl.FormulaShowMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='在这里显示针对当前猜测结果的批量下载公式!'
end;

procedure TForm_GetUrl.SBGuessStartMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='还等什么,点击!'
end;

procedure TForm_GetUrl.Panel1MouseMove(Sender: TObject; Shift: TShiftState;
  X, Y: Integer);
begin
  StatusBar1.Panels[1].Text:='以一猜十，以十猜百！ 注意:地址中必须要有数字!';
  Panel1.Hint:='以一猜十，以十猜百！'+#13+#10+#13
                +'只要有一个地址----歌曲、电影、图片...,URL King 将帮助你猜测出其它同类型地址,使用愉快,^_^'+#13+#10+#13
                +'注意:地址中必须要有数字!';
end;
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>附加事件>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>附加事件>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<主菜单<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
//<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<主菜单<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
procedure TForm_GetUrl.N6Click(Sender: TObject);
begin
  GuessAlone.Checked:=true;
end;

procedure TForm_GetUrl.N7Click(Sender: TObject);
begin
  GuessBalance.Checked:=true;
end;

procedure TForm_GetUrl.N8Click(Sender: TObject);
begin
  ReMove0.Checked:=true;
end;

procedure TForm_GetUrl.N1001Click(Sender: TObject);
begin
  RdGp_MaxGsUrl.ItemIndex:=0;
end;

procedure TForm_GetUrl.N5001Click(Sender: TObject);
begin
  RdGp_MaxGsUrl.ItemIndex:=1;
end;

procedure TForm_GetUrl.N10001Click(Sender: TObject);
begin
  RdGp_MaxGsUrl.ItemIndex:=2;
end;

procedure TForm_GetUrl.N20001Click(Sender: TObject);
begin
  RdGp_MaxGsUrl.ItemIndex:=3;
end;

procedure TForm_GetUrl.N50001Click(Sender: TObject);
begin
  RdGp_MaxGsUrl.ItemIndex:=4;
end;

procedure TForm_GetUrl.N10Click(Sender: TObject);
begin
  RdGp_MaxGsUrl.ItemIndex:=5;
end;

procedure TForm_GetUrl.N11Click(Sender: TObject);
begin
  ExploreTheOne.Click;
end;

procedure TForm_GetUrl.N12Click(Sender: TObject);
begin
  ShowUrlWin.Click;
end;

procedure TForm_GetUrl.N13Click(Sender: TObject);
begin
  Button1.Click;
end;

procedure TForm_GetUrl.N15Click(Sender: TObject);
begin
  DelGUrl.Click;
end;

procedure TForm_GetUrl.N16Click(Sender: TObject);
begin
  Explore.Click;
end;

procedure TForm_GetUrl.URLKING1Click(Sender: TObject);
begin
  Showmessage('超级偷链工具，只要有一个 带数字的 歌曲地址、电影地址、图片地址...，那么'+#13+#10
              +'其它该网址上的歌曲、电影、图片...就交给URL King 去找吧，真正实现一变十，'+#13+#10
              +'十变百，百变千，千百万！！');
end;

procedure TForm_GetUrl.N3Click(Sender: TObject);
begin
  IEApp:=CreateOLEObject('InternetExplorer.Application') as IWebBrowser2;
  IEApp.Visible:=True;
  IEApp.Navigate('http://liuxy.95200.com');
end;

procedure TForm_GetUrl.MTV1Click(Sender: TObject);
begin
  UrlType:='MTV';
  showmessage('暂无此功能，请期待！');
end;

procedure TForm_GetUrl.MP31Click(Sender: TObject);
begin
  UrlType:='Music';
  showmessage('暂无此功能，请期待！');  
end;

procedure TForm_GetUrl.N21Click(Sender: TObject);
begin
  self.GuessAlone.Checked:=true;
  self.GetFistUrl.Text:='http://220.165.60.123:6666///Aaa/g/连续剧/风云2/17.rmvb';
end;

procedure TForm_GetUrl.N18Click(Sender: TObject);
begin
  self.GuessAlone.Checked:=true;
  self.GetFistUrl.Text:='http://www.c188.com/all/rmtop1000801/012.rm';
end;

procedure TForm_GetUrl.N22Click(Sender: TObject);
begin
  GuessBalance.Checked:=true;
  GetFistUrl.Text:='http://220.165.60.123:6666///Aaa/g/连续剧/风云2/05.rmvb';
  GetLastUrl.Text:='http://220.165.60.123:6666///Aaa/g/连续剧/风云2/26.rmvb';
end;

procedure TForm_GetUrl.N19Click(Sender: TObject);
begin
  GuessBalance.Checked:=true;
  GetFistUrl.Text:='http://219.149.122.178/050606/v554-/v58-/v633-/v077-/0265/7.Wma';
  GetLastUrl.Text:='http://219.149.122.178/050606/v554-/v58-/v633-/v077-/0200/7.Wma';  
end;

procedure TForm_GetUrl.ReMove0Click(Sender: TObject);
begin
if JerqueUrl()=True then 
  SBGuessStart.Click;
end;
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>主菜单>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
//>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>主菜单>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
end.
123

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -