دیدن اجرای برنامه

[آرشم@30]

چگونه می توان داخل برنامه دلفی متوجه شد چه برنامه هایی در حال اجرا است

[vesal]

Uses
Psapi, tlhelp32;

procedure CreateWin9xProcessList(List : TStringList) ;
var
hSnapShot : THandle;
ProcInfo : TProcessEntry32;
begin
if List = nil then Exit ;
hSnapShot := CreateToolHelp32Snapshot(TH32CS_SNAPPROCESS, 0);
if (hSnapShot <> THandle(-1)) then
begin
ProcInfo.dwSize := sizeof(ProcInfo) ;
if (Process32First(hSnapshot, ProcInfo)) then
begin
List.Add( ProcInfo.szExeFile) ;
while (Process32Next(hSnapShot, ProcInfo)) do
List.Add(ProcInfo.szExeFile) ;
end ;
CloseHandle(hSnapShot) ;
end ;
end ;

procedure CreateWinNTProcessList(List : TStringList) ;
var
PIDArray : array [0..1023] of DWORD ;
cb : DWORD ;
I : integer ;
ProcCount : integer ;
hMod : HMODULE ;
hProcess : THandle ;
ModuleName : array [0..300] of char ;
begin
if List = nil then Exit ;
EnumProcesses(@PIDArray, sizeof(PIDArray), cb) ;
ProcCount := cb div sizeof(DWORD) ;
for I := 0 to ProcCount-1 do
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or
PROCESS_VM_READ,
false,
PIDArray[i]) ;
if (hProcess <> 0) then
begin
EnumProcessModules(hProcess, @hMod, sizeof(hMod), cb) ;
GetModuleFilenameEx(hProcess,hMod,ModuleName,sizeo f(ModuleName));
List.Add(ModuleName);
CloseHandle(hProcess);
end;
end;
end;

procedure GetProcessList(Var List : TStringList) ;
var ovi : TOSVersionInfo ;
begin
if List = nil then Exit ;
ovi.dwOSVersionInfoSize := sizeof(TOSVersionInfo) ;
GetVersionEx(ovi) ;
case ovi.dwPlatformId of
VER_PLATFORM_WIN32_WINDOWS : CreateWin9xProcessList(List) ;
VER_PLATFORM_WIN32_NT : CreateWinNTProcessList(List) ;
end
end;

function EXE_Running(FileName : String; fullpath : boolean) : boolean;
var
i : integer ;
MyProcList : TStringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList) ;
result := false;
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
begin
if not fullpath then
begin
if CompareText(ExtractFileName(MyProcList.Strings[i]),FileName) = 0 then result := true
end else
if CompareText(MyProcList.Strings[i],FileName) = 0 then result := true;
if result then break;
end;
finally
MyProcList.Free ;
end;
end;


// Example 1: Is a Exe-File running ?
procedure TForm1.Button1Click(Sender: TObject);
begin
if EXE_Running('notepad.exe',false) then
ShowMessage('EXE is running')
else
ShowMessage('EXE is not running');
end;


// Example 2: List running Exe-Files
procedure TForm1.Button3Click(Sender: TObject);
var
i : integer ;
MyProcList : TStringList;
begin
MyProcList := TStringList.Create;
try
GetProcessList(MyProcList) ;
if MyProcList = nil then Exit;
for i := 0 to MyProcList.Count - 1 do
ListBox1.items.add(MyProcList.Strings[i]);
finally
MyProcList.Free;
end;
end;

و اگر قصد داری که یک پروسه باز رو ببندی
procedure KillApp(title : string);
var h : HWND;

begin
h:=FindWindow(nil,@(title)[1]);
if h<>0 then
begin
SendMessage(h,WM_CLOSE,0,0);
Showmessage('App terminated.')
end
else
Showmessage('failed kill app.')
end;


کشاورز: لطفا کدها را در تگ CODE قرار بدید

[vcldeveloper]

Tool Help Functions در یونیت TIHelp32 هم در Win9x و هم در Win NT جواب میدن و برای ایجاد لیستی از Process های در حال اجرا نیازی به WinNT process API در یونیت PsAPI نیست.