unit UnitMeshworkFairy;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, Buttons, ShellAPI, Registry, Menus,
ImgList, IniFiles;
const
MouseMsg = WM_USER + 1;
//自定义消息，用于处理用户在图标上点击鼠标的事件
Number = 100;
//用户自定义数值，在TnotifyIconDataA类型全局变量Ntida中使用
type
TMeshworkFairyForm = class(TForm)
MeshworkPanel: TPanel;
PageControl1: TPageControl;
StatusBar1: TStatusBar;
IEContorlTabSheet: TTabSheet;
NetSetTabSheet: TTabSheet;
RegSetTabSheet: TTabSheet;
HelpTabSheet: TTabSheet;
NetLimitCheckBox: TCheckBox;
AddURLPanel: TPanel;
AddURLSpeedBtn: TSpeedButton;
DelURLPanel: TPanel;
DelURLSpeedBtn: TSpeedButton;
ImportURLPanel: TPanel;
ImportURLSpeedBtn: TSpeedButton;
ClearURLPanel: TPanel;
ClearURLSpeedBtn: TSpeedButton;
URLAddressEdit: TEdit;
ViewGroupBox: TGroupBox;
ViewURLPanel: TPanel;
ViewSpeedBtn: TSpeedButton;
URLViewComboBox: TComboBox;
GroupBox1: TGroupBox;
IETitleLabel: TLabel;
IEHomepageLabel: TLabel;
IETitleEdit: TEdit;
Panel1: TPanel;
SpeedButton1: TSpeedButton;
Panel2: TPanel;
SpeedButton2: TSpeedButton;
PopupMenu_Task: TPopupMenu;
IE1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
ImageList1: TImageList;
TimeControlTabSheet: TTabSheet;
SoftSetTabSheet: TTabSheet;
AutoRunCheckBox: TCheckBox;
IEHomepageComboBox: TComboBox;
GroupBox2: TGroupBox;
CheckBox1: TCheckBox;
CheckBox2: TCheckBox;
CheckBox3: TCheckBox;
CheckBox4: TCheckBox;
CheckBox5: TCheckBox;
CheckBox6: TCheckBox;
CheckBox7: TCheckBox;
CheckBox8: TCheckBox;
CheckBox9: TCheckBox;
CheckBox10: TCheckBox;
CheckBox11: TCheckBox;
CheckBox12: TCheckBox;
CheckBox13: TCheckBox;
CheckBox14: TCheckBox;
CheckBox15: TCheckBox;
CheckBox16: TCheckBox;
CheckBox17: TCheckBox;
CheckBox18: TCheckBox;
CheckBox19: TCheckBox;
CheckBox20: TCheckBox;
Memo1: TMemo;
GroupBox3: TGroupBox;
CheckBox22: TCheckBox;
Panel3: TPanel;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
CheckBox23: TCheckBox;
CheckBox24: TCheckBox;
CheckBox25: TCheckBox;
CheckBox26: TCheckBox;
CheckBox27: TCheckBox;
CheckBox28: TCheckBox;
CheckBox29: TCheckBox;
CheckBox30: TCheckBox;
CheckBox31: TCheckBox;
CheckBox32: TCheckBox;
CheckBox33: TCheckBox;
CheckBox34: TCheckBox;
CheckBox35: TCheckBox;
CheckBox36: TCheckBox;
CheckBox37: TCheckBox;
CheckBox38: TCheckBox;
CheckBox39: TCheckBox;
CheckBox40: TCheckBox;
CheckBox41: TCheckBox;
CheckBox42: TCheckBox;
CheckBox43: TCheckBox;
CheckBox44: TCheckBox;
CheckBox45: TCheckBox;
CheckBox46: TCheckBox;
CheckBox47: TCheckBox;
CheckBox48: TCheckBox;
CheckBox49: TCheckBox;
CheckBox50: TCheckBox;
CheckBox51: TCheckBox;
CheckBox52: TCheckBox;
CheckBox53: TCheckBox;
CheckBox54: TCheckBox;
CheckBox55: TCheckBox;
CheckBox56: TCheckBox;
CheckBox57: TCheckBox;
CheckBox58: TCheckBox;
CheckBox59: TCheckBox;
CheckBox60: TCheckBox;
CheckBox61: TCheckBox;
CheckBox62: TCheckBox;
CheckBox63: TCheckBox;
CheckBox64: TCheckBox;
CheckBox65: TCheckBox;
CheckBox66: TCheckBox;
CheckBox67: TCheckBox;
CheckBox68: TCheckBox;
CheckBox69: TCheckBox;
CheckBox70: TCheckBox;
CheckBox71: TCheckBox;
CheckBox72: TCheckBox;
CheckBox73: TCheckBox;
CheckBox74: TCheckBox;
CheckBox75: TCheckBox;
CheckBox76: TCheckBox;
CheckBox77: TCheckBox;
CheckBox78: TCheckBox;
CheckBox79: TCheckBox;
CheckBox80: TCheckBox;
CheckBox81: TCheckBox;
CheckBox82: TCheckBox;
CheckBox83: TCheckBox;
CheckBox84: TCheckBox;
CheckBox85: TCheckBox;
CheckBox86: TCheckBox;
CheckBox87: TCheckBox;
CheckBox88: TCheckBox;
CheckBox89: TCheckBox;
CheckBox90: TCheckBox;
CheckBox91: TCheckBox;
CheckBox92: TCheckBox;
CheckBox93: TCheckBox;
CheckBox94: TCheckBox;
CheckBox95: TCheckBox;
CheckBox96: TCheckBox;
CheckBox97: TCheckBox;
CheckBox98: TCheckBox;
CheckBox99: TCheckBox;
CheckBox100: TCheckBox;
CheckBox101: TCheckBox;
CheckBox102: TCheckBox;
CheckBox103: TCheckBox;
CheckBox104: TCheckBox;
CheckBox105: TCheckBox;
CheckBox106: TCheckBox;
CheckBox107: TCheckBox;
CheckBox108: TCheckBox;
CheckBox109: TCheckBox;
CheckBox110: TCheckBox;
CheckBox111: TCheckBox;
CheckBox112: TCheckBox;
CheckBox113: TCheckBox;
CheckBox114: TCheckBox;
CheckBox115: TCheckBox;
CheckBox116: TCheckBox;
CheckBox117: TCheckBox;
CheckBox118: TCheckBox;
CheckBox119: TCheckBox;
CheckBox120: TCheckBox;
CheckBox121: TCheckBox;
CheckBox122: TCheckBox;
CheckBox123: TCheckBox;
CheckBox124: TCheckBox;
CheckBox125: TCheckBox;
CheckBox126: TCheckBox;
CheckBox127: TCheckBox;
CheckBox128: TCheckBox;
CheckBox129: TCheckBox;
CheckBox130: TCheckBox;
CheckBox131: TCheckBox;
CheckBox132: TCheckBox;
CheckBox133: TCheckBox;
CheckBox134: TCheckBox;
CheckBox135: TCheckBox;
CheckBox136: TCheckBox;
CheckBox137: TCheckBox;
CheckBox138: TCheckBox;
CheckBox139: TCheckBox;
CheckBox140: TCheckBox;
CheckBox141: TCheckBox;
CheckBox142: TCheckBox;
CheckBox143: TCheckBox;
CheckBox144: TCheckBox;
CheckBox145: TCheckBox;
CheckBox146: TCheckBox;
CheckBox147: TCheckBox;
CheckBox148: TCheckBox;
CheckBox149: TCheckBox;
CheckBox150: TCheckBox;
CheckBox151: TCheckBox;
CheckBox152: TCheckBox;
CheckBox153: TCheckBox;
CheckBox154: TCheckBox;
CheckBox155: TCheckBox;
CheckBox156: TCheckBox;
CheckBox157: TCheckBox;
CheckBox158: TCheckBox;
CheckBox159: TCheckBox;
CheckBox160: TCheckBox;
CheckBox161: TCheckBox;
CheckBox162: TCheckBox;
CheckBox163: TCheckBox;
CheckBox164: TCheckBox;
CheckBox165: TCheckBox;
CheckBox166: TCheckBox;
CheckBox167: TCheckBox;
CheckBox168: TCheckBox;
CheckBox169: TCheckBox;
CheckBox170: TCheckBox;
CheckBox171: TCheckBox;
CheckBox172: TCheckBox;
CheckBox173: TCheckBox;
CheckBox174: TCheckBox;
CheckBox175: TCheckBox;
CheckBox176: TCheckBox;
CheckBox177: TCheckBox;
CheckBox178: TCheckBox;
CheckBox179: TCheckBox;
CheckBox180: TCheckBox;
CheckBox181: TCheckBox;
CheckBox182: TCheckBox;
CheckBox183: TCheckBox;
CheckBox184: TCheckBox;
CheckBox185: TCheckBox;
CheckBox186: TCheckBox;
CheckBox187: TCheckBox;
CheckBox188: TCheckBox;
CheckBox189: TCheckBox;
TimeLimitCheckBox: TCheckBox;
N9: TMenuItem;
ExitMeshwork: TMenuItem;
N10: TMenuItem;
N11: TMenuItem;
ScreenControlCheckBox: TCheckBox;
NewURLEdit: TEdit;
Timer1: TTimer;
URLListBox: TListBox;
PubOpenDlg: TOpenDialog;
SetWarnPanel: TPanel;
SetWarnSpeedBtn: TSpeedButton;
ExportURLPanel: TPanel;
ExportURLSpeedBtn: TSpeedButton;
URLSaveDlg: TSaveDialog;
OtherSetGroupBox: TGroupBox;
ClearIETempPanel: TPanel;
ClearIETempSpeedBtn: TSpeedButton;
ClearIEHistoryPanel: TPanel;
ClearIEHistorySpeedBtn: TSpeedButton;
ClearDocumentPanel: TPanel;
ClearDocumentSpeedBtn: TSpeedButton;
ClearIEAddressPanel: TPanel;
ClearIEAddressSpeedBtn: TSpeedButton;
ClearIEFavoritesPanel: TPanel;
ClearIEFavoritesSpeedBtn: TSpeedButton;
Label8: TLabel;
ClearIETempCheckBox: TCheckBox;
ClearIEHistoryCheckBox: TCheckBox;
ClearDocumentCheckBox: TCheckBox;
ClearIEAddressCheckBox: TCheckBox;
ClearIEFavoritesCheckBox: TCheckBox;
OtherSetCheckBox: TCheckBox;
ConfigPasswordGroupBox: TGroupBox;
OldPassword: TLabeledEdit;
NewPassword: TLabeledEdit;
ConfigPassword: TLabeledEdit;
ModifyPanel: TPanel;
ModifySpeedBtn: TSpeedButton;
CancelPanel: TPanel;
CancelSpeedBtn: TSpeedButton;
procedure FormCreate(Sender: TObject);
procedure ViewSpeedBtnClick(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure AutoRunCheckBoxClick(Sender: TObject);
procedure NetLimitCheckBoxClick(Sender: TObject);
procedure IE1Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure AddURLSpeedBtnClick(Sender: TObject);
procedure ExitMeshworkClick(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure CheckBox22MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox69MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox93MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox117MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox141MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox165MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox189MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox27MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox28MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox29MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox30MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox31MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox32MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox33MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox26MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox25MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox24MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox23MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox35MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox36MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox37MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox38MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox39MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox40MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox41MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox42MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox43MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox44Click(Sender: TObject);
procedure CheckBox45MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure CheckBox34MouseMove(Sender: TObject;
Shift: TShiftState;
X,
Y: Integer);
procedure TimeLimitCheckBoxClick(Sender: TObject);
procedure ScreenControlCheckBoxClick(Sender: TObject);
procedure FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
procedure Timer1Timer(Sender: TObject);
procedure URLAddressEditClick(Sender: TObject);
procedure ClearURLSpeedBtnClick(Sender: TObject);
procedure DelURLSpeedBtnClick(Sender: TObject);
procedure ExportURLSpeedBtnClick(Sender: TObject);
procedure SetWarnSpeedBtnClick(Sender: TObject);
procedure ImportURLSpeedBtnClick(Sender: TObject);
procedure CheckBox2Click(Sender: TObject);
procedure OtherSetCheckBoxClick(Sender: TObject);
procedure ModifySpeedBtnClick(Sender: TObject);
procedure ClearIETempSpeedBtnClick(Sender: TObject);
procedure ClearIEHistorySpeedBtnClick(Sender: TObject);
procedure ClearDocumentSpeedBtnClick(Sender: TObject);
procedure ClearIEAddressSpeedBtnClick(Sender: TObject);
procedure ClearIEFavoritesSpeedBtnClick(Sender: TObject);
private
OldHomepage: string;
procedure ReadIni(Sender: TObject);
//从Ini文件中读取数据
procedure WriteIni(Sender: TObject);//向INI文件中写入数据
procedure MouseMessage(var Message: TMessage);
Message MouseMsg;//自定义消息处理函数，处理鼠标点击图标事件
procedure NtidaInstall;
procedure NtidaUnInstall;
procedure AppMinimize(Sender: TObject);
procedure ShowMainWindow;
public
Must:Word;
TagInfo : Boolean;
procedure SetPassword;
end;
var
MeshworkFairyForm: TMeshworkFairyForm;
ntida: TNotifyIcondataA;//用于增加和删除系统状态图标
implementation
uses UnitPassword;
{$R *.dfm}
function RegisterServiceProcess(dwprocessID,dwType:Integer):Integer;
stdcall;external 'KERNEL32.DLL';
procedure TMeshworkFairyForm.AppMinimize(Sender: TObject);
begin
ShowWindow(Application.Handle, SW_HIDE);
end;
procedure TMeshworkFairyForm.ShowMainWindow;
begin
Application.Restore;
Application.BringToFront;
end;
procedure TMeshworkFairyForm.MouseMessage(var Message: TMessage);
var
Mousept: TPoint;
//鼠标点击位置
begin
inherited;
if message.LParam = wm_rbuttonup then
begin
//用鼠标右键点击图标
getcursorpos(Mousept);
//获取光标位置
PopupMenu_Task.popup(Mousept.X, Mousept.Y);//在光标位置弹出选单
end;
if message.LParam = wm_lbuttonup then
begin
//用鼠标左键点击图标
PopupMenu_Task.FreeOnRelease;//释放PopupMenu_Task所占用的资源
Show;
end;
message.Result := 0;
end;
function Filter(URL
Char):Boolean;
var
I: Integer;
S: String;
begin
Result:=False;
S:=LowerCase(StrPas(URL));
with MeshworkFairyForm.URLListBoxdo
for I:=0 to Items.Count-1do
if pos(Items
,S)>0 then
begin
Result:=True;
Exit;
end;
end;
function EnumChildProc(hwnd:HWND;IParam:LPARAM):Bool;stdcall;
var
Buf: array[0..250] of char;
RSize: Integer;
begin
Result:=true;
GetClassName(hwnd,Buf,SizeOf(Buf));
if StrPas(Buf)='Edit' then
begin
RSize:=SendMessage(hwnd,WM_GETTEXT,SizeOf(Buf),Integer(@Buf));
if RSize>0 then
if StrPas(Buf)<>MeshworkFairyForm.NewURLEdit.Text then
if Filter(Buf) then
begin
SendMessage(hwnd,WM_SETTEXT,0,Integer(MeshworkFairyForm.NewURLEdit.Text));
PostMessage(hwnd,WM_KEYDOWN,$D,$1c0001);
PostMessage(hwnd,WM_KEYUP,$D,$c01c0001);
end;
Result:=false;
end;
end;
procedure TMeshworkFairyForm.NtidaInstall;
begin
try
Ntida.cbSize := SizeOf(TNotifyicondataa);
//指定ntida的长度
Ntida.Wnd := Handle;
//取应用程序主窗体的句柄
Ntida.uID := Number;
//用户自定义的一个数值，在uCallbackMessage参数指定的消息中使
Ntida.uFlags := nif_icon+nif_tip+nif_message;
//指定在该结构中uCallbackMessage、hIcon和szTip参数都有效
ntida.uCallbackMessage := MouseMsg;//指定的窗口消息
Ntida.hIcon := Application.Icon.handle;//指定系统状态栏显示应用程序的图标句柄
Ntida.szTip := '网络精灵1.1';//当鼠标停留在系统状态栏该图标上时，出现该提示信息
shell_notifyicona(NIM_ADD, @Ntida);//在系统状态栏增加一个新图标
ShowWindow(Handle, SW_HIDE);
//隐藏主窗体
SetWindowLong(Application.Handle,GWL_EXSTYLE,WS_EX_TOOLWINDOW);//隐藏应用程序窗口在任务栏上的显示
except
MessageBox(Handle,'程序即将退出!','错误',MB_OK+MB_ICONSTOP);
Application.Terminate;
end;
end;
procedure TMeshworkFairyForm.NtidaUnInstall;
begin
//为ntida赋值，指定各项参数
Ntida.cbSize := SizeOf(TNotifyicondataa);
Ntida.Wnd := Handle;
Ntida.uID := Number;
Ntida.uFlags := nif_icon + nif_tip + nif_message;
Ntida.uCallbackMessage := MouseMsg;
Ntida.hIcon := Application.Icon.Handle;
Ntida.szTip := '网络精灵1.1';
Shell_notifyicona(NIM_DELETE, @Ntida);//删除已有的应用程序图标
Application.Terminate;//中断应用程序运行，退出应用程序
end;
procedure TMeshworkFairyForm.Timer1Timer(Sender: TObject);
var
fwnd:THandle;
Buf,Buf2: array[0..250] of char;
begin
fwnd:=GetForegroundWindow;
GetClassName(fwnd,Buf,SizeOf(Buf));
GetWindowText(fwnd,Buf2,SizeOf(Buf2));
if (StrPas(Buf)='CabinetWClass') or (StrPas(Buf)='IEFrame') or (Pos('Netscape',StrPas(Buf2))>0) or (Pos('Opera',StrPas(Buf2))>0) or (Pos('Tencent',StrPas(buf2))>0) or (Pos('浏览',StrPas(Buf2))>0) then
EnumChildWindows(fwnd,@EnumChildProc,0);
end;
procedure TMeshworkFairyForm.ReadIni(Sender: TObject);
const
IniFileName='Meshwork.ini';
//Ini文件名=WinPath+'Meshwork.ini'
var
IniFile:TIniFile;
begin
IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniFileName);
//IniFile:=TIniFile.Create(IniFileName);//从系统Windows文件夹下读NotePad.ini
with IniFiledo
begin
AutoRunCheckBox.Checked:=ReadBool('SystemSet','AutoRun',True);
NetLimitCheckBox.Checked:=ReadBool('NetLimit','NetControl',True);
ScreenControlCheckBox.Checked:=ReadBool('SystemSet','ScreenControl',True);
end;
end;
procedure TMeshworkFairyForm.WriteIni(Sender: TObject);
const
IniFileName='Meshwork.ini';
//Ini文件名=WinPath+'Meshwork.ini'
var
IniFile:TIniFile;
begin
IniFile:=TIniFile.Create(ExtractFilePath(Application.ExeName)+IniFileName);
//IniFile:=TIniFile.Create(IniFileName);//从系统Windows文件夹下读NotePad.ini
with IniFiledo
begin
WriteBool('SystemSet','AutoRun',AutoRunCheckBox.Checked);
WriteBool('NetLimit','NetControl',AutoRunCheckBox.Checked);
WriteBool('SystemSet','ScreenControl',ScreenControlCheckBox.Checked);
end;
end;
procedure TMeshworkFairyForm.SetPassword;
var
Reg:TRegistry;
begin
if TagInfo then
begin
Reg:=TRegistry.create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software',true);
Reg.WriteString('网络精灵','1111');
finally
Reg.CloseKey;
Reg.Free;
end;
end;
end;
procedure TMeshworkFairyForm.FormCreate(Sender: TObject);
var
Reg:TRegistry;
begin
TagInfo := True;
WindowState:=wsMinimized;
Application.OnMinimize := AppMinimize;
NtidaInstall;
//初始化窗体时添加网址和关键字到列表框中
URLListBox.Items.LoadFromFile('FilterKeys.txt');
SetPassword;
Reg:=TRegistry.create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software/Microsoft/Internet Explorer/Main',true);
OldHomepage:=Reg.ReadString('Start Page');
finally
Reg.CloseKey;
end;
ReadIni(Sender);
NewURLEdit.Text:=ExtractFilePath(Application.ExeName)+'Warnning.htm';
if GlobalFindAtom('MeshworkFairy')=0 then
Must:=GlobalAddAtom('MeshworkFairy') //假如没有找到该文件则添加到系统数据库中
else
begin
MessageBox(Handle,'该程序正在运行!','警告',MB_OK+MB_ICONWARNING);
//如果程序已经运行，显示退出信息
Halt;
end;
end;
procedure TMeshworkFairyForm.FormDestroy(Sender: TObject);
begin
GlobalDeleteAtom(Must);//退出程序时，从数据表中删除添加的文件名
end;
procedure TMeshworkFairyForm.ViewSpeedBtnClick(Sender: TObject);
var
URLEdit: String;
begin
URLEdit:= Trim(URLViewComboBox.Text);
Shellexecute(Handle,'open',PChar(URLEdit),nil,nil,SW_ShowNormal);
end;
procedure TMeshworkFairyForm.SpeedButton1Click(Sender: TObject);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software/Microsoft/Internet Explorer/Main',true);
Reg.WriteString('Window Title',IETitleEdit.Text);
Reg.WriteString('Start Page',IEHomepageComboBox.Text);
finally
Reg.CloseKey;
end;
end;
procedure TMeshworkFairyForm.SpeedButton2Click(Sender: TObject);
var
Reg:TRegistry;
begin
Reg:=TRegistry.Create;
Reg.RootKey:=HKEY_CURRENT_USER;
try
Reg.OpenKey('/Software/Microsoft/Internet Explorer/Main',true);
Reg.DeleteValue('Window Title');
Reg.WriteString('Start Page',OldHomepage);
finally
Reg.CloseKey;
end;
end;
procedure TMeshworkFairyForm.AutoRunCheckBoxClick(Sender: TObject);
var RegF : TRegistry;
begin
RegF:=TRegistry.Create;
RegF.RootKey:=HKEY_LOCAL_MACHINE;
try
RegF.OpenKey('SOFTWARE/Microsoft/Windows/CurrentVersion/Run',True);
//设置开机是否自动运行
if AutoRunCheckBox.Checked then
begin
RegF.DeleteValue('MeshworkFairy');
RegF.WriteString('MeshworkFairy',Application.ExeName);
end
else
RegF.DeleteValue('MeshworkFairy');
except
with Applicationdo
MessageBox('程序内部错误',PChar(Title),MB_OK+MB_ICONERROR);
end;
RegF.CloseKey;
RegF.Free;
end;
procedure TMeshworkFairyForm.NetLimitCheckBoxClick(Sender: TObject);
begin
if NetLimitCheckBox.Checked then
begin
NetLimitCheckBox.Caption:= '取消网络限制功能';
Timer1.Enabled:=True;
end
else
begin
NetLimitCheckBox.Caption:= '启用网络限制功能';
Timer1.Enabled:=False;
end;
end;
procedure TMeshworkFairyForm.IE1Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=0;
ShowMainWindow;
end;
end;
procedure TMeshworkFairyForm.N2Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=1;
ShowMainWindow;
end;
end;
procedure TMeshworkFairyForm.N4Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=2;
ShowMainWindow;
end;
end;
procedure TMeshworkFairyForm.N6Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=3;
ShowMainWindow;
end;
end;
procedure TMeshworkFairyForm.N8Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=4;
ShowMainWindow;
end;
end;
procedure TMeshworkFairyForm.N11Click(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
PageControl1.ActivePageIndex:=5;
ShowMainWindow;
end;
end;
procedure TMeshworkFairyForm.AddURLSpeedBtnClick(Sender: TObject);
var
URLAddress: String;
I: Integer;
begin
URlAddress := Trim(URLAddressEdit.Text);
if URlAddress = '' then
begin
ShowMessage('网址、关键字不能为空');
URLAddressEdit.SetFocus;
end
else
begin
with URLListBoxdo
begin
for I:=0 to Items.count -1do
if Items=LowerCase(URLAddress) then
begin
ShowMessage('此关键字已经存在!');
Exit;
end;
URLListBox.Items.Add(LowerCase(URLAddress));
URLListBox.SetFocus;
end;
end;
end;
procedure TMeshworkFairyForm.ExitMeshworkClick(Sender: TObject);
begin
Password:=TPassword.Create(Application);
Password.ShowModal;
if Sucessful then
begin
WriteIni(Sender);
Shell_Notifyicona(NIM_DELETE, @Ntida);
NtidaUnInstall;
Free;
end;
end;
procedure TMeshworkFairyForm.CheckBox22MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[1:00-2:00]';
end;
procedure TMeshworkFairyForm.CheckBox69MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期二[1:00-2:00]';
end;
procedure TMeshworkFairyForm.CheckBox93MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期三[1:00-2:00]';
end;
procedure TMeshworkFairyForm.CheckBox117MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期四[1:00-2:00]';
end;
procedure TMeshworkFairyForm.CheckBox141MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期五[1:00-2:00]';
end;
procedure TMeshworkFairyForm.CheckBox165MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期六[1:00-2:00]';
end;
procedure TMeshworkFairyForm.CheckBox189MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期日[1:00-2:00]';
end;
procedure TMeshworkFairyForm.CheckBox27MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[2:00-3:00]';
end;
procedure TMeshworkFairyForm.CheckBox28MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[3:00-4:00]';
end;
procedure TMeshworkFairyForm.CheckBox29MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[4:00-5:00]';
end;
procedure TMeshworkFairyForm.CheckBox30MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[5:00-6:00]';
end;
procedure TMeshworkFairyForm.CheckBox31MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[6:00-7:00]';
end;
procedure TMeshworkFairyForm.CheckBox32MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[7:00-8:00]';
end;
procedure TMeshworkFairyForm.CheckBox33MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[8:00-9:00]';
end;
procedure TMeshworkFairyForm.CheckBox26MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[9:00-10:00]';
end;
procedure TMeshworkFairyForm.CheckBox25MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[10:00-11:00]';
end;
procedure TMeshworkFairyForm.CheckBox24MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[11:00-12:00]';
end;
procedure TMeshworkFairyForm.CheckBox23MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[12:00-13:00]';
end;
procedure TMeshworkFairyForm.CheckBox35MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[13:00-14:00]';
end;
procedure TMeshworkFairyForm.CheckBox36MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[14:00-15:00]';
end;
procedure TMeshworkFairyForm.CheckBox37MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[15:00-16:00]';
end;
procedure TMeshworkFairyForm.CheckBox38MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[16:00-17:00]';
end;
procedure TMeshworkFairyForm.CheckBox39MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[17:00-18:00]';
end;
procedure TMeshworkFairyForm.CheckBox40MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[18:00-19:00]';
end;
procedure TMeshworkFairyForm.CheckBox41MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[19:00-20:00]';
end;
procedure TMeshworkFairyForm.CheckBox42MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[20:00-21:00]';
end;
procedure TMeshworkFairyForm.CheckBox43MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[21:00-22:00]';
end;
procedure TMeshworkFairyForm.CheckBox44Click(Sender: TObject);
begin
Panel3.Caption := '星期一[22:00-23:00]';
end;
procedure TMeshworkFairyForm.CheckBox45MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[23:00-24:00]';
end;
procedure TMeshworkFairyForm.CheckBox34MouseMove(Sender: TObject;
Shift: TShiftState;
X, Y: Integer);
begin
Panel3.Caption := '星期一[24:00-1:00]';
end;
procedure TMeshworkFairyForm.TimeLimitCheckBoxClick(Sender: TObject);
begin
if TimeLimitCheckBox.Checked then
begin
TimeLimitCheckBox.Caption:= '取消时间限制功能';
GroupBox3.Enabled := True;
end
else
begin
TimeLimitCheckBox.Caption:= '启用时间限制功能';
GroupBox3.Enabled := False;
end;
end;
procedure TMeshworkFairyForm.ScreenControlCheckBoxClick(Sender: TObject);
var
Temp: Integer;
begin
Temp := 0;
if ScreenControlCheckBox.Checked then
begin
//屏蔽 Alt-Tab
SystemParametersInfo(SPI_SETFASTTASKSWITCH,1,@temp,0);
//屏蔽 Ctrl-Alt-Del
SystemParametersInfo( SPI_SCREENSAVERRUNNING,1,@temp,0);
ScreenControlCheckBox.Caption := '恢复功能组合键ALT+TAB、CTRL+ALT+DEL';
ScreenControlCheckBox.Hint := '恢复功能组合键ALT+TAB、CTRL+ALT+DEL';
end
else
begin
//恢复 Alt-Tab
SystemParametersInfo(SPI_SETFASTTASKSWITCH,0,@temp,0);
//恢复 Ctrl-Alt-Del
SystemParametersInfo( SPI_SCREENSAVERRUNNING,0,@temp,0);
ScreenControlCheckBox.Caption := '屏蔽功能组合键ALT+TAB、CTRL+ALT+DEL';
ScreenControlCheckBox.Hint := '屏蔽功能组合键ALT+TAB、CTRL+ALT+DEL';
end;
end;
procedure TMeshworkFairyForm.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
CanClose := False;
Application.Minimize;
Application.OnMinimize := AppMinimize;
end;
procedure TMeshworkFairyForm.URLAddressEditClick(Sender: TObject);
begin
if URLAddressEdit.Focused then
URLAddressEdit.Text:='';
end;
procedure TMeshworkFairyForm.ClearURLSpeedBtnClick(Sender: TObject);
begin
URLListBox.Clear;
end;
procedure TMeshworkFairyForm.DelURLSpeedBtnClick(Sender: TObject);
var
I: Integer;
begin
I:=0;
while I<=URLListBox.Items.Count-1do
if URLListBox.Selected then
URLListBox.Items.Delete(i)
else
Inc(I);
URLListBox.SetFocus;
end;
procedure TMeshworkFairyForm.ExportURLSpeedBtnClick(Sender: TObject);
begin
if URLSaveDlg.Execute then
URLListBox.Items.SaveToFile(URLSaveDlg.FileName);
end;
procedure TMeshworkFairyForm.SetWarnSpeedBtnClick(Sender: TObject);
begin
if PubOpenDlg.Execute then
NewURLEdit.Text := PubOpenDlg.FileName;
end;
procedure TMeshworkFairyForm.ImportURLSpeedBtnClick(Sender: TObject);
var
Num: Integer;
MyFile: TextFile;
FN,S: string;
Lines:TStrings;
begin
if PubOpenDlg.Execute then
begin
Lines:=TStringList.Create;
Lines.LoadFromFile(PubOpenDlg.FileName);
FN:=PubOpenDlg.FileName;
AssignFile(MyFile,FN);
ReSet(MyFile);
for Num:=0 to Lines.Count-1do
begin
ReadLn(MyFile,S);
if URLListBox.Items.IndexOf(LowerCase(S))=-1 then
URLListBox.Items.Add(LowerCase(S));
end;
CloseFile(MyFile);
end;
end;
procedure TMeshworkFairyForm.CheckBox2Click(Sender: TObject);
begin
if CheckBox2.Checked then
begin
try
with TRegistry.Createdo
try
RootKey := HKEY_CURRENT_USER;
OpenKey( '/Software/Microsoft/Internet Explorer', TRUE );
deletekey('TypedUrls');
createkey('TypedUrls');
finally
free;
end;
showmessage('IE地址栏网址清空完毕!,需重新打开IE后有效！');
except
showmessage('IE地址栏网址无法清空，请重启后再试!');
end;
end
else
exit;
end;
procedure TMeshworkFairyForm.OtherSetCheckBoxClick(Sender: TObject);
begin
if OtherSetCheckBox.Checked then
begin
OtherSetGroupBox.Enabled := True;
ClearIETempSpeedBtn.Enabled := True;
ClearIEHistorySpeedBtn.Enabled := True;
ClearDocumentSpeedBtn.Enabled := True;
ClearIEAddressSpeedBtn.Enabled := True;
ClearIEFavoritesSpeedBtn.Enabled := True;
end
else
begin
OtherSetGroupBox.Enabled := False;
ClearIETempSpeedBtn.Enabled := False;
ClearIEHistorySpeedBtn.Enabled := False;
ClearDocumentSpeedBtn.Enabled := False;
ClearIEAddressSpeedBtn.Enabled := False;
ClearIEFavoritesSpeedBtn.Enabled := False;
end;
end;
procedure TMeshworkFairyForm.ModifySpeedBtnClick(Sender: TObject);
var
OldPasswordText: String;
begin
OldPasswordText := OldPassword.Text;
if OldPasswordText<>'12345' then
begin
ShowMessage('原密码输入错误');
Exit;
end;
if NewPassword.Text <> ConfigPassword.Text then
Showmessage('两次输入的密码不一致');
end;
procedure TMeshworkFairyForm.ClearIETempSpeedBtnClick(Sender: TObject);
begin
ShowMessage('IE临时文件夹已清除');
end;
procedure TMeshworkFairyForm.ClearIEHistorySpeedBtnClick(Sender: TObject);
begin
ShowMessage('IE历史记录已清除');
end;
procedure TMeshworkFairyForm.ClearDocumentSpeedBtnClick(Sender: TObject);
begin
ShowMessage('文档记录已清除');
end;
procedure TMeshworkFairyForm.ClearIEAddressSpeedBtnClick(Sender: TObject);
begin
ShowMessage('IE地址栏已清除');
end;
procedure TMeshworkFairyForm.ClearIEFavoritesSpeedBtnClick(
Sender: TObject);
begin
ShowMessage('收藏夹记录已清除');
end;
end.
][
]