Umgebungsvariable eines anderen, laufenden Programms ändern

[Christian Seehase]

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;

[Tiemo]

Danke, Christian. Wirklich super. Ich werde es probieren.... Tausend Dank!!!

[himitsu]

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.