Akku ID auslesen

[Strahlex]

Wie ihr vielleicht wisst kann Windows, bei manchen Akkus die ID auslesen, so jetzt meine Frage wie kann ich das mit Delphi (oder besser gesagt Lazarus) machen. :gruebel:

Das müsste irgentwie über DeviceIOControl gehen oder so?!

[hathor]

WMI
CIMV2
Win32_Battery
DeviceID

[Strahlex]

Danke, und wie benutzt man das? (Codebeispiel) :?:

[QuickAndDirty]

Ich glaube er meint
er meint du sollst das WMI Objekt
/CIMV2/Win32_Battery
importieren
und darüber die DeviceID ermtteln.

aber so ganz sicher bin ich mir da auch nicht.

[Strahlex]

hmmm Ja, nur wie macht man das? Hab erlich keine Ahnung von der WMI, bin zu oft in Linux unterwegs...

[opfer.der.genauigkeit]

Bevor du dich auf die Informationen im WMI verlässt, empfehle ich dir
die Verwendung von DeviceIOControl und IOCTL_BATTERY_QUERY_INFORMATION.

Die nötigen Informationen dazu findest du in der WinSDK.

MfG
odg

[Strahlex]

Und wie verwendet man DeviceIoControl bzw. wo findet man Tutorials?

[DeddyH]

http://msdn.microsoft.com/en-us/libr...16(VS.85).aspx
Und da dann den entsprechenden Links folgen.

[Strahlex]

Ja, wie mach ich das mit dem Battery Handle und wie definiert man BATTERY_QUERY_INFORMATION?

Hat wirklich keiner ein Code-Beispiel oder Tutorial?

[DeddyH]

Ein Tutorial habe ich nicht, aber bist Du wirklich den Links gefolgt? Nach 2 Klicks bin ich z.B. hier:http://msdn.microsoft.com/en-us/libr...69(VS.85).aspx
Mehr kann ich Dir auch nicht dazu sagen, da noch nie benutzt, aber so lückenhaft finde ich die Informationen von Microsoft nicht ^^.

[hathor]

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Activex, WbemScripting_TLB, StdCtrls;


