📄 unit1.~pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics,Registry, Controls, Forms, Dialogs,
StdCtrls, Db, KDaoTable, KDaoDataBase, ExtCtrls, Buttons, sSkinProvider,
sSkinManager, sButtonControl, sCustomButton, sPanel;
type
TNetCardStruct=record
Id :DWORD; // 网卡设备号
Name :String[255]; // 网卡名
Disabled:Boolean; // 当前是否禁用
Changed :Boolean; // 是否更改过
end;
PNetCardStruct=^TNetCardStruct;
TForm1 = class(TForm)
Button1: TButton;
KADaoDatabase1: TKADaoDatabase;
KADaoTable1: TKADaoTable;
DataSource1: TDataSource;
Button3: TButton;
Edit1: TEdit;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button10: TButton;
Button11: TButton;
Button12: TButton;
Button13: TButton;
Panel1: TPanel;
ListBox1: TListBox;
Button5: TButton;
Button14: TButton;
BitBtn1: TBitBtn;
BitBtn2: TBitBtn;
sSkinManager1: TsSkinManager;
sSkinProvider1: TsSkinProvider;
sBitBtn1: TsBitBtn;
sBitBtn2: TsBitBtn;
sPanel1: TsPanel;
Label1: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure FormPaint(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button10Click(Sender: TObject);
procedure Button11Click(Sender: TObject);
procedure Button12Click(Sender: TObject);
procedure Button13Click(Sender: TObject);
procedure FormResize(Sender: TObject);
procedure Edit1KeyPress(Sender: TObject; var Key: Char);
procedure Button5Click(Sender: TObject);
procedure Button14Click(Sender: TObject);
procedure BitBtn1Click(Sender: TObject);
procedure BitBtn2Click(Sender: TObject);
procedure sBitBtn1Click(Sender: TObject);
procedure sBitBtn2Click(Sender: TObject);
private
{ Private declarations }
List:TList;
procedure EnumCards;
procedure EnableCard;
procedure DisableCard;
Procedure WMNCHitTest(var Msg: TMessage); message WM_NCHITTEST;
procedure user_sysmenu(var msg:twmmenuselect);
message wm_syscommand;
public
{ Public declarations }
end;
var
Form1: TForm1;
tmp,Flag :integer;
Key: Boolean;
procedure BeginHook; external 'HookDLL.dll';
procedure EndHook; external 'HookDLL.dll';
procedure BeginHook1; external 'HookDLL1.dll';
procedure EndHook1; external 'HookDLL1.dll';
procedure EnumNetCards(NetDeviceList:TList);external 'ChgEthernetState.dll';
function NetCardStateChange(var NetCardPoint:PNetCardStruct;Enabled:Boolean):Boolean;external 'ChgEthernetState.dll';
implementation
uses unit2;
{$R *.DFM}
procedure TForm1.EnumCards;
var I:Integer;
begin
EnumNetCards(List);
for I:=0 to List.Count-1 do ListBox1.Items.Append(PNetCardStruct(List[I]).Name);
end;
procedure TForm1.DisableCard;
var K:PNetCardStruct;
begin
K:=List[0];
NetCardStateChange(K,False);
end;
procedure TForm1.EnableCard;
var K:PNetCardStruct;
begin
K:=List[0];
NetCardStateChange(K,True);
end;
procedure TForm1.WMNCHitTest(var Msg: TMessage);
begin
inherited; // 这样,移动就不可能了...
Msg.Result := HTCLIENT;
end;
procedure TForm1.user_sysmenu(var msg:TWMMENUSELECT);
begin
if msg.iditem=100 then
showmessage(' 响应系统菜单!')
{ 也 可 以setwindowpos()来实现处于最前端功能}
else
inherited; { 作缺省处理
必须调用这一过程}
end;
procedure TForm1.Button1Click(Sender: TObject);
var
rtButton2: TRect;
//var rect:TRect;
begin
rtButton2 := form1.Panel1.BoundsRect;
MapWindowPoints(handle, 0, rtButton2, 2); // 座标换算
ClipCursor(@rtButton2); // 限制鼠标移动区域
end;
procedure TForm1.FormActivate(Sender: TObject);
begin
button1.Click;
end;
procedure TForm1.FormCreate(Sender: TObject);
Var
RegFile : TRegistry;
AppFile : String ;
//hr :thandle;
begin
KADaoDatabase1.Database:= extractfilepath(application.exename)+'db1.mdb';
KADaoDatabase1.Connected:=true;
List:=TList.Create;
//hr:=createroundrectrgn(0,0,width,height,40,40);//定义园角矩形(win API函数)
//setwindowrgn(handle,hr,true); //设置园角窗口
AppFile := Application.ExeName ;
RegFile:=TRegistry.Create;
RegFile.RootKey:=HKEY_LOCAL_MACHINE;
try
RegFile.OpenKey('SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True);
RegFile.WriteString('Test Add App to Start','"'+AppFile+'"');
except
End;
RegFile.CloseKey ;
RegFile.Free;
button6.Click;
button8.Click;
button10.Click;
button12.Click;
end;
procedure TForm1.FormShow(Sender: TObject);
var
wndHandle : THandle;
wndClass : array[0..50] of Char;
begin
EnumCards;
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_HIDE);
edit1.SetFocus;
button5.Click;
end;
procedure TForm1.Button3Click(Sender: TObject);
var
wndHandle : THandle;
wndClass : array[0..50] of Char;
begin
StrPCopy(@wndClass[0], 'Shell_TrayWnd');
wndHandle := FindWindow(@wndClass[0], nil);
ShowWindow(wndHandle, SW_RESTORE);
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
button1.Click;
end;
procedure TForm1.Button6Click(Sender: TObject);
Var
Reg:TRegistry;
begin
key:=true;
Reg:=TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then
begin
if Key then
Reg.WriteString('DisableTaskMgr','1')
else
Reg.WriteInteger('DisableTaskMgr',0);
Reg.CloseKey;
end;
except
Reg.Free;
end;
end;
procedure TForm1.Button7Click(Sender: TObject);
Var
Reg:TRegistry;
begin
key:=false;
Reg:=TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\System', True) then
begin
if Key then
Reg.WriteString('DisableTaskMgr','1')
else
Reg.WriteInteger('DisableTaskMgr',0);
Reg.CloseKey;
end;
except
Reg.Free;
end;
end;
procedure TForm1.Button8Click(Sender: TObject);
//var hmenu:integer;
//Var
//temp:integer;
begin
//SystemParametersInfo(Spi_screensaverrunning,1,@temp,0);//屏蔽键盘所有功能键;
//showwindow(findwindow('Shell_TrayWnd',nil),SW_HIDE); // 隐藏
//hmenu:=getsystemmenu(handle,false);
{获取系统菜单句柄}
BeginHook;
end;
procedure TForm1.Button9Click(Sender: TObject);
//var hmenu:integer;
//Var
//temp:integer;
begin
//SystemParametersInfo(spi_screensaverrunning,0,@temp,0);//--恢复键盘所有功能键;
//showwindow(findwindow('Shell_TrayWnd',nil),SW_NORMAL); // 恢复
//hmenu:=getsystemmenu(handle,true);
{获取系统菜单句柄}
//appendmenu(hmenu,MF_SEPARATOR,0,nil);
EndHook;
end;
procedure TForm1.Button10Click(Sender: TObject);
//Var
//temp:integer;
begin
//SystemParametersInfo(Spi_screensaverrunning,1,@temp,0);//屏蔽键盘所有功能键;
BeginHook1; //屏蔽
end;
procedure TForm1.Button11Click(Sender: TObject);
//Var
//temp:integer;
begin
//SystemParametersInfo(spi_screensaverrunning,0,@temp,0);//--恢复键盘所有功能键;
EndHook1; //恢复
end;
procedure TForm1.Button12Click(Sender: TObject);
var
hDesktop : THandle;
begin
hDesktop := FindWindow('Progman', nil); //隐藏
ShowWindow(hDesktop, SW_HIDE);
end;
procedure TForm1.Button13Click(Sender: TObject);
var
hDesktop : THandle;
begin
hDesktop := FindWindow('Progman', nil); //显示
ShowWindow(hDesktop, SW_SHOW);
end;
procedure TForm1.FormResize(Sender: TObject);
begin
button1.Click;
end;
procedure TForm1.Edit1KeyPress(Sender: TObject; var Key: Char);
begin
if ord(key)=13 then
BitBtn1.SetFocus;
end;
procedure TForm1.Button5Click(Sender: TObject);
begin
DisableCard; //禁用
end;
procedure TForm1.Button14Click(Sender: TObject);
begin
EnableCard; //启用
end;
procedure TForm1.BitBtn1Click(Sender: TObject);
var
rtScreen: TRect;
begin
if KADaoTable1.Active =true then
KADaoTable1.Active :=false;
KADaoTable1.SQL.Text :='select * from login where ([password]="' + edit1.Text+'")';
KADaoTable1.Active :=true;
if not KADaoTable1.Eof then
begin
//close;
rtScreen := Rect(0, 0, Screen.Width, Screen.Height);
ClipCursor(@rtScreen);
button3.Click;
button7.Click;
button9.Click;
button11.Click;
button13.Click;
button14.Click;
close;
end
else
begin
showmessage('密码错误,请重新输入!');
edit1.SetFocus;
exit;
end;
end;
procedure TForm1.BitBtn2Click(Sender: TObject);
begin
form2.ShowModal;
end;
procedure TForm1.sBitBtn1Click(Sender: TObject);
begin
BitBtn1.Click ;
end;
procedure TForm1.sBitBtn2Click(Sender: TObject);
begin
BitBtn2.Click ;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -