[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 275
  • Last Modified:

Windows Power Profiles - changing, reading, writing.

Hi

I need procedures to read the names of the power profiles,read the currently selected power profile, changing current power profile. And if there is anything else that can be done in this topic than it would be nice to know about it to, but the above have the highest priority for me.

Thank you for any help.
0
abrakadabra1
Asked:
abrakadabra1
  • 4
  • 4
1 Solution
 
jgbustosCommented:
Hello,

In Windows XP, 2003 and Vista, there is a command line tool called PowerCfg.exe. You can use it to list the available power schemes, query their settings and set the active scheme. You could encapsulate calls to this program, waiting until the process has finished and capturing the command line output.
http://technet2.microsoft.com/WindowsVista/en/library/1d58b934-f56a-4796-b2df-7be2eb9c03bc1033.mspx?mfr=true

The bad news is that PowerCfg.exe is not distributed with Windows 2000. Your only option in that case is to look at the Registry key HKEY_CURRENT_USER\Control Panel\PowerCfg. The value CurrentPowerPolicy contains the current scheme index, and the list of available schemes is stored as sub-keys under HKEY_CURRENT_USER\Control Panel\PowerCfg\PowerPolicies. You can change the value of CurrentPowerPolicy by hand or using Delphi code, but it will probably require a restart.

I wouldn't be surprised if any of these operations require administrative privileges!

Good luck

Jorge
0
 
abrakadabra1Author Commented:
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.
0
 
jgbustosCommented:
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;
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
jgbustosCommented:
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
0
 
abrakadabra1Author Commented:
Thank you very much for your help.
0
 
abrakadabra1Author Commented:
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.
0
 
jgbustosCommented:
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.
0
 
abrakadabra1Author Commented:
It works fine now. Thank you once again.
0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

  • 4
  • 4
Tackle projects and never again get stuck behind a technical roadblock.
Join Now