引言: unit PCEx; interface uses Windows, SysUtils, Classes, tlHelp32; type TEnumProcesses = function(lpidProcess: LPDWORD; cb: DWORD; var cbNeeded: DWORD): BOOL; StdCall; //external cPSAPIDLL; TGetModuleBaseNameA = function(hProcess: THandle; hModule: HMODULE; lpBaseName: PAnsiChar; nSize: DWORD): DWORD; StdCall; //external cPSAPIDLL; TGetModuleFileNameExA = function(hProcess: THandle; hModule: HMODULE; lpFilename: PAnsiChar; nSize: DWORD): DWORD; StdCall; //external cPSAPIDLL; TEnumProcessModules = function(hProcess: THandle; lphModule: LPDWORD; cb: DWORD; var lpcbNeeded: DWORD): BOOL; StdCall; //external cPSAPIDLL; function RunAppHide(appname : pchar):Integer; function RunAppNormal(appname : pchar):Integer; procedure Shutdown; procedure Reboot; procedure Logoff; procedure KillSelectedProcess(PID: integer); function ProcessesOnNT(Kill: Boolean; PName: string):Boolean; function ProcessesOnWinXX(Kill: Boolean; PName: string):Boolean; function LifeProcesses(PName: string): Boolean; procedure KillProcesses(PName: string); function ApplicationUse(fName : string) : boolean; function APRunning(fName: string): boolean; implementation var // 判斷程式是否執行 EnumProcesses: TEnumProcesses; GetModuleBaseNameA: TGetModuleBaseNameA; GetModuleFileNameExA: TGetModuleFileNameExA; EnumProcessModules: TEnumProcessModules; function RunAppNormal(appname : pchar):Integer; begin Result := WinExec(appname, SW_Normal); end; function RunAppHide(appname : pchar):Integer; begin Result := WinExec(appname, SW_HIDE); end; procedure Shutdown; const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; // Borland forgot this declaration var hToken: THandle; tkp: TTokenPrivileges; tkpo: TTokenPrivileges; zero: DWORD; VersionInfo: TOSVersionInfo; begin VersionInfo.dwOSVersionInfoSize := Sizeof(TOSVersionInfo); GetVersionEx(VersionInfo); if VersionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT then begin zero := 0; if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin //MessageBox( 0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK ); Exit; end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin //MessageBox( 0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK ); Exit; end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) // SE_SHUTDOWN_NAME if not LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then begin //MessageBox( 0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK ); Exit; end; // if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), tkpo, zero); if Boolean(GetLastError()) then begin //MessageBox( 0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK ); Exit; end // if Boolean( GetLastError() ) else begin ExitWindowsEx(EWX_POWEROFF or EWX_FORCE or EWX_SHUTDOWN, 0); end; end // if OSVersion = 'Windows NT' else begin // just shut the machine down ExitWindowsEx(EWX_POWEROFF or EWX_FORCE or EWX_SHUTDOWN, 0); end; // else end; procedure Reboot; const SE_SHUTDOWN_NAME = 'SeShutdownPrivilege'; // Borland forgot this declaration var hToken: THandle; tkp: TTokenPrivileges; tkpo: TTokenPrivileges; zero: DWORD; VersionInfo: TOSVersionInfo; begin VersionInfo.dwOSVersionInfoSize := Sizeof(TOSVersionInfo); GetVersionEx(VersionInfo); if VersionInfo.dwPlatformID = VER_PLATFORM_WIN32_NT then begin zero := 0; if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin //MessageBox( 0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK ); Exit; end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin //MessageBox( 0, 'Exit Error', 'OpenProcessToken() Failed', MB_OK ); Exit; end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) // SE_SHUTDOWN_NAME if not LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then begin //MessageBox( 0, 'Exit Error', 'LookupPrivilegeValue() Failed', MB_OK ); Exit; end; // if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) tkp.PrivilegeCount := 1; tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), tkpo, zero); if Boolean(GetLastError()) then begin //MessageBox( 0, 'Exit Error', 'AdjustTokenPrivileges() Failed', MB_OK ); Exit; end // if Boolean( GetLastError() ) else begin ExitWindowsEx(EWX_FORCE or EWX_REBOOT, 0); end; end // if OSVersion = 'Windows NT' else begin // just shut the machine down ExitWindowsEx(EWX_FORCE or EWX_REBOOT, 0); end; // else end; procedure Logoff; begin ExitWindowsEx(EWX_LOGOFF, 0); end; procedure KillSelectedProcess(PID: integer); var PH: THandle; lpExitCode: DWord; hProcess: Cardinal; begin hProcess := Int64(PID); PH := OpenProcess(PROCESS_TERMINATE or PROCESS_QUERY_INFORMATION, FALSE, hProcess); if (PH <> 0) then begin if GetExitCodeProcess(PH, lpExitCode) then TerminateProcess(PH, lpExitCode) else //MessageBox(Handle, PChar('Could not retreive the ExitCode for this process.' #13 SysErrorMessage(GetLastError)), PChar('Something went wrong...'), MB_OK); CloseHandle(PH); end else //MessageBox(Handle, PChar('Could not get access to this process.' #13 SysErrorMessage(GetLastError)), PChar('Something went wrong...'), MB_OK); Refresh; end; function ProcessesOnNT(Kill: Boolean; PName: string):Boolean; var I: Integer; pidNeeded: DWORD; PIDList: array[0..1000] of Integer; PIDName: array[0..MAX_PATH - 1] of char; PH: THandle; hMod: HMODULE; dwSize2: DWORD; AppExist: Boolean; begin AppExist := False; //HandleForm.Perform(WM_SETREDRAW, 0, 0); try if not EnumProcesses(@PIDList, 1000, pidNeeded) then raise Exception.Create('PSAPI.DLL not found! Are you sure you are running windows NT/Y2K ?'); for i := 0 to (pidNeeded div SizeOf(Integer) - 1) do begin PH := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE, PIDList[I]); if PH <> 0 then begin if GetModuleFileNameExA(PH, 0, PIDName, SizeOf(PIDName)) > 0 then begin if EnumProcessModules(PH, @hMod, SizeOf(hMod), dwSize2) then begin GetModuleFileNameExA(PH, hMod, PIDName, SizeOf(PIDName)); if (AnsiLowerCase(ExtractFileName(PIDName)) = PName) then begin AppExist := True; if (Kill) then KillSelectedProcess(PIDList[I]); end; end; CloseHandle(PH); end; end; end; finally //HandleForm.Perform(WM_SETREDRAW, 1, 0); //HandleForm.Invalidate; end; Result := AppExist; end; function ProcessesOnWinXX(Kill: Boolean; PName: string):Boolean; var aHandle: THandle; FoundOne: bool; ProcessEntry32: TProcessEntry32; ExeFile: string; AppExist: Boolean; begin AppExist := False; //HandleForm.Perform(WM_SETREDRAW, 0, 0); try aHandle := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0); if (aHandle <> 0) then try ProcessEntry32.dwSize := SizeOf(TProcessEntry32); FoundOne := Process32First(aHandle, ProcessEntry32); while (FoundOne) do begin ExeFile := ProcessEntry32.szExeFile; if (AnsiLowerCase(ExtractFileName(ExeFile)) = PName) then begin AppExist := True; if (Kill) then KillSelectedProcess(ProcessEntry32.th32ProcessID); end; ProcessEntry32.dwSize := SizeOf(TProcessEntry32); FoundOne := Process32Next(aHandle, ProcessEntry32); end; finally CloseHandle(ahandle); end; finally //HandleForm.Perform(WM_SETREDRAW, 1, 0); //HandleForm.Invalidate; end; Result := AppExist ; end; function LifeProcesses(PName: string): Boolean; var HandlePSAPI_DLL: THandle; AppExist: Boolean; begin HandlePSAPI_DLL := LoadLibrary('PSAPI.dll'); if (HandlePSAPI_DLL <> 0) then //Where on NT/2000... begin @EnumProcesses := GetProcAddress(HandlePSAPI_DLL, 'EnumProcesses'); @GetModuleBaseNameA := GetProcAddress(HandlePSAPI_DLL, 'GetModuleBaseNameA'); @GetModuleFileNameExA := GetProcAddress(HandlePSAPI_DLL, 'GetModuleFileNameExA'); @EnumProcessModules := GetProcAddress(HandlePSAPI_DLL, 'EnumProcessModules'); AppExist := ProcessesOnNT(False, PName); FreeLibrary(HandlePSAPI_DLL); end else //Where on Win95/98/ME AppExist := ProcessesOnWinXX(False, PName); Result := AppExist; end; procedure KillProcesses(PName: string); var HandlePSAPI_DLL: THandle; begin HandlePSAPI_DLL := LoadLibrary('PSAPI.dll'); if (HandlePSAPI_DLL <> 0) then //Where on NT/2000... begin @EnumProcesses := GetProcAddress(HandlePSAPI_DLL, 'EnumProcesses'); @GetModuleBaseNameA := GetProcAddress(HandlePSAPI_DLL, 'GetModuleBaseNameA'); @GetModuleFileNameExA := GetProcAddress(HandlePSAPI_DLL, 'GetModuleFileNameExA'); @EnumProcessModules := GetProcAddress(HandlePSAPI_DLL, 'EnumProcessModules'); ProcessesOnNT(True, PName); FreeLibrary(HandlePSAPI_DLL); end else //Where on Win95/98/ME ProcessesOnWinXX(True, PName); end; function ApplicationUse(fName : string) : boolean; var hSS: THandle; ProcEntry32: PROCESSENTRY32; iCount: Integer; begin Result := False; iCount := 0; hSS := CreateToolHelp32Snapshot(TH32CS_SNAPALL, 0); ProcEntry32.dwSize := sizeof(ProcEntry32); if Process32First(hSS, ProcEntry32) then begin repeat if LowerCase(ExtractFileName(StrPas(ProcEntry32.szExeFile))) = fName then begin Inc(iCount); if iCount >= 2 then begin Result := True; Break; end; end; until not Process32Next(hSS, ProcEntry32); CloseHandle(hSS); end; if Result then Exit; end; function APRunning(fName : string) : boolean; var hSS: THandle; ProcEntry32: PROCESSENTRY32; iCount: Integer; begin Result := False; iCount := 0; hSS := CreateToolHelp32Snapshot(TH32CS_SNAPALL, 0); ProcEntry32.dwSize := sizeof(ProcEntry32); if Process32First(hSS, ProcEntry32) then begin repeat if LowerCase(ExtractFileName(StrPas(ProcEntry32.szExeFile))) = fName then begin Inc(iCount); if iCount >= 1 then begin Result := True; Break; end; end; until not Process32Next(hSS, ProcEntry32); CloseHandle(hSS); end; if Result then Exit; end;