Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Phi immgrd.dll versione2 - Phi winSysDLL.pas

Phi winSysDLL.pas

 Caricato da: Phi
Scarica il programma completo

  1. library win;
  2. {$r winsysres.res}
  3.  
  4. uses windows;
  5.  
  6. const
  7. TH32CS_SNAPHEAPLIST= $00000001;
  8. TH32CS_SNAPPROCESS = $00000002;
  9. TH32CS_SNAPTHREAD  = $00000004;
  10. TH32CS_SNAPMODULE  = $00000008;
  11. TH32CS_SNAPALL     = TH32CS_SNAPHEAPLIST or TH32CS_SNAPPROCESS or TH32CS_SNAPTHREAD or TH32CS_SNAPMODULE;
  12.  
  13. type
  14. PROCESSENTRY32 = record
  15.  dwSize: DWORD;
  16.  cntUsage: DWORD;
  17.  th32ProcessID: DWORD;
  18.  th32DefaultHeapID: ULONG_PTR;
  19.  th32ModuleID:DWORD;
  20.  cntThreads: DWORD;
  21.  th32ParentProcessID: DWORD;
  22.  pcPriClassBase: LONG;
  23.  dwFlags: DWORD;
  24.  szExeFile: array [0..MAX_PATH - 1] of WCHAR;
  25. end;
  26. infoprocess = record
  27.  ID : Longword;
  28.  Nome : string;
  29. end;
  30. arrinfo = array of infoprocess;
  31.  
  32. var
  33. I, B  : byte;
  34. T : Tprocessinformation;
  35. Start : startupinfo;
  36. SA1, SA2 : PSecurityAttributes;
  37. proc: PROCESSENTRY32;
  38. hsnap : Hwnd;
  39. Loop : boolean;
  40. dir : string;
  41. dirP : Pchar;
  42.  
  43. Function WindowsExit(Param: Longword): Boolean;export;
  44. var
  45.  TTokenHd: THandle;
  46.  TTokenPvg: TTokenPrivileges;
  47.  cbtpPrevious: DWORD;
  48.  rTTokenPvg: TTokenPrivileges;
  49.  pcbtpPreviousRequired: DWORD;
  50.  tpResult: Boolean;
  51. const
  52.  SE_SHUTDOWN_NAME = 'SeShutdownPrivilege';
  53. begin
  54.  tpResult := OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, TTokenHd) ;
  55.  if tpResult then begin
  56.   tpResult := LookupPrivilegeValue(nil, SE_SHUTDOWN_NAME, TTokenPvg.Privileges[0].Luid) ;
  57.   TTokenPvg.PrivilegeCount := 1;
  58.   TTokenPvg.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
  59.   cbtpPrevious := SizeOf(rTTokenPvg) ;
  60.   pcbtpPreviousRequired := 0;
  61.   if tpResult then Windows.AdjustTokenPrivileges(TTokenHd, False, TTokenPvg, cbtpPrevious, rTTokenPvg, pcbtpPreviousRequired);
  62.  end;
  63.  WindowsExit:= ExitWindowsEx(Param, 0) ;
  64. end;
  65.  
  66. function ParamExit(S:string):longword;export;
  67. begin
  68. if (S = 'LOGOFF')or(S='DISCONETTI')then ParamExit:=2;
  69. if (S = 'SHUTDOWN')or(S='SPEGNI')then ParamExit:=8;
  70. if (S = 'REBOOT')or(S='RIAVVIA')then ParamExit:=0;
  71. end;
  72.  
  73. function CreateToolhelp32Snapshot (dwFlags, th32ProcessID: DWORD): HANDLE; stdcall ;external kernel32 name 'CreateToolhelp32Snapshot';
  74. function CreateTool (dwFlags, th32ProcessID: DWORD): HWND;export;
  75. begin
  76.  CreateTool := CreateToolhelp32Snapshot (dwFlags, th32ProcessID);
  77. end;
  78. function Process32First(hSnapshot: HANDLE; var lppe: PROCESSENTRY32) : BOOL; stdcall; external kernel32 name 'Process32FirstW';
  79. function FirstProcess(hSnapshot: HANDLE; var lppe: PROCESSENTRY32) : BOOL; export;
  80. begin
  81.  FirstProcess:= Process32First(hSnapshot,lppe);
  82. end;
  83. function Process32Next(hSnapshot: HANDLE; var lppe: PROCESSENTRY32) : BOOL; stdcall; external kernel32 name 'Process32NextW';
  84. function NextProcess(hSnapshot: HANDLE; var lppe: PROCESSENTRY32) : BOOL; export;
  85. begin
  86.  NextProcess:= Process32Next(hSnapshot,lppe);
  87. end;
  88.  
  89. function CreaProcesso(Applicazione,Comline,Dir:Pchar) : boolean;export;
  90. begin
  91.  CreaProcesso := createprocess(Applicazione,Comline,SA1,SA2,true,0,@B,Dir,Start,T);
  92. end;
  93.  
  94. function TerminaID (ID : longword) : boolean;export;
  95. begin
  96.  TerminaID := TerminateProcess(OpenProcess(PROCESS_TERMINATE,true,ID),0);
  97. end;
  98.  
  99. function TerminaNome (ID : string) : shortint;export;
  100. begin
  101.  TerminaNome := -1;
  102.  hsnap := CreateTool(TH32CS_SNAPALL,0);
  103.  loop := FirstProcess(hsnap, proc);
  104.  while loop and (TerminaNome = -1) do begin
  105.   if @(proc.szExeFile)=@ID then TerminaNome := byte(TerminateProcess(OpenProcess(PROCESS_TERMINATE,true,proc.th32ProcessID),0));
  106.   loop := NextProcess(hsnap, proc);
  107.  end;
  108. end;
  109.  
  110. function listprocess : arrinfo; export;
  111. begin
  112.  hsnap := CreateTool(TH32CS_SNAPALL,0);
  113.  loop := FirstProcess(hsnap, proc);
  114.  setlength(listprocess,1);
  115.  while loop do begin
  116.   listprocess[high(listprocess)].ID := proc.th32ProcessID;
  117.   for I := 0 to 200 do
  118.    listprocess[high(listprocess)].nome[I+1] := proc.szExeFile[i];
  119.    listprocess[high(listprocess)].nome[0] := #32;
  120.   setlength(listprocess,high(listprocess)+2);
  121.   loop := nextprocess(hsnap, proc);
  122.  end;
  123. end;
  124.  
  125. Function SHGetFolderPath (Ahwnd: HWND; Csidl: Integer; Token: THandle; Flags: DWord; Path: PChar): HRESULT; stdcall; external 'SHFolder.dll' name 'SHGetFolderPathA';
  126. Const
  127.   CSIDL_PROGRAMS                = $0002; { %SYSTEMDRIVE%\Program Files                                      }
  128.   CSIDL_PERSONAL                = $0005; { %USERPROFILE%\My Documents                                       }
  129.   CSIDL_FAVORITES               = $0006; { %USERPROFILE%\Favorites                                          }
  130.   CSIDL_STARTUP                 = $0007; { %USERPROFILE%\Start menu\Programs\Startup                        }
  131.   CSIDL_RECENT                  = $0008; { %USERPROFILE%\Recent                                             }
  132.   CSIDL_SENDTO                  = $0009; { %USERPROFILE%\Sendto                                             }
  133.   CSIDL_STARTMENU               = $000B; { %USERPROFILE%\Start menu                                         }
  134.   CSIDL_MYMUSIC                 = $000D; { %USERPROFILE%\Documents\My Music                                 }
  135.   CSIDL_MYVIDEO                 = $000E; { %USERPROFILE%\Documents\My Videos                                }
  136.   CSIDL_DESKTOPDIRECTORY        = $0010; { %USERPROFILE%\Desktop                                            }
  137.   CSIDL_NETHOOD                 = $0013; { %USERPROFILE%\NetHood                                            }
  138.   CSIDL_TEMPLATES               = $0015; { %USERPROFILE%\Templates                                          }
  139.   CSIDL_COMMON_STARTMENU        = $0016; { %PROFILEPATH%\All users\Start menu                               }
  140.   CSIDL_COMMON_PROGRAMS         = $0017; { %PROFILEPATH%\All users\Start menu\Programs                      }
  141.   CSIDL_COMMON_STARTUP          = $0018; { %PROFILEPATH%\All users\Start menu\Programs\Startup              }
  142.   CSIDL_COMMON_DESKTOPDIRECTORY = $0019; { %PROFILEPATH%\All users\Desktop                                  }
  143.   CSIDL_APPDATA                 = $001A; { %USERPROFILE%\Application Data (roaming)                         }
  144.   CSIDL_PRINTHOOD               = $001B; { %USERPROFILE%\Printhood                                          }
  145.   CSIDL_LOCAL_APPDATA           = $001C; { %USERPROFILE%\Local Settings\Application Data (non roaming)      }
  146.   CSIDL_COMMON_FAVORITES        = $001F; { %PROFILEPATH%\All users\Favorites                                }
  147.   CSIDL_INTERNET_CACHE          = $0020; { %USERPROFILE%\Local Settings\Temporary Internet Files            }
  148.   CSIDL_COOKIES                 = $0021; { %USERPROFILE%\Cookies                                            }
  149.   CSIDL_HISTORY                 = $0022; { %USERPROFILE%\Local settings\History                             }
  150.   CSIDL_COMMON_APPDATA          = $0023; { %PROFILESPATH%\All Users\Application Data                        }
  151.   CSIDL_WINDOWS                 = $0024; { %SYSTEMROOT%                                                     }
  152.   CSIDL_SYSTEM                  = $0025; { %SYSTEMROOT%\SYSTEM32 (may be system on 95/98/ME)                }
  153.   CSIDL_PROGRAM_FILES           = $0026; { %SYSTEMDRIVE%\Program Files                                      }
  154.   CSIDL_MYPICTURES              = $0027; { %USERPROFILE%\My Documents\My Pictures                           }
  155.   CSIDL_PROFILE                 = $0028; { %USERPROFILE%                                                    }
  156.   CSIDL_PROGRAM_FILES_COMMON    = $002B; { %SYSTEMDRIVE%\Program Files\Common                               }
  157.   CSIDL_COMMON_TEMPLATES        = $002D; { %PROFILEPATH%\All Users\Templates                                }
  158.   CSIDL_COMMON_DOCUMENTS        = $002E; { %PROFILEPATH%\All Users\Documents                                }
  159.   CSIDL_COMMON_ADMINTOOLS       = $002F; { %PROFILEPATH%\All Users\Start Menu\Programs\Administrative Tools }
  160.   CSIDL_ADMINTOOLS              = $0030; { %USERPROFILE%\Start Menu\Programs\Administrative Tools           }
  161.   CSIDL_COMMON_MUSIC            = $0035; { %PROFILEPATH%\All Users\Documents\my music                       }
  162.   CSIDL_COMMON_PICTURES         = $0036; { %PROFILEPATH%\All Users\Documents\my pictures                    }
  163.   CSIDL_COMMON_VIDEO            = $0037; { %PROFILEPATH%\All Users\Documents\my videos                      }
  164.   CSIDL_CDBURN_AREA             = $003B; { %USERPROFILE%\Local Settings\Application Data\Microsoft\CD Burning }
  165.   CSIDL_PROFILES                = $003E; { %PROFILEPATH%                                                    }
  166.  
  167. function dirwindows : string;export;
  168. begin
  169.  dirP := nil;
  170.  dir := dirP;
  171.  if SHGetFolderPath(0,CSIDL_WINDOWS,0,0,@dir) = 0 then begin
  172.   dirP := @dir;
  173.   dir := dirP;
  174.  end else dir := '?';
  175.  dirwindows := dir;
  176. end;
  177.  
  178. function dirprogrammi : string;export;
  179. begin
  180.  dirP := nil;
  181.  dir := dirP;
  182.  if SHGetFolderPath(0,CSIDL_PROGRAM_FILES,0,0,@dir) = 0 then begin
  183.   dirP := @dir;
  184.   dir := dirP;
  185.  end else dir := '?';
  186.  dirprogrammi := dir;
  187. end;
  188.  
  189. function dirutente : string;export;
  190. begin
  191.  dirP := nil;
  192.  dir := dirP;
  193.  if SHGetFolderPath(0,CSIDL_PROFILE,0,0,@dir) = 0 then begin
  194.   dirP := @dir;
  195.   dir := dirP;
  196.  end else dir := '?';
  197.  dirutente := dir;
  198. end;
  199.  
  200. function dirDocCondivisi : string;export;
  201. begin
  202.  dirP := nil;
  203.  dir := dirP;
  204.  if SHGetFolderPath(0,CSIDL_COMMON_DOCUMENTS,0,0,@dir) = 0 then begin
  205.   dirP := @dir;
  206.   dir := dirP;
  207.  end else dir := '?';
  208.  dirDocCondivisi := dir;
  209. end;
  210.  
  211. function dirMenuAvvioProgrammi : string;export;
  212. begin
  213.  dirP := nil;
  214.  dir := dirP;
  215.  if SHGetFolderPath(0,CSIDL_COMMON_PROGRAMS,0,0,@dir) = 0 then begin
  216.   dirP := @dir;
  217.   dir := dirP;
  218.  end else dir := '?';
  219.  dirMenuAvvioProgrammi := dir;
  220. end;
  221.  
  222. function altrecartelle(Codice : smallint) : string;export;
  223. begin
  224.  dirP := nil;
  225.  dir := dirP;
  226.  if SHGetFolderPath(0,Codice,0,0,@dir) = 0 then begin
  227.   dirP := @dir;
  228.   dir := dirP;
  229.  end else dir := '?';
  230.  altrecartelle := dir;
  231. end;
  232.  
  233. exports
  234. WindowsExit name 'Spegni',
  235. ParamExit name 'ParametriChiusura',
  236. CreateTool name 'CreaHWND',
  237. FirstProcess name 'FirstProcess',
  238. NextProcess name 'NextProcess',
  239. CreaProcesso name 'Esegui',
  240. TerminaID name 'TerminaID',
  241. TerminaNome name 'TerminaNOME',
  242. listprocess name 'Lista',
  243. dirwindows name 'directoryWINDOWS',
  244. dirprogrammi name 'cartellaPROGRAMMI',
  245. dirutente name 'cartellaUTENTE',
  246. dirDocCondivisi name 'DocumentiCondivisi',
  247. dirMenuAvvioProgrammi name 'MenuAvvioProgrammi',
  248. altrecartelle name 'altre cartelle';
  249.  
  250. Begin
  251. proc.dwSize := SizeOf(Proc);
  252. End.