Einzelnen Beitrag anzeigen

Benutzerbild von Garfield
Garfield

Registriert seit: 9. Jul 2004
Ort: Aken (Anhalt-Bitterfeld)
1.335 Beiträge
 
Delphi XE5 Professional
 
#23

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)

  Alt 16. Jan 2005, 16:34
Zitat von Alter Mann:
Delphi-Quellcode:
unit wmiCDROM;

interface

uses Windows, Classes, Contnrs, Variants;

type
  PCDROMDrive = ^TCDROMDrive;
  TCDROMDrive = class(TObject)
  private
    FUserName : String;
    FUserPwd : String;
    FComputerName : String;

    FDescription : String;
    FDrive : String;
    FManufacturer : String;
    FMediaLoaded : Boolean;
    FMediaType : String;
    FName : String;
    FSCSIBus : Uint;
    FSCSILogicalUnit : Uint;
    FSCSIPort : Uint;
    FSCSITargetId : Uint;
    FStatus : String;
  protected
    procedure SystemValues(CDROMDeviceID : String);
  public
    constructor Create(CDROMDeviceID : String);
    destructor Destroy; override;
    property Description : String read FDescription;
    property Drive : String read FDrive;
    property Manufacturer : String read FManufacturer;
    property MediaLoaded : Boolean read FMediaLoaded default False;
    property MediaType : String read FMediaType;
    property Name : String read FName;
    property SCSIBus : Uint read FSCSIBus;
    property SCSILogicalUnit : Uint read FSCSILogicalUnit;
    property SCSIPort : Uint read FSCSIPort;
    property SCSITargetId : Uint read FSCSITargetId;
    property Status : String read FStatus;
  published
  end;

implementation

uses SysUtils, ActiveX, WbemScripting_TLB;

////////////////////////////////////////////////////////////////////////
//// TCDROMDrive ////
////////////////////////////////////////////////////////////////////////

constructor TCDROMDrive.Create(CDROMDeviceID : String);
begin
  inherited Create;
  SystemValues(CDROMDeviceID);
end;

procedure TCDROMDrive.SystemValues(CDROMDeviceID : String);
var
  FLocator : ISWbemLocator;
  FServices : ISWbemServices;
  FObjectSet: ISWbemObjectSet;
  FObjEnum : IEnumVariant;
  FWMIObj : ISWbemObject;
  FWMITmpObj: OleVariant;
  PropVal : OLEVariant;
  Cnt : Cardinal;

  function GetValue(Value : String) : Variant;
  begin
    try
       PropVal := (FWMIObj.Properties_.Item(Value, 0) as ISWbemProperty).Get_Value;
       if not (VarIsEmpty(PropVal) or VarIsNull(PropVal)) then Result := PropVal;
    except
    end;
  end;

begin
  FLocator := CoSWbemLocator.Create;
  try
    if FLocator <> nil then
    begin
      FServices := FLocator.ConnectServer('.', 'root\cimv2', '', '', '', '', 0, nil);
      if FServices <> nil then
      begin
        FObjectSet := FServices.ExecQuery('SELECT * FROM Win32_CDROMDrive', 'WQL', wbemFlagReturnWhenComplete, nil);
        if FObjectSet <> nil then
        begin
          with FObjectSet do
          begin
            FObjEnum := (FObjectSet._NewEnum) as IEnumVariant;
            if FObjEnum <> nil then
            begin
              if FObjectSet.Count > 0 then
              begin
                while(FObjEnum.Next(1, FWMITmpObj, Cnt) = S_OK) do
                begin
                  FWMIObj := IUnknown(FWMITmpObj) as ISWbemObject;

                  PropVal := (FWMIObj.Properties_.Item('DeviceID', 0) as ISWbemProperty).Get_Value;
                  if not (VarIsEmpty(PropVal) or VarIsNull(PropVal)) and (CDROMDeviceID = PropVal) then
                  begin
                    FDescription := GetValue('Description');
                    FDrive := GetValue('Drive');
                    FManufacturer := GetValue('Manufacturer');
                    FMediaLoaded := GetValue('MediaLoaded');
                    FMediaType := GetValue('MediaType');
                    FName := GetValue('Name');
                    FSCSIBus := GetValue('SCSIBus');
                    FSCSILogicalUnit := GetValue('SCSILogicalUnit');
                    FSCSIPort := GetValue('SCSIPort');
                    FSCSITargetId := GetValue('SCSITargetId');
                    FStatus := GetValue('Status');
                  end;
                end;
              end;
            end;
          end;
        end;
      end;
    end;
  finally
    FServices := nil;
    FLocator := nil;
  end;
end;

destructor TCDROMDrive.Destroy;
begin
  inherited Destroy;
end;

end.
Folgende Änderungen habe ich vorgenommen:
  • Zeile 7 type eingefügt,
  • Zeile 57ff (FUserName := UserName; FUserPwd := UserPwd; FComputerName := ComputerName herausgenommen und
  • Zeile 85/86 das 'wbemConnectFlagUseMaxWait' durch 0 ersetzt.
Nun scheint bei Zeile 104, 105 ein Fehler zu sein. Denn (CDROMDeviceID = PropVal) kann nicht eintreten, weil PropVal zum Beispiel 'IDE\CDROM...' ist.
Gruss Garfield
Ubuntu 22.04: Laz2.2.2/FPC3.2.2 - VirtBox6.1+W10: D7PE, DXE5Prof
  Mit Zitat antworten Zitat