![]() |
Re: Umgebungsvariable eines anderen, laufenden Programms änd
Moin Tiemo,
soweit hab' ich es fertig, allerdings ungetestet. Bislang habe ich das nur gebraucht, um das Environment des Parent-Prozesses zu manipulieren. Es könnte also das Problem geben, dass Dein Prozess nicht die Rechte hat, ein fremdes Environment zu ändern. Falls Du einen Virenscanner hast, wird der wahrscheinlich Alarm schlagen, wenn Du das Programm erzeugst ;-)
Delphi-Quellcode:
uses
TlHelp32,PsAPI; {$R *.dfm} const // 488 bis 499 werden nicht von der API belegt, können hier also benutzt werden. _ERR_DIFFERENT_SIZE = 488; _ERR_SIZE_CHANGED = 489; function csGetProcIDFromPath(const AsPath : string;var AdwLastError : DWORD) : Integer; // Die Prozess-ID aus dem Pfad ermitteln var hSnapShot : DWORD; pe32 : PROCESSENTRY32; hProcess : DWORD; pFilepath : PChar; sPath : string; begin Result := 0; hSnapshot := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS,0); if hSnapshot = INVALID_HANDLE_VALUE then begin AdwLastError := GetLastError; Exit; end; try sPath := AnsiLowerCase(Trim(sPath)); pe32.dwSize := SizeOf(pe32); if not Process32First(hSnapshot,pe32) then begin AdwLastError := GetLastError; Exit; end; repeat hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,pe32.th32ProcessID); try if hProcess <> 0 then begin pFilepath := AllocMem(MAX_PATH+1); try if GetModuleFileNameEx(hProcess,pe32.th32ModuleID,pFilePath,MAX_PATH+1) <> 0 then begin if AnsiLowerCase(Trim(pFilepath)) = sPath then begin Result := pe32.th32ProcessID; Exit; end; end; finally FreeMem(pFilepath,MAX_PATH+1); end; end; finally CloseHandle(hProcess); end; until not Process32Next(hSnapshot,pe32); finally CloseHandle(hSnapshot); end; end; function csReadProcessEnvironment(const AdwProcID : DWORD;var AdwEnvSize : DWORD;var ApEnvContent : Pointer;var AdwLastError : DWORD) : Boolean; // Den Speicher mit den WideString Umgebungsvariablen in Abhängigkeit // für eine Prozess-ID auslesen. var pEnvironment : Pointer; mbi : MEMORY_BASIC_INFORMATION; hProcess : DWORD; dwDummy : DWORD; begin Result := False; // Die Adresse ermitteln, an der das Environment liegt // Diese Adresse ist bei allen Prozessen gleich (bis incl. XP), weshalb man sich // hier nicht um den Prozess kümmern muss. pEnvironment := GetEnvironmentStringsW; hProcess := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ,False,AdwProcID); if hProcess = 0 then begin AdwLastError := GetLastError; Exit; end; try // Eckdaten des Speicherbereiches holen, in dem das Environment liegt // prozessabhängig auslesen... if VirtualQueryEx(hProcess,pEnvironment,mbi,SizeOf(mbi)) <> SizeOf(mbi) then begin AdwLastError := GetLastError; Exit; end; // und den Speicherinhalt lesen ApEnvContent := AllocMem(mbi.RegionSize); AdwEnvSize := mbi.RegionSize; if not ReadProcessMemory(hProcess,mbi.BaseAddress,ApEnvContent,AdwEnvSize,dwDummy) then begin AdwLastError := GetLastError; FreeMem(ApEnvContent,AdwEnvSize); Exit; end; Result := True; finally CloseHandle(hProcess); end; end; function csWriteProcessEnvironment(const AdwProcID : DWORD;const ApEnvContent : Pointer;var AdwLastError : DWORD) : Boolean; var hProc : DWORD; mbi : MEMORY_BASIC_INFORMATION; dwOldProtect : DWORD; dwDummy : DWORD; pEnvironment : Pointer; begin Result := False; hProc := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_WRITE or PROCESS_VM_OPERATION,False,AdwProcID); if hProc = 0 then begin AdwLastError := GetLastError; Exit; end; try pEnvironment := GetEnvironmentStringsW; if VirtualQueryEx(hProc,pEnvironment,mbi,SizeOf(mbi)) <> SizeOf(mbi) then begin AdwLastError := GetLastError; Exit; end; // Den Zielspeicher zum Schreiben vorbereiten if not VirtualProtectEx(hProc,pEnvironment,mbi.RegionSize,PAGE_READWRITE,dwOldProtect) then begin AdwLastError := GetLastError; Exit; end; try // Das alte Environment mit dem neuen überschreiben if not WriteProcessMemory(hProc,pEnvironment,ApEnvContent,mbi.RegionSize,dwDummy) then begin AdwLastError := GetLastError; end; finally // Den Einstellungen für den Speicherschutz wieder herstellen if not VirtualProtectEx(hProc,pEnvironment,mbi.RegionSize,dwOldProtect,dwOldProtect) then begin AdwLastError := GetLastError; end else begin Result := True; end; end; finally CloseHandle(hProc); end; end; function csChangeProcessEnvironment(const AsPath : string;const AsEnvVariable : string;const AsValue : string;var AdwLastError : DWORD) : Boolean; // AsPath: Der Pfad des Programmes, dessen Enviroment geändert werden soll // AsEnvVariable: Name der Umgebungsvariablen // AsValue: Der Wert, den die Variable bekommen soll // AdwLastError: Falls Result = false der Fehlercode var dwProcessIDSelf : DWORD; dwProcessID : DWORD; pEnvironmentOldSelf : Pointer; dwEnvSizeOldSelf : DWORD; pEnvironmentNewSelf : Pointer; dwEnvSizeNewSelf : DWORD; pEnvironment : Pointer; dwEnvSize : DWORD; begin Result := False; dwProcessIDSelf := GetCurrentProcessId; dwProcessID := csGetProcIDFromPath(AsPath,AdwLastError); if dwProcessID = 0 then Exit; pEnvironmentOldSelf := nil; pEnvironmentNewSelf := nil; pEnvironment := nil; try // Das aktuelle eigene Environment auslesen if not csReadProcessEnvironment(dwProcessIDSelf,dwEnvSizeOldSelf,pEnvironmentOldSelf,AdwLastError) then Exit; // Das aktuelle Zielenvironment auslesen if not csReadProcessEnvironment(dwProcessID,dwEnvSize,pEnvironment,AdwLastError) then Exit; // Stimmen die Grössen nicht überein, können wir nicht weitermachen // da die Adressen nicht übereinstimmen werden if dwEnvSizeOldSelf <> dwEnvSize then begin AdwLastError := _ERR_DIFFERENT_SIZE; exit; end; // Die gewünschte Variable im eigenen Environment ändern if not SetEnvironmentVariable(PChar(AsEnvVariable),PChar(AsValue)) then begin AdwLastError := GetLastError; Exit; end; // Jetzt das geänderte eigene Enviroment auslesen if not csReadProcessEnvironment(dwProcessIDSelf,dwEnvSizeNewSelf,pEnvironmentNewSelf,AdwLastError) then Exit; // Wenn sich die Grösse geändert hat, können wir nicht weitermachen, da sich die Adressen // geändert haben if dwEnvSizeNewSelf <> dwEnvSize then begin AdwLastError := _ERR_SIZE_CHANGED; Exit; end; // Zielenviroment mit dem eigenen geänderten überschreiben if not csWriteProcessEnvironment(dwProcessID,pEnvironmentNewSelf,AdwLastError) then Exit; Result := true; finally // Aufräumen if Assigned(pEnvironmentOldSelf) then FreeMem(pEnvironmentOldSelf,dwEnvSizeOldSelf); if Assigned(pEnvironmentNewSelf) then FreeMem(pEnvironmentNewSelf,dwEnvSizeNewSelf); if Assigned(pEnvironment) then FreeMem(pEnvironment,dwEnvSize); end; end; procedure TForm1.btn1Click(Sender: TObject); var dwLastError : DWORD; begin if csChangeProcessEnvironment('<HIER DEN PFAD ZUR EXE ÜBERGEBEN','NAME DER ENVIRONMENTVARIABLENN','ZU SETZENDER WERT',dwLastError) then begin ShowMessage('Erledigt.'); end else begin case dwLastError of _ERR_DIFFERENT_SIZE : ShowMessage('Die Environments stimmen in der Grösse nicht überein.'); _ERR_SIZE_CHANGED : ShowMessage('Die Grösse des Environments hat sich geändert.'); else ShowMessage(IntToStr(dwLastError)+#13#10+SysErrorMessage(dwLastError)); end; end; end; |
Re: Umgebungsvariable eines anderen, laufenden Programms änd
Danke, Christian. Wirklich super. Ich werde es probieren.... Tausend Dank!!!
|
Re: Umgebungsvariable eines anderen, laufenden Programms änd
wäre es da nicht einfacher das CAD-Programm direkt mit den gewünschten Umgebungsvariablen zu starten, als diese im Nachinein zu ändern?
nicht das dieses CAD-Programm sich noch 'ne Kopie dieser Variablen erstellt und damit arbeitet ... dan kann man da ja ändern was man will und nix passiert. |
Alle Zeitangaben in WEZ +1. Es ist jetzt 02:22 Uhr. |
Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz