Windows

Code:

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;

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, SizeOf(ModuleName));

List.Add(ModuleName);

CloseHandle(hProcess);

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; bFullpath: 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 bFullpath 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;

// 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;

Добавить комментарий

Подробности: Родительская категория: Процессы, потоки, память, задачи; Категория: Список задач, процессы и приорететы

То, что я понаписал нельзя считать цивильным кодом...просто демонстрация работы функции WaitForMultipleObjects ( код позорный...просто жуть...)

Подробнее: Как запустить и... Добавить комментарий

Подробности: Родительская категория: Процессы, потоки, память, задачи; Категория: Запуск и завершение процессов

Code:

procedure TForm1.Button1Click(Sender: TObject);

var

Picture: TPicture;

Desktop: TCanvas;

X, Y: Integer;

begin

// Objekte erstellen

// create objects

Picture := TPicture.Create;

Desktop := TCanvas.Create;

// Bild laden

// load bitmap

Picture.LoadFromFile('bitmap1.bmp');

// Geratekontex vom Desktop ermitteln

// get DC of desktop

Desktop.Handle := GetWindowDC(0);

// Position des Bildes

// position of bitmap

X := 100;

Y := 100;

// Bild zeichnen

// draw bitmap

Desktop.Draw(X, Y, Picture.Graphic);

// Geratekontex freigeben

ReleaseDC(0, Desktop.Handle);

// Objekte freigeben

// release objects

Picture.Free;

Desktop.Free;

end;

Добавить комментарий

Подробности: Родительская категория: Windows; Категория: Рабочий стол

Code:

var

pi : TProcessInformation;

si : TStartupInfo;

begin

ZeroMemory(@si,sizeof(si));

si.cb:=SizeOf(si);

if not CreateProcess(

PChar(lpApplicationName), //pointer to name of executable module

PChar(lpCommandLine), // Command line.

nil, // Process handle not inheritable.

nil, // Thread handle not inheritable.

False, // Set handle inheritance to FALSE.

0, // No creation flags.

nil, // Use parent's environment block.

nil, // Use parent's starting directory.

si, // Pointer to STARTUPINFO structure.

pi ) // Pointer to PROCESS_INFORMATION structure.

then begin

Result:=false;

RaiseLastWin32Error;

Exit;

end;

WaitForSingleObject(pi.hProcess,INFINITE);

CloseHandle(pi.hProcess);

CloseHandle(pi.hThread);

// ... здесь твой код

end;

Автор ответа: TAPAKAH

Примечание Vit:

Если заменить

WaitForSingleObject(pi.hProcess,INFINITE);

на

while WaitforSingleObject(PI.hProcess,200)=WAIT_TIMEOUT do application.ProcessMessages;

то вызывающая программа не будет казаться завешанной и будет отвечать на сообщения

Примечание Mikel: В RxLib есть функция для этого: FileExecuteWait

Добавить комментарий

Подробности: Родительская категория: Процессы, потоки, память, задачи; Категория: Запуск и завершение процессов

Для начала необходимо получить дескриптор рабочего стола, который представляет из себя обычный ListView.

Подробнее: Как выровнять иконки на... Добавить комментарий

Подробности: Родительская категория: Windows; Категория: Рабочий стол

блоке begin..end модуля .dpr:

Code:

begin

if HPrevInst <> 0 then

begin

ActivatePreviousInstance;

Halt;

end;

Подробнее: Как сделать, чтобы... Добавить комментарий

Подробности: Родительская категория: Процессы, потоки, память, задачи; Категория: Запуск и завершение процессов

Code:

procedure RefreshDesktop;

{©Drkb v.3}

var

c1 : cardinal;

begin

c1:=FindWindowEx(FindWindowEx(FindWindow('Progman','Program Manager'),,'SHELLDLL_DefView',''),0,'SysListView32','');

PostMessage(c1,WM_KEYDOWN,VK_F5,0);

PostMessage(c1,WM_KEYUP,VK_F5,1 shl 31);

end;

Подробнее: Как обновить рабочий... Добавить комментарий

Подробности: Родительская категория: Windows; Категория: Рабочий стол

Процедура AddTerminateProc( TermProc: TTerminateProc);

Добавляет процедуру в системный список процедур "завершения программы" (termination procedures list), которые вызываются перед окончанием работы приложения. Каждая такая процедура должна возвращать True, когда приложение может быть беспроблемно завершено или False, если приложение не должно быть завершено. Если любая из указанных процедур возвращает False, то выполнение приложения завершено не будет.

Функция CallTerminateProcs: Boolean;

Функция вызывает все подпрограммы, указанные в списке процедур завершения программы (termination procedures list). Если все процедуры и функции списка возвращают True, то CallTerminateProcs возвращает True, в остальных случаях функция возвращает False. Функция CallTerminateProcs вызывается внутренне непосредственно перед завершением выполнения приложения.

Добавить комментарий

Подробности: Родительская категория: Процессы, потоки, память, задачи; Категория: Запуск и завершение процессов

Code:

ShellExecute(Application.Handle, 'open', 'desk.cpl', nil, nil, sw_ShowNormal);

Автор: Nomadic

Подробнее: Как пpогpаммно вывести... Добавить комментарий

Подробности: Родительская категория: Windows; Категория: Рабочий стол

Должно работать, только лучше указывать полный путь до папки запускаемого приложения... без этого у меня некоторые приложения не запускались(один из параметров после 'notepad').

Подробнее: Создать процесс с... Добавить комментарий

Подробности: Родительская категория: Процессы, потоки, память, задачи; Категория: Запуск и завершение процессов

Для этого воспользуемся 'Rundll32.exe' и запустим её в 'shellexecute'. Не забудьте добавить 'shellapi' в Ваш список uses.

Подробнее: Как показать окно... Добавить комментарий

Подробности: Родительская категория: Windows; Категория: Рабочий стол

Windows

Системные функции и WinAPI

Вопросы по Delphi

VCL

Язык Дельфи

Облако тегов

Карта сайта