function CreateEnvironmentBlock(lpEnvironment: Pointer; hToken: THandle;
bInherit: BOOL): BOOL;
stdcall;
external '
userenv.dll';
function DestroyEnvironmentBlock(lpEnvironment: Pointer): BOOL;
stdcall;
external '
userenv.dll';
procedure TForm5.Button1Click(Sender: TObject);
var
Token: THandle;
EnvironmentBlock: Pointer;
EnvData: WideString;
CurVar: PWideChar;
StartupInfo: TStartupInfo;
ProcessInfo: TProcessInformation;
begin
if (OpenProcessToken(GetCurrentProcess, TOKEN_ALL_ACCESS, Token))
then
try
if (
not CreateEnvironmentBlock(@EnvironmentBlock, Token, false))
then
RaiseLastOSError;
try
EnvData := '
';
// Copy existing environment variables
CurVar := EnvironmentBlock;
repeat
if (CurVar <> '
')
then
begin
EnvData := EnvData + CurVar + #0;
CurVar := PWideChar(PByte(CurVar) + (Length(CurVar) + 1) * SizeOf(WideChar));
end;
until (CurVar = '
');
// Add new environment variables
EnvData := EnvData + '
test=wuppdi' + #0;
EnvData := EnvData + '
var2=DP' + #0;
// Add termination char
EnvData := EnvData + #0;
// Start console with modified environment block
FillChar(StartupInfo, SizeOf(StartupInfo), #0);
StartupInfo.cb := SizeOf(StartupInfo);
if (
not CreateProcess('
C:\Windows\System32\cmd.exe',
nil,
nil,
nil, false,
CREATE_UNICODE_ENVIRONMENT, @EnvData[1],
nil, StartupInfo, ProcessInfo))
then
RaiseLastOSError;
try
// ..
finally
CloseHandle(ProcessInfo.hProcess);
CloseHandle(ProcessInfo.hThread);
end;
finally
DestroyEnvironmentBlock(EnvironmentBlock);
end;
finally
CloseHandle(Token);
end;
end;