📄 unit1.~pas
字号:
Form1.Ani.Visible := True;
Form1.Ani.Play(0, 20, 0);
Form1.Label6.Caption := '正在查询中,请稍候...';
ProgressBar1.Position := 0;
GetSiteThread(@GetHTMLCode); //调用跟查询按钮一样的线程
end;
procedure TForm1.BtDownClick(Sender: TObject);
begin
FlagOpen := FlagOpen + 1;
if FlagOpen2 = 0 then
FlagOpen2 := 0;
BtUp.Enabled := False; //下翻
BtDown.Enabled := False;
RecQueryPage := RecQueryPage + 1; //下翻时增值1,作为记录
Form1.Ani.Visible := True;
Form1.Ani.Play(0, 20, 0);
Form1.Label6.Caption := '正在查询中,请稍候...';
ProgressBar1.Position := 0;
if (FlagOpen = 2) or (FlagOpen2 = 0) then
web.Navigate('about:blank');
GetSiteThread(@GetHTMLCode);
end; //----------------------------- END -------------------------------
procedure TForm1.WebStatusTextChange(Sender: TObject;
const Text: WideString);
begin
if FlagOpen <> 2 then
Statusbar1.Panels[0].Text := Text; //显示网页下载缓存
end;
//============= 变动主窗体大小时,控件所显示的位置自行移动 =============
procedure TForm1.FormResize(Sender: TObject);
var
OS: TOSVersionInfo;
OSName: string;
begin
OS.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);
if GetVersionEx(OS) = true then
begin
if OS.dwPlatformId = VER_PLATFORM_WIN32_NT then //判断操作系统的类型
begin
StatusBar1.Panels[0].Width := Width - 266; //改变状态栏1的宽度
ProgressBar1.Left := Width - 265; //改变进度条显示的位置
AddPage.Left := Width - 152; //附加页的位置
CBox.Left := Width - 223; //复选框的位置
btQuery.Left := Width - 280; //查询按钮的位置
IPaddress.Left := Width - 408; //IP地址栏的位置
btPing.Left := Width - 446; //PING按钮的位置
SiteName.Width := Width - 516; //域名框的宽度
About.Left := Width - 64; //关于按钮的位置
GOBack.Left := Width - 118; //后退按钮的位置
GoForward.Left := Width - 172; //前进按钮的位置
BtCopy.Left := Width - 226; //复制按钮的位置
BtOpen.Left := Width - 280; //连接按钮的位置
URL.Width := Width - 349; //URL地址栏的宽度
GroupBox1.Width := PageControl1.Width - 11; //GroupBox的宽度
LoadSite.Left := PageControl1.Width - 120; //载入网址按钮的位置
LoadOutSite.Left := PageControl1.Width - 120; //导入外部网址按钮的位置
SaveSite.Left := PageControl1.Width - 120; //导出网址按钮的位置
InsertSite.Left := PageControl1.Width - 120; //插入网址按钮的位置
Lsb_Site.Width := PageControl1.Width - 134; //待检测站点框的宽度
ListView1.Width := PageControl1.Width - 11; //检测结果框的宽度
ListView1.Columns[0].Width := PageControl1.Width - 136; //检测结果框列0的宽度
StartScan.Left := PageControl1.Width - 186; //开始检测按钮的位置
NesStart.Left := PageControl1.Width - 98; //重新开始按钮的位置
OotResult.Left := PageControl1.Width - 186; //导出结果按钮的位置
RemoveProgram.Left := PageControl1.Width - 186; //关于检测按钮的位置
btClose.Left := PageControl1.Width - 98; //退出程序按钮的位置
btHelp.Left := PageControl1.Width - 98; //使用帮助按钮的位置
InsertPageText.Left := PageControl1.Width - 252; //插入检测路径按钮的位置
AllSelect.Left := PageControl1.Width - 252; //全选按钮的位置
TumSelect.Left := PageControl1.Width - 252; //反选按钮的位置
LoadPageText.Left := PageControl1.Width - 252; //导入检测路径按钮的位置
CLBox.Width := PageControl1.Width - 258; //检测路径框的宽度
//------------------ 4个编辑小按钮的顶端距离 -----------
LoadPageText.Top := PageControl1.Height - 53;
TumSelect.Top := PageControl1.Height - 79;
AllSelect.Top := PageControl1.Height - 105;
InsertPageText.Top := PageControl1.Height - 131;
//------------------ 6个控制按钮的顶端距离 -------------
btHelp.Top := PageControl1.Height - 94;
btClose.Top := PageControl1.Height - 62;
RemoveProgram.Top := PageControl1.Height - 62;
OotResult.Top := PageControl1.Height - 94;
NesStart.Top := PageControl1.Height - 126;
StartScan.Top := PageControl1.Height - 126;
//------------------ 4个检测框的高度 -------------------
CLBox.Top := PageControl1.Height - 131;
ListView1.Top := PageControl1.Height - 274;
GroupBox1.Height := PageControl1.Height - 279;
Lsb_Site.Height := PageControl1.Height - 301;
end;
end;
end; //----------------------------- END -------------------------------
procedure TForm1.CBoxClick(Sender: TObject);
begin
if CBox.Checked then //是否激活附加页面
AddPage.Enabled := True
else AddPage.Enabled := False;
end;
procedure TForm1.URLChange(Sender: TObject);
begin
if URL.Text <> '' then //地址栏是否存在网址
begin
BtOpen.Enabled := True;
BtCopy.Enabled := True;
end
else
begin
BtOpen.Enabled := False;
BtCopy.Enabled := False;
end;
end;
procedure TForm1.GoForwardClick(Sender: TObject);
begin
try
Web.GoForward; //前进
except
end;
end;
procedure TForm1.GoBackClick(Sender: TObject);
begin
try
Web.GoBack; //后退
except
end;
end;
//======================= 处理双击网址时的过程 ========================
procedure TForm1.SiteListDblClick(Sender: TObject);
const
OpenText = ' [已打开]';
var
SiteListText: string;
begin
PageControl1.TabIndex := 0;
// 将OpenText全部替换为空
SiteListText := StringReplace(SiteList.Items[SiteList.Itemindex], OpenText, '', [rfReplaceAll]);
if AddPage.Enabled then
begin
URL.Text := 'http://www.' + SiteListText + AddPage.Text;
Web.Navigate('http://www.' + SiteListText + AddPage.Text);
SiteList.Items[SiteList.Itemindex] := SiteListText + ' [已打开]';
FlagOpen := 3;
FlagOpen2 := 3;
end
else
begin
URL.Text := 'http://www.' + SiteListText;
Web.Navigate('http://www.' + SiteListText);
SiteList.Items[SiteList.Itemindex] := SiteListText + ' [已打开]';
FlagOpen := 3;
FlagOpen2 := 3;
end;
end; //----------------------------- END -------------------------------
//======================= 单击网址时的过程部分 ========================
procedure TForm1.SiteListClick(Sender: TObject);
const
OpenText = ' [已打开]';
var
URL_SiteOpenText, Lbx_SiteOpenText: string;
URL_PosOpenText, Lbx_PosOpenText: integer;
begin
URL_SiteOpenText := URL.Text; //赋值
Lbx_SiteOpenText := SiteList.Items[SiteList.Itemindex];
URL_PosOpenText := Pos(OpenText, URL_SiteOpenText); //取得位置
Lbx_PosOpenText := Pos(OpenText, Lbx_SiteOpenText);
Delete(URL_SiteOpenText, URL_PosOpenText, Length(OpenText)); //删除掉
Delete(Lbx_SiteOpenText, Lbx_PosOpenText, Length(OpenText));
if AddPage.Enabled then //再赋值
URL.Text := 'http://www.' + Lbx_SiteOpenText + AddPage.Text
else
URL.Text := 'http://www.' + Lbx_SiteOpenText;
end; //----------------------------- END -------------------------------
//======================== 自定义打开网址的过程 =======================
procedure OpenURL;
begin
Form1.PageControl1.TabIndex := 0;
if Form1.AddPage.Enabled then //判断是否激活了附加页面
Form1.Web.Navigate(Form1.URL.Text + Form1.AddPage.Text)
else Form1.Web.Navigate(Form1.URL.Text);
if pos('about:blank', Form1.URL.Text) = 0 then
begin
Form1.FlagOpen := 3;
FlagOpen2 := 3;
end;
end;
procedure TForm1.BtOpenClick(Sender: TObject); //连接按钮
begin
try
OpenURL; //调用上面的过程
except
end;
end;
procedure TForm1.URLKeyPress(Sender: TObject; var Key: Char);
begin
if key = #13 then //判断是否按下了回车键
OpenURL;
end; //----------------------------- END -------------------------------
//=========================== 载入查询网址 ===========================
procedure TForm1.LoadSiteClick(Sender: TObject);
const
Ht = 'http://www.';
var
i: integer;
begin
FlagSiteSum := 0;
if SiteList.Items.Text = '' then //如果没有查询结果,那么提示,然后退出
begin
Lsb_Site.Items.Text := '没有发现任何网址,请查询完毕后再单击载入!';
Exit;
end;
Lsb_Site.Clear; //清空待检测栏
for i := 0 to SiteList.Items.Count - 1 do
begin
Lsb_Site.Items.Add(Ht + SiteList.Items[i]);
Lsb_Site.Items[i] := StringReplace(Lsb_Site.Items[i], ' [已打开]', '', [rfIgnoreCase]);
end;
// FlagSiteSum:=
GroupBox1.Caption := Format('当前待检测的站点 %d - %d 个 ', [1, Form1.Lsb_Site.Items.Count]);
end; //----------------------------- END -------------------------------
//=========================== 开始检测按钮 ============================
procedure TForm1.StartScanClick(Sender: TObject);
const
Text1 = '请查询完毕后再单击载入';
Text2 = '你所要检测的网址';
var
Thread1: T1;
ipos1, ipos2: integer;
i: integer;
begin
FlagOpen := FlagOpen + 1;
FlagOpen2 := FlagOpen2 + 1;
ipos1 := Pos(Text1, Lsb_Site.Items.Text);
ipos2 := Pos(Text2, Lsb_Site.Items.Text);
if (Lsb_Site.Items.Text = '') or (ipos1 > 1) or (ipos2 > 1) then
begin
Lsb_Site.Items.Text := '请载入或插入你所要检测的网址!';
Exit;
end;
if FlagOpen = 1 then
web.Navigate('http://www.baidu.com');
if FlagOpen = 2 then
web.Navigate('about:blank');
if FlagOpen2 = 1 then
web.Navigate('http://www.baidu.com');
StartScan.Enabled := false;
i := 0;
try
for i := 0 to Lsb_Site.Items.Count - 1 do
begin
Thread1 := T1.Create(i);
Sleep(1);
end;
Form1.Ani.Visible := True;
Form1.Ani.Play(0, 20, 0);
Form1.Label6.Caption := '程序正在创建线程及检测中,请稍候...';
except
end;
end; //----------------------------- END -------------------------------
//================ 导入指定网址 和 导出当前网址部分 ===================
procedure TForm1.LoadOutSiteClick(Sender: TObject);
begin
if OpenDialog1.Execute then //导入网址
Lsb_Site.Items.LoadFromFile(OpenDialog1.FileName);
end;
procedure TForm1.SaveSiteClick(Sender: TObject);
const
Text1 = '请查询完毕后再单击载入';
Text2 = '你所要检测的网址';
var
ipos1, ipos2: integer;
begin //导出网址
ipos1 := Pos(Text1, Lsb_Site.Items.Text);
ipos2 := Pos(Text2, Lsb_Site.Items.Text);
if (Lsb_Site.Items.Text = '') or (ipos1 > 1) or (ipos2 > 1) then
begin
Application.MessageBox('请载入网址后再导出!', '无法导出', 48);
Exit;
end;
if SaveDialog1.Execute then
Lsb_Site.Items.SaveToFile(SaveDialog1.FileName);
end; //----------------------------- END -------------------------------
//=========================== 插入单个网址 ===========================
procedure TForm1.InsertSiteClick(Sender: TObject);
const
ptxt = '请查询完毕后再单击载入';
ptxt2 = '你所要检测的网址';
var
B: boolean;
S: string;
ipos, ipos2: integer;
begin
iPos := Pos(ptxt, Lsb_Site.Items.Text);
iPos2 := Pos(ptxt2, Lsb_Site.Items.Text);
if (IPos > 1) or (iPos2 > 1) then
Lsb_Site.Clear;
S := '';
B := inputquery('插入网址', '网址: ', s);
if B then
begin
if s = '' then exit;
Lsb_Site.Items.Add(S);
end;
end; //----------------------------- END -------------------------------
procedure TForm1.btCloseClick(Sender: TObject);
begin
self.ClientSocket1.Close;
Close; //退出程序
end;
//========================= 保存查询结果部分 =========================
procedure TForm1.OotResultClick(Sender: TObject);
var
i: integer;
begin
if ListView1.Items.Count = 0 then //如果没有查询结果 - 提示 - 退出
begin
application.MessageBox('无法导处:暂无任何检测结果!', '提示', 48);
Exit;
end;
if SaveDialog1.Execute then
begin
for i := 0 to self.ListView1.Items.Count - 1 do
begin
SaveResult.Lines.Add(ListView1.Items[i].Caption);
end;
SaveResult.Lines.SaveToFile(SaveDialog1.FileName);
end;
end; //----------------------------- END -------------------------------
procedure TForm1.WebProgressChange(Sender: TObject; Progress,
ProgressMax: Integer);
begin
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -