{$mode delphi}
uses windows,variants,activex,comobj,classes,sysutils;
Type
TEatenType = {$ifdef fpc} {$ifdef ver3_0}pulong{$else}Ulong{$endif}{$else}longword{$endif};
oEnumIterator = record
mainobj: OleVariant;
oEnum : IEnumvariant;
iteritem : olevariant;
iterval : longword;
function Enumerate(v :olevariant):oEnumIterator;
function getenumerator :oEnumIterator ;
function MoveNext:Boolean; // This is where filtering happens
property Current:OleVariant read iteritem;
end;
function oEnumIterator.getenumerator :oEnumIterator;
begin
result:=self;
end;
function oEnumIterator.Enumerate(v :olevariant):oEnumIterator;
begin
mainobj:=v;
oEnum := IUnknown(mainobj._NewEnum) as IEnumVariant;
result:=self;
end;
function oEnumIterator.MoveNext:boolean;
begin
result:=(oEnum.Next(1, iteritem, iterval) = s_ok); // fail then set iteritem to unassigned?
end;
function OleVariantToText(aVar:OleVariant):string;
// mostly quickdump for WMI researchpurposes
var
i : integer;
begin
Result:='';
if not VarIsNull(aVar) then
if VarIsArray(aVar) then
begin
result:='{';
for i :=VarArrayLowBound(aVar,1) to vararrayhighbound(aVar,1) do
begin
if i<>0 then
result:=result+',';
result:=result+OleVariantToText(vararrayget(aVar,[i]));
end;
result:=result+'}';
end
else
Result:=VarToStr(aVar);
end;
function RightPad(const PadString : string ; HowMany : integer): string;
var
Counter : integer;
oldlen : integer;
x : integer;
begin
result:=padstring;
oldlen:=Length(PadString);
Counter := HowMany - oldlen;
if oldlen<howmany then
setlength(result,howmany);
for x := 1 to Counter do
result[oldlen+x]:=' ';
end;
procedure DumpProperties(obj : OleVariant;condense : boolean=true);
var
objprop : OLEVariant;
propiter : oEnumIterator;
s : string;
begin
for objprop in propiter.Enumerate(obj.Properties_) do
begin
s:=OleVariantToText(objprop.Value);
if (s<>'') or not condense then
Writeln(rightpad(objprop.Name,40),' = ',s);
end;
end;
{function GetTypeStr(tdesc : TTypeDesc; Context : ActiveX.ITypeinfo):string;
var
tinfo : ActiveX.ITypeInfo;
bstrName : WideString;
begin
case tdesc.vt of
VT_PTR : Result:=GetTypeStr(tdesc.ptdesc^,Context);
VT_ARRAY : Result:=Format('Array of %s',[GetTypeStr(tdesc.padesc^.tdescElem,Context)]);
VT_USERDEFINED : begin
context.GetRefTypeInfo(tdesc.hreftype, tinfo);
tinfo.GetDocumentation(-1, @bstrName, nil, nil, nil);
Result:=bstrName;
end
else
Result:=VarTypeAsText(tdesc.vt);
end;
}
procedure doit;
const
wbemFlagForwardOnly = $00000020;
var
FSWbemLocator : OLEVariant;
FWMIService : OLEVariant;
FWbemObjectSet: OLEVariant;
FWbemObject : OLEVariant;
oenum : oEnumIterator;
DefragRecommended : longint;
DefragAnalyseOutput : OleVariant;
ErrorID : integer;
begin;
FSWbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
FWMIService := FSWbemLocator.ConnectServer('localhost', 'root\CIMV2', '', '');
FWbemObjectSet:= FWMIService.ExecQuery('SELECT * FROM Win32_Volume Where Name = "d:\\"','WQL',wbemFlagForwardOnly);
for FWbemObject in oEnum.Enumerate(FWbemObjectSet) do
begin
DumpProperties(FWbemObject,true);
ErrorID := FWbemObject.DefragAnalysis(DefragRecommended,DefragAnalyseOutput);
{$ifdef console}writeln{$else}showmessage{$endif}(format('Errorid=%d',[ErrorID]));
end;
end;
begin
doit;
{$ifndef fpc}
if DebugHook=1 then
{$endif}
Readln;
end.
Bookmarks