[El Sanchez]

Johny777, определение рабочей папки процесса:

читать дальше »

Код:

[code]
#ifdef UNICODE
    #define A "W"
#else
    #define A "A"
#endif
const
    TH32CS_SNAPPROCESS = $2;
    INVALID_HANDLE_VALUE = -1;
    PROCESS_QUERY_INFORMATION = $400;
    PROCESS_VM_READ = $10;
    MAX_PATH = 260;

type
    TPROCESSENTRY32 = record
        dwSize, cntUsage, th32ProcessID: DWORD;
        th32DefaultHeapID: Longint;
        th32ModuleID, cntThreads, th32ParentProcessID: DWORD;
        pcPriClassBase: Longint;
        dwFlags: DWORD;
        szExeFile: array [0..MAX_PATH-1] of Сhar;
    end;

function CreateToolhelp32Snapshot(dwFlags, th32ProcessID: DWORD): THandle; external 'CreateToolhelp32Snapshot@kernel32.dll stdcall';
#ifdef UNICODE
function Process32First(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32First{#A}@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32Next{#A}@kernel32.dll stdcall';
#else
function Process32First(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32First@kernel32.dll stdcall';
function Process32Next(hSnapshot: THandle; var lppe: TPROCESSENTRY32): Boolean; external 'Process32Next@kernel32.dll stdcall';
#endif
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function GetProcessImageFileName(hProcess: THandle; var lpImageFileName: Char; nSize: DWORD): DWORD; external 'GetProcessImageFileName{#A}@psapi.dll stdcall';
function GetLogicalDriveStrings(nBufferLength: DWORD; var lpBuffer: Char): DWORD; external 'GetLogicalDriveStrings{#A}@kernel32.dll stdcall';
function QueryDosDevice(lpDeviceName: String; var lpTargetPath: Char; ucchMax: DWORD): DWORD; external 'QueryDosDevice{#A}@kernel32.dll stdcall';
function OpenProcess(dwDesiredAccess: DWORD; bInheritHandle: BOOL; dwProcessId: DWORD): THandle; external 'OpenProcess@kernel32.dll stdcall';

function CharArrayToString(aChar: array of Char): String;
begin
    Result := '';
    while not (aChar[Length(Result)] = #0) do Result := Result + aChar[Length(Result)];
end;

function GetProcessWorkingDirectory(ProcessName: String): TArrayOfString;
var
    hProcessSnap, hProc: THandle;
    pe32: TPROCESSENTRY32;
    szExeFile, szDrives, szDeviceName: array [0..MAX_PATH-1] of Char;
    sDeviceName: String;
    i, iLen: DWORD;
begin
    SetArrayLength(Result, 0);
    hProcessSnap := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
    if hProcessSnap = INVALID_HANDLE_VALUE then Exit;
    pe32.dwSize := sizeof(pe32);
    if not Process32First(hProcessSnap, pe32) then Exit;
    while Process32Next(hProcessSnap, pe32) do
    begin
        if CompareText(CharArrayToString(pe32.szExeFile), ProcessName) = 0 then
        begin
            hProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, False, pe32.th32ProcessID);
            if GetProcessImageFileName(hProc, szExeFile[0], MAX_PATH) = 0 then Exit;
            SetArrayLength(Result, GetArrayLength(Result)+1);
            Result[GetArrayLength(Result)-1] := CharArrayToString(szExeFile);
            iLen := GetLogicalDriveStrings(MAX_PATH, szDrives[0]);
            if iLen = 0 then Exit;
            i := 0;
            while i <= iLen-3 do
            begin
                if QueryDosDevice(szDrives[i] + ':', szDeviceName[0], MAX_PATH) > 0 then
                begin
                    sDeviceName := CharArrayToString(szDeviceName);
                    if (Length(sDeviceName) <= Length(Result[GetArrayLength(Result)-1])) and
                    (Pos(sDeviceName, Result[GetArrayLength(Result)-1]) = 1) then
                    begin
                        StringChangeEx(Result[GetArrayLength(Result)-1], sDeviceName, szDrives[i] + ':', True);
                        Result[GetArrayLength(Result)-1] := RemoveBackSlash(ExtractFilePath(Result[GetArrayLength(Result)-1]));
                        Break;
                    end;
                end;
                i := i + 4;
            end;
            CloseHandle(hProc);
        end;
    end;
    CloseHandle(hProcessSnap);
end;

procedure InitializeWizard();
var
    szArray: TArrayOfString;
    i: Integer;
begin
    //хочу знать откуда калькуляторы запущены
    szArray := GetProcessWorkingDirectory('calc.exe');
    if GetArrayLength(szArray) > 0 then for i := 0 to GetArrayLength(szArray)-1 do MsgBox(szArray[i], mbInformation, MB_OK);
end;