type
  TForm1 = class(TForm)
    Memo1: TMemo;
    Button1: TButton;
    procedure WMIbattery(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function GetWMIstring (wmiHost, wmiClass, wmiProperty : string):string;
var  // These are all needed for the WMI querying process
  Locator:  ISWbemLocator;
  Services: ISWbemServices;
  SObject:  ISWbemObject;
  ObjSet:   ISWbemObjectSet;
  SProp:    ISWbemProperty;
  Enum:     IEnumVariant;
  Value:    Cardinal;
  TempObj:  OleVariant;
  SN: string;
begin
  try
  Locator := CoSWbemLocator.Create;
   Services :=  Locator.ConnectServer(wmiHost, 'root\cimv2', '', '', '','', 0, nil);
  ObjSet := Services.ExecQuery('SELECT * FROM '+wmiClass, 'WQL',
    wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
  Enum :=  (ObjSet._NewEnum) as IEnumVariant;
  while (Enum.Next(1, TempObj, Value) = S_OK) do
  begin
    SObject := IUnknown(tempObj) as ISWBemObject;
    SProp := SObject.Properties_.Item(wmiProperty, 0);
    if VarIsNull(SProp.Get_Value) then
      result := ''
    else
    begin
      SN := SProp.Get_Value;
      result :=  SN;
    end;
  end;
  except // Trap any exceptions (Not having WMI installed will cause one!)
   on exception do
    result := '';
   end;
end;

function GetWMIstring2 (wmiHost, wmiClass, wmiProperty : string):string;
var  // These are all needed for the WMI querying process
  Locator:  ISWbemLocator;
  Services: ISWbemServices;
  SObject:  ISWbemObject;
  ObjSet:   ISWbemObjectSet;
  SProp:    ISWbemProperty;
  Enum:     IEnumVariant;
  Value:    Cardinal;
  TempObj:  OleVariant;
  SN: string;
begin
  try
  Locator := CoSWbemLocator.Create;
   Services :=  Locator.ConnectServer(wmiHost, 'root\wmi', '', '', '','', 0, nil);
  ObjSet := Services.ExecQuery('SELECT * FROM '+wmiClass, 'WQL',
    wbemFlagReturnImmediately and wbemFlagForwardOnly , nil);
  Enum :=  (ObjSet._NewEnum) as IEnumVariant;
  while (Enum.Next(1, TempObj, Value) = S_OK) do
  begin
    SObject := IUnknown(tempObj) as ISWBemObject;
    SProp := SObject.Properties_.Item(wmiProperty, 0);
    if VarIsNull(SProp.Get_Value) then
      result := ''
    else
    begin
      SN := SProp.Get_Value;
      result :=  SN;
    end;
  end;
  except
   on exception do
    result := '';
   end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
WMIbattery(Self);
end;

procedure TForm1.WMIbattery(Sender: TObject);
var tmpstr, FullChargedCapacity, RemainingCapacity, addstr : string;
    tmp,Difference : integer;
Begin
Memo1.Clear; 
  tmpstr := getWMIstring('','Win32_Battery','DesignVoltage');
  Memo1.lines.add(' DesignVoltage : '+ tmpstr + ' mVolt ');

  tmpstr := getWMIstring2('','BatteryStatus','Voltage');
  Memo1.lines.add(' Voltage : '+tmpstr + ' mVolt ');

  tmpstr := getWMIstring('','Win32_Battery','EstimatedRunTime');
  if StrToInt(tmpstr)<1000 then
  Memo1.lines.add(' EstimatedRunTime : '+tmpstr + ' Minutes ');

  tmpstr := getWMIstring('','Win32_Battery','BatteryStatus');
  tmp:= StrToInt(tmpstr);
  case tmp of
  1:  addstr:='Other';
  2:  addstr:='Unknown';
  3:  addstr:='Fully Charged';
  4:  addstr:='Low';
  5:  addstr:='Critical';
  6:  addstr:='Charging';
  7:  addstr:='Charging and High';
  8:  addstr:='Charging and Low';
  9:  addstr:='Charging and Critical';
  10: addstr:='Undefined';
  11: addstr:='Partially Charged';
  end;
  Memo1.lines.add(' BatteryStatus : '+ addstr);

  tmpstr := getWMIstring2('','BatteryFullChargedCapacity','FullChargedCapacity');
  Memo1.lines.add(' FullChargedCapacity : '+tmpstr + ' mWatt/h ');
  FullChargedCapacity:=tmpstr;

  tmpstr := getWMIstring2('','BatteryStatus','RemainingCapacity');
  Memo1.lines.add(' RemainingCapacity : '+tmpstr + ' mWatt/h ');
  RemainingCapacity:=tmpstr;

  Difference:=StrToInt(FullChargedCapacity)- StrToInt(RemainingCapacity);
  Memo1.lines.add(' Difference : '+IntToStr(Difference) + ' mWatt ');

  tmpstr := getWMIstring2('','BatteryStatus','Chargerate');
  Memo1.lines.add(' Chargerate : '+tmpstr + ' mWatt/h ');

  tmpstr := getWMIstring2('','BatteryStatus','DisChargerate');
  Memo1.lines.add(' DisChargerate : '+tmpstr + ' mWatt/h ');

  tmpstr := getWMIstring('','Win32_Battery','DeviceID');
  Memo1.lines.add(' DeviceID : '+tmpstr);
end;

end.

[Strahlex]

Danke hathor,
aber leider scheint die WMI mit fpc nicht zu funktionieren (keine WbemScripting_TLB). :(

[hathor]

Zitat:

Zitat von Strahlex

Danke hathor,
aber leider scheint die WMI mit fpc nicht zu funktionieren (keine WbemScripting_TLB). :(

BAHNHOF ?

Hat man Dir verboten, die Suchfunktion zu nutzen?
Oder zu kopieren?