unit main;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, Menus, AppEvnts,ShellAPI,WinInet;
type
TForm1 = class(TForm)
btn1: TButton;
btn2: TButton;
TrayIcon1: TTrayIcon;
IdHTTP1: TIdHTTP;
aplctnvnts1: TApplicationEvents;
pm1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
btn3: TButton;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure aplctnvnts1Exception(Sender: TObject; E: Exception);
procedure TrayIcon1DblClick(Sender: TObject);
procedure aplctnvnts1Minimize(Sender: TObject);
procedure btn3Click(Sender: TObject);
private
testhost:string;
myhost:string;
bakhost:string;
syspath:string;
procedure setbtnstatus();
procedure DeleteIECache();
public
{ Public declarations }
end;
var
Form1: TForm1;
type
TGetHost = class(TThread)
private
protected
procedure execute;override;
public
constructor Create();
end;
implementation
{$R *.dfm}
procedure TForm1.setbtnstatus;
begin
if FileExists(bakhost) then
begin
btn1.Enabled := false;
btn2.Enabled := True;
end
else
begin
btn1.Enabled := true;
btn2.Enabled := false;
end;
end;
procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
Application.BringToFront;
Application.Restore;
Application.BringToFront;
Application.Restore;
Self.Show();
end;
procedure TGetHost.execute;
begin
try
Form1.testhost:=Form1.IdHTTP1.Get('http://172.20.201.3/host.txt');
except
end;
end;
constructor TGetHost.Create;
begin
inherited Create(False);
end;
procedure TForm1.aplctnvnts1Exception(Sender: TObject; E: Exception);
begin
//
end;
procedure TForm1.aplctnvnts1Minimize(Sender: TObject);
begin
Hide();
end;
procedure TForm1.btn1Click(Sender: TObject);
var
mystringlist:TStringList;
begin
TGetHost.Create;
CopyFile(PAnsiChar(myhost),PAnsiChar(bakhost),true);
mystringlist :=TStringList.Create();
mystringlist.Text:=testhost;
if testhost<>'' then
mystringlist.SaveToFile(myhost);
setbtnstatus();
ShellExecute(Handle, 'open', 'IExplore.EXE', 'http://www.bologe.com', nil, SW_SHOWNORMAL);
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
if FileExists(bakhost) then
begin
CopyFile(PAnsiChar(bakhost),PAnsiChar(myhost),false);
DeleteFile(PAnsiChar(bakhost));
end;
setbtnstatus();
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
DeleteIECache();
end;
procedure TForm1.DeleteIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil,TInternetCacheEntryInfo(nil^),dwEntrySize);//第一个参数可以指定类型
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
begin
repeat
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
FreeMem(lpEntryInfo, dwEntrySize);
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
end;
FreeMem(lpEntryInfo, dwEntrySize);
FindCloseUrlCache(hCacheDir);
ShellExecute(Handle, 'open', 'arp.EXE', '-d', nil, SW_HIDE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TGetHost.Create;
syspath := GetEnvironmentVariable('WINDIR');
myhost := syspath+'\system32\drivers\etc\hosts';
bakhost := syspath+'\system32\drivers\etc\hosts_bak';
setbtnstatus();
end;
procedure TForm1.N1Click(Sender: TObject);
begin
Application.Destroy;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Form1.Show();
end;
end.
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
IdTCPClient, IdHTTP, Menus, AppEvnts,ShellAPI,WinInet;
type
TForm1 = class(TForm)
btn1: TButton;
btn2: TButton;
TrayIcon1: TTrayIcon;
IdHTTP1: TIdHTTP;
aplctnvnts1: TApplicationEvents;
pm1: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
btn3: TButton;
procedure btn1Click(Sender: TObject);
procedure btn2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N1Click(Sender: TObject);
procedure aplctnvnts1Exception(Sender: TObject; E: Exception);
procedure TrayIcon1DblClick(Sender: TObject);
procedure aplctnvnts1Minimize(Sender: TObject);
procedure btn3Click(Sender: TObject);
private
testhost:string;
myhost:string;
bakhost:string;
syspath:string;
procedure setbtnstatus();
procedure DeleteIECache();
public
{ Public declarations }
end;
var
Form1: TForm1;
type
TGetHost = class(TThread)
private
protected
procedure execute;override;
public
constructor Create();
end;
implementation
{$R *.dfm}
procedure TForm1.setbtnstatus;
begin
if FileExists(bakhost) then
begin
btn1.Enabled := false;
btn2.Enabled := True;
end
else
begin
btn1.Enabled := true;
btn2.Enabled := false;
end;
end;
procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
Application.BringToFront;
Application.Restore;
Application.BringToFront;
Application.Restore;
Self.Show();
end;
procedure TGetHost.execute;
begin
try
Form1.testhost:=Form1.IdHTTP1.Get('http://172.20.201.3/host.txt');
except
end;
end;
constructor TGetHost.Create;
begin
inherited Create(False);
end;
procedure TForm1.aplctnvnts1Exception(Sender: TObject; E: Exception);
begin
//
end;
procedure TForm1.aplctnvnts1Minimize(Sender: TObject);
begin
Hide();
end;
procedure TForm1.btn1Click(Sender: TObject);
var
mystringlist:TStringList;
begin
TGetHost.Create;
CopyFile(PAnsiChar(myhost),PAnsiChar(bakhost),true);
mystringlist :=TStringList.Create();
mystringlist.Text:=testhost;
if testhost<>'' then
mystringlist.SaveToFile(myhost);
setbtnstatus();
ShellExecute(Handle, 'open', 'IExplore.EXE', 'http://www.bologe.com', nil, SW_SHOWNORMAL);
end;
procedure TForm1.btn2Click(Sender: TObject);
begin
if FileExists(bakhost) then
begin
CopyFile(PAnsiChar(bakhost),PAnsiChar(myhost),false);
DeleteFile(PAnsiChar(bakhost));
end;
setbtnstatus();
end;
procedure TForm1.btn3Click(Sender: TObject);
begin
DeleteIECache();
end;
procedure TForm1.DeleteIECache;
var
lpEntryInfo: PInternetCacheEntryInfo;
hCacheDir: LongWord;
dwEntrySize: LongWord;
begin
dwEntrySize := 0;
FindFirstUrlCacheEntry(nil,TInternetCacheEntryInfo(nil^),dwEntrySize);//第一个参数可以指定类型
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
hCacheDir := FindFirstUrlCacheEntry(nil, lpEntryInfo^, dwEntrySize);
if hCacheDir <> 0 then
begin
repeat
DeleteUrlCacheEntry(lpEntryInfo^.lpszSourceUrlName);
FreeMem(lpEntryInfo, dwEntrySize);
dwEntrySize := 0;
FindNextUrlCacheEntry(hCacheDir, TInternetCacheEntryInfo(nil^), dwEntrySize);
GetMem(lpEntryInfo, dwEntrySize);
if dwEntrySize > 0 then lpEntryInfo^.dwStructSize := dwEntrySize;
until not FindNextUrlCacheEntry(hCacheDir, lpEntryInfo^, dwEntrySize);
end;
FreeMem(lpEntryInfo, dwEntrySize);
FindCloseUrlCache(hCacheDir);
ShellExecute(Handle, 'open', 'arp.EXE', '-d', nil, SW_HIDE);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
TGetHost.Create;
syspath := GetEnvironmentVariable('WINDIR');
myhost := syspath+'\system32\drivers\etc\hosts';
bakhost := syspath+'\system32\drivers\etc\hosts_bak';
setbtnstatus();
end;
procedure TForm1.N1Click(Sender: TObject);
begin
Application.Destroy;
end;
procedure TForm1.N2Click(Sender: TObject);
begin
Form1.Show();
end;
end.