Windows Power Profiles - changing, reading, writing.

ok... so how can i run powercfg from delphi and get it's response back to my proggy ? - preferably without the need to write powercfg's output to disk.

Hi again,

You'd need to redirect the output of powercfg.exe with a pipe. After a call to the CreatePipe API function, you need to use the allocated read and write handles in the subsequent call to CreateProcess.

I have created a simple method that does it for you, and aggregates the result in a TStrings instance:

procedure RunCmdLineAndCaptureOutput(const CmdLine: string; Output: TStrings);
var
  SecAttr: TSecurityAttributes;
  ReadHandle: THandle;
  WriteHandle: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  WaitResult: Cardinal;
  Buffer: PChar;
  BytesRead: Cardinal;
const
  BUFFER_SIZE = 4096;
begin
  Output.BeginUpdate;
  try
    Output.Clear;
    SecAttr.nLength := SizeOf(TSecurityAttributes);
    SecAttr.bInheritHandle := true;
    SecAttr.lpSecurityDescriptor := nil;

    if not CreatePipe(ReadHandle, WriteHandle, @SecAttr, 0) then
      RaiseLastOSError;
    try
      FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
      StartupInfo.cb := SizeOf(TStartupInfo);
      StartupInfo.hStdOutput := WriteHandle;
      StartupInfo.hStdInput := ReadHandle;
      StartupInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
      StartupInfo.wShowWindow := SW_HIDE;

      if not CreateProcess(nil, PChar(CmdLine), @SecAttr, @SecAttr, true,
        NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
          RaiseLastOSError;
      try
        repeat
          WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 100);
          Application.ProcessMessages;
        until (WaitResult <> WAIT_TIMEOUT);

        GetMem(Buffer, BUFFER_SIZE + 1);
        try
          BytesRead := 0;
          repeat
            if not ReadFile(ReadHandle, Buffer^, BUFFER_SIZE, BytesRead, nil) then
              RaiseLastOSError;
            Buffer[BytesRead] := #0;
            OemToChar(Buffer, Buffer);
            Output.Text := Output.Text + Buffer;
          until (BytesRead < BUFFER_SIZE);
        finally
          FreeMem(Buffer);
        end;
      finally
        CloseHandle(ProcessInfo.hThread);
        CloseHandle(ProcessInfo.hProcess);
      end;
    finally
      CloseHandle(ReadHandle);
      CloseHandle(WriteHandle);
    end;
  finally
    Output.EndUpdate;
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  RunCmdLineAndCaptureOutput('C:\WINDOWS\system32\defrag.exe', Memo1.Lines);
end;

Needless to say, any error in an API function call will cause the raising of an exception, which you need to trap in your code.

Hope this helps

Thank you very much for your help.

jgbustos,

i can't make your code to run powercfg (defrag worked fine) - it hangs the whole app on:

            if not ReadFile(ReadHandle, Buffer^, BUFFER_SIZE, BytesRead, nil) then
              RaiseLastOSError;

if i remove the above if statement than the results is an empty memo.

Hi again,

That happens because calling powercfg.exe with no parameters returns an error code. Most MS-DOS programs return an integer value, commonly known as an error level. If the error level is 0, execution of the program succeeds and everything went OK. A return code greater than zero means something wrong happened.

There are two things you can do to fix this. First one is to capture the exit code of the program and read its output only if there was no error (result was 0). See the revised procedure:

procedure RunCmdLineAndCaptureOutput(const CmdLine: string; Output: TStrings);
var
  SecAttr: TSecurityAttributes;
  ReadHandle: THandle;
  WriteHandle: THandle;
  StartupInfo: TStartupInfo;
  ProcessInfo: TProcessInformation;
  Buffer: PChar;
  WaitResult: Cardinal;
  BytesRead: Cardinal;
  ExitCode: Cardinal;
const
  BUFFER_SIZE = 4096;
begin
  Output.BeginUpdate;
  try
    Output.Clear;
    SecAttr.nLength := SizeOf(TSecurityAttributes);
    SecAttr.bInheritHandle := true;
    SecAttr.lpSecurityDescriptor := nil;

    if not CreatePipe(ReadHandle, WriteHandle, @SecAttr, 0) then
      RaiseLastOSError;
    try
      FillChar(StartupInfo, SizeOf(TStartupInfo), 0);
      StartupInfo.cb := SizeOf(TStartupInfo);
      StartupInfo.hStdOutput := WriteHandle;
      StartupInfo.hStdInput := ReadHandle;
      StartupInfo.dwFlags := STARTF_USESTDHANDLES + STARTF_USESHOWWINDOW;
      StartupInfo.wShowWindow := SW_HIDE;

      if not CreateProcess(nil, PChar(CmdLine), @SecAttr, @SecAttr, true,
        NORMAL_PRIORITY_CLASS, nil, nil, StartupInfo, ProcessInfo) then
          RaiseLastOSError;
      try
        repeat
          WaitResult := WaitForSingleObject(ProcessInfo.hProcess, 100);
          Application.ProcessMessages;
        until (WaitResult <> WAIT_TIMEOUT);

        if not GetExitCodeProcess(ProcessInfo.hProcess, ExitCode) then
          RaiseLastOSError;

        if ExitCode = 0 then
        begin
          // The output is read only if the MS-DOS call succeeded (error level 0)
          GetMem(Buffer, BUFFER_SIZE + 1);
          try
            BytesRead := 0;
            repeat
              if not ReadFile(ReadHandle, Buffer^, BUFFER_SIZE, BytesRead, nil) then
                RaiseLastOSError;
              Buffer[BytesRead] := #0;
              OemToChar(Buffer, Buffer);
              Output.Text := Output.Text + Buffer;
            until (BytesRead < BUFFER_SIZE);
          finally
            FreeMem(Buffer);
          end;
        end;
      finally
        CloseHandle(ProcessInfo.hThread);
        CloseHandle(ProcessInfo.hProcess);
      end;
    finally
      CloseHandle(ReadHandle);
      CloseHandle(WriteHandle);
    end;
  finally
    Output.EndUpdate;
  end;
end;

In any case, make sure you call powercfg.exe with the parameter /list to get all the available power schemes and /setactive to set the one you want. Call powercfg /? on a command line window to get the help with all the available options.

It works fine now. Thank you once again.