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

📄 unit1.~pas

📁 当运行本软件时
💻 ~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 + -