Keine eine Ahnung von
WMI und WQL?
Ich habe jetzt herausgefunden, dass ich das Feld "MediaType" überprüfen sollte, wenn ich nur interne Festplatten (fixed drives) prüfen möchte. Alles andere schließt auch USB-Festplatten, Cardreader etc. in die Hardware-ID mit ein, was Fehler und wechselnde Hardware-IDs bewirkt.
Die WQL
Query schlägt aber bei zweiterer Funktion immer ein. Ich versuche schon seit 2 Stunden, sehe aber in der
Query keinen Fehler.
Delphi-Quellcode:
function MagWmiGetDiskSerial (drive: integer): string ;
begin
result := '' ;
MagWmiGetOneQ ('SELECT SerialNumber FROM Win32_PhysicalMedia WHERE ' +
'Tag = "\\\\.\\PHYSICALDRIVE' + IntToStr (drive) + '"', 'SerialNumber', Result) ;
end ;
// [DM] Added
function MagWmiGetHardDiskSerial (drive: integer): string ;
begin
result := '' ;
MagWmiGetOneQ ('SELECT SerialNumber FROM Win32_PhysicalMedia WHERE ' +
'MediaType = "Fixed hard disk media" AND ' +
'Tag = "\\\\.\\PHYSICALDRIVE' + IntToStr (drive) + '"', 'SerialNumber', Result) ;
end ;
MagWmiGetOneQ:
Delphi-Quellcode:
function MagWmiGetOneQ (
const Arg, Prop: widestring ;
var ResStr:
string): integer ;
var
wmiLocator: TSWbemLocator;
wmiServices: ISWbemServices;
wmiObjectSet: ISWbemObjectSet;
wmiObject: ISWbemObject;
wmiProp: ISWbemProperty;
ovVar: OleVariant;
lwValue: LongWord;
Enum: IEnumVariant;
begin
ResStr := '
' ;
wmiLocator := TSWbemLocator.Create (
Nil);
try
try
wmiServices := wmiLocator.ConnectServer ('
', RootNameSpace, '
', '
',
'
', '
', 0,
nil);
wmiObjectSet := wmiServices.ExecQuery (Arg, '
WQL',
wbemFlagReturnImmediately,
nil) ;
result := wmiObjectSet.Count ;
if (result <> 1)
then exit ;
// can only handle a single instance
Enum := (wmiObjectSet._NewEnum)
as IEnumVariant;
while (Enum.Next (1, ovVar, lwValue) = S_OK)
do
begin
wmiObject := IUnknown(ovVar)
as SWBemObject;
wmiProp := wmiObject.Properties_.Item (Prop, 0) ;
if wmiProp.
Name <> Prop
then exit ;
ResStr := MagWmiGetPropStr (wmiProp) ;
if ResStr <> '
NULL'
then result := 1 ;
end ;
except
result := -1 ;
end ;
finally
wmiLocator.Free;
end;
end ;
// Edit: Allgemeingültig behoben:
http://www.viathinksoft.de/?page=pro...ownload&id=149