unit uoRegistry;
interface
uses
{ uoInstaller, meine Datenunit }
System.Classes;
function FoundIDE(
var uoItem: TuoItem
{meine Datenklasse}): Boolean;
function RunningIDE(
const aFileName:
String): Boolean;
implementation
uses
Winapi.Windows, System.Win.Registry, System.SysUtils,
ShellAPI, TlHelp32, PsAPI;
const
PROCESS_QUERY_LIMITED_INFORMATION = $1000;
function PidToFilename(
const TargetPID: THandle): WideString;
type
TQueryFullProcessImageNameW =
function(hProcess: THandle; dwFlags: DWORD; lpExeName: PWideChar; nSize: PDWORD)
: BOOL;
stdcall;
var
hProcess: THandle;
TargetName: WideString;
QueryFullProcessImageNameW: TQueryFullProcessImageNameW;
nSize: cardinal;
begin
Result := '
';
nSize := MAX_PATH;
SetLength(TargetName, nSize);
if Win32MajorVersion >= 6
then
begin
hProcess := OpenProcess(PROCESS_QUERY_LIMITED_INFORMATION, false, TargetPID);
if hProcess <> 0
then
begin
try
@QueryFullProcessImageNameW := GetProcAddress(GetModuleHandle('
kernel32'), '
QueryFullProcessImageNameW');
if Assigned(QueryFullProcessImageNameW)
then
if QueryFullProcessImageNameW(hProcess, 0, PWideChar(TargetName), @nSize)
then
Result := PWideChar(TargetName);
finally
CloseHandle(hProcess);
end;
end;
end
else
begin
hProcess := OpenProcess(PROCESS_QUERY_INFORMATION
or PROCESS_VM_READ, false, TargetPID);
if hProcess <> 0
then
try
if GetModuleFileNameExW(hProcess, 0, PWideChar(TargetName), nSize) <> 0
then
Result := PWideChar(TargetName);
finally
CloseHandle(hProcess);
end;
end;
end;
function ProcessIsRunning(
const aFileName: WideString): Boolean;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
fullPath: WideString;
myPID: DWORD;
OwnPID: cardinal;
begin
OwnPID := GetCurrentProcessId;
FSnapshotHandle := CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
Result := false;
while Integer(ContinueLoop) <> 0
do
begin
try
if UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase(ExtractFileName(aFileName))
then
begin
myPID := FProcessEntry32.th32ProcessID;
fullPath := PidToFilename(myPID);
if SameText(fullPath, aFileName)
then
begin
Result := True;
Break;
end;
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
except
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
end;
end;
CloseHandle(FSnapshotHandle);
end;
function RunningIDE(
const aFileName:
String): Boolean;
begin
Result := ProcessIsRunning(aFileName);
end;
function RegKeyExists(
const RegPath:
string;
const RootKey: HKEY): Boolean;
var
Reg: TRegistry;
begin
try
Reg := TRegistry.Create;
try
Reg.RootKey := RootKey;
Result := Reg.KeyExists(RegPath);
finally
Reg.Free;
end;
except
Result := false;
end;
end;
function RegReadStr(
const RegPath, RegValue:
string;
var Str:
string;
const RootKey: HKEY): Boolean;
var
Reg: TRegistry;
begin
try
Reg := TRegistry.Create;
try
Reg.RootKey := RootKey;
Result := Reg.OpenKey(RegPath, true);
if Result
then
Str := Reg.ReadString(RegValue);
finally
Reg.Free;
end;
except
Result := false;
end;
end;
function FoundIDE(
var uoItem: TuoItem): Boolean;
var
FileName:
string;
Found: Boolean;
begin
Result := false;
uoItem.IdeFileName := '
';
Found := RegKeyExists(uoItem.IdeRegPath, HKEY_CURRENT_USER);
if (Found)
then
begin
if (RegReadStr(uoItem.IdeRegPath, '
App', FileName, HKEY_CURRENT_USER)
and (FileExists(FileName)))
then
begin
uoItem.IdeFileName := FileName;
Exit(true);
end;
end;
Found := RegKeyExists(uoItem.IdeRegPath, HKEY_LOCAL_MACHINE);
if (Found)
then
begin
if (RegReadStr(uoItem.IdeRegPath, '
App', FileName, HKEY_LOCAL_MACHINE)
and (FileExists(FileName)))
then
begin
uoItem.IdeFileName := FileName;
Exit(true);
end;
end;
end;
end.