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

[Garfield]

Hallo,

über diesen Source

Delphi-Quellcode:

  ComboLW.Clear;
  for i := 0 to 25 do
    if GetLogicalDrives and (1 shl i) <> 0
    then
      if GetDriveType(PChar(Chr(i + Ord('A')) + ':\')) = DRIVE_CDROM
      then ComboLW.Items.Add(Chr(i + Ord('A')) + ':');

ermittle ich die vorhandenen CD-Rom-Laufwerke und trage sie in eine ComboBox ein.

In zahlreichen Beispielen wird gezeigt, wie man unter anderem die Bezeichnung der eingelegten CD/DVD ermitteln kann. Ich möchte jedoch, wie zum Beispiel bei Brennprogrammen üblich, die Typenbezeichnung des Laufwerks ermitteln. So das die Liste zum Beispiel so aussieht:

Code:

D: [LITEON DVD-ROM LTD163D]
E: [LITE-ON LTR-40125S]
F: [Generic DVD-ROM]

Unter Win98SE könnte man die Registry durchsuchen. Da stehen dann unter Arbeitsplatz\HKEY_LOCAL_MACHINE\Enum\SCSI\ unter anderem die CD-ROM-Laufwerke mit DeviceType, HardwareID, Manufakturer, ProductID, CurrentDriveLetter, ...

Bei WinXP sind in der Registry zum Beispiel unter Arbeitssplatz\HKEY_LOCAL_MACHINE\HARDWARE\DEVICEMA P\Scsi die Laufwerke (Festplatte/CD/DVD-ROM) mit ihrer Bezeichnung aufgeführt. Ausführlicher stehen sie dann unter Arbeitssplatz\HKEY_LOCAL_MACHINE\SYSTEM\CONTROLSET 001\IDE und SCSI.

Gibt es Funktionen, mit welchen man sich die aufwändige Suche in der Registry ersparen kann?

[OregonGhost]

Ein Weg führt über die Windows Management Instrumentation (WMI), siehe dazu im PSDK. Da solltest du dir mal die Klasse Win32_LogicalDisk ansehen, die enthält glaube ich die Information, die du suchst.

[Garfield]

Vielen Dank für den Tipp. Über Win32_LogicalDisk bin ich zu win32_cdromdrive gekommen. Jetzt muss 'nur' noch sehen, wie ich das in D7PE reinbekomme. Die Source-Beispiele, welche Google bringt, sind fast ausschließlich in C.

[Robert Marquardt]

Der alternative Weg geht ueber das Config Manager API, aber ich habe noch keine Zeit gefunden die Delphi-Konversion davon freizugeben.
Das ist im Wesentlichen das API das vom Device Manager verwendet wird.

[Garfield]

Wenn Nero installiert ist, könnte man auch die Delphi Nero API benutzen. Oder alternativ nachsehen, was Nero in die Registry geschrieben hat. Nero habe ich allerdings nicht.

[Kernel32.DLL]

Zitat:

Zitat von Garfield

Vielen Dank für den Tipp. Über Win32_LogicalDisk bin ich zu win32_cdromdrive gekommen. Jetzt muss 'nur' noch sehen, wie ich das in D7PE reinbekomme. Die Source-Beispiele, welche Google bringt, sind fast ausschließlich in C.

Win32_CDRomDrive funzt aber nur unter WinXP und Server 2003.

Bei Win98 würd ich bei der Registry bleiben.

[Garfield]

Ganz unten steht:

Zitat:

Requirements

Client: Requires Windows XP, Windows 2000 Professional, or Windows NT Workstation 4.0 SP4 and later.

Somit könnte man eine Version für Win9x/ME und eine für Win2000/XP machen.

[Kernel32.DLL]

Oder man erstellt eine Abfrage, welches System gerade läuft

[Garfield]

Die Abfrage ist ja das einfachste an der Sache:

Delphi-Quellcode:

  //***********************************************************************//
 // Ist mindestens Windows 2000 installiert?                              //
//***********************************************************************//
function minWin2000: Boolean;
var
  os         : TOSVersionInfo;
begin
  os.dwOSVersionInfoSize := sizeof(os);
  GetVersionEx(os);
  if (os.dwPlatformId = VER_PLATFORM_WIN32_NT) and
     (os.dwMajorVersion >= 5)
  then minWin2000 := True
  else minWin2000 := False;
end;

NT 4.0 Workstation wird wohl kaum noch jemand installiert haben!?

[fkerber]

Hi!

*Meld*
Bei uns in der Schule z.B.!


Ciao Frederic

[Kernel32.DLL]

:duck:
Bei uns an der Schule Win98!!

[Wishmaster]

Hi

Dazu kann ich dir nur die Bass.dll + BassCD.dll Empfehlen!
http://www.un4seen.com/
oder
cddbComp
http://sourceforge.net/projects/cddbcomp
oder
AKRip CD-DA Audio Extraction Library
http://akrip.sourceforge.net/


http://www.freedb.org/modules.php?na...ticle&artid=27

du wirst sicherlich das passende finden.

[Garfield]

Zitat:

Zitat von fkerber

Bei uns in der Schule z.B.!

Zitat:

Zitat von Kernel32.DLL

Bei uns an der Schule Win98!!

:shock: Meine Töchter gehen auf's Gymnasium, dort haben sie WinXP. Win98 dürfte ja in die Kategorie Win9x/ME fallen. ;)

Zitat:

Zitat von Wishmaster

du wirst sicherlich das passende finden.

Auf jeden Fall habe ich einiges zum Ansehen und Ausprobieren. Danke.

Auf dem ersten Blick sieht die AspiCD.pas ganz vielversprechend aus.

Ich hatte schon mal ein Beispiel mit ASPI.pas. Allerdings bekam ich da nur die Bezeichnung meiner Festplatten heraus.

[Garfield]

Als erstes habe ich mir 'Peter Tribe's VB ActiveX / Delphi VCL interface to AKRip32.dll' von der Seite http://akrip.sourceforge.net/download.html angesehen. Rausgekommen ist unten stehende Unit. Benötigt werden dafür die AKRip32.Dll, die AKRip32.pas und die AKRipVCL.pas. Eine Zuordnung zu den Laufwerksbuchstaben wird nicht vorgenommen. Wenn man die Laufwerksbuchstaben aber nicht manuell geändert hat, passen sie.

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ComCtrls, StdCtrls, Buttons, AKRipVCL;

type
  TForm1 = class(TForm)
    Drives: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;
  AK: TAKRip;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  i             : Integer;
  lngHA         : Integer;
  lngTGT        : Integer;
  lngLUN        : Integer;
  lngPAD        : Integer;
  strID         : String;
  strVendor     : String;
  strProductID  : String;
  strRevision   : String;
  strVendorSpec : String;

begin
  Drives.Clear;
  for i := 0 to 25 do
    if GetLogicalDrives and (1 shl i) <> 0
    then
      if GetDriveType(PAnsiChar(Chr(i + Ord('A')) + ':\')) = DRIVE_CDROM
      then Drives.Items.Add(Chr(i + Ord('A')) + ' - ');

  AK.GetCDList;
  if AK.GetCDListCount > 0
  then begin
    for i :=0 to AK.GetCDListCount - 1 do
    begin
      AK.GetCDListRecord(i, lngHA, lngTGT, lngLUN, lngPAD, strID);
      Drives.Items[i] := Drives.Items[i]
                       + '['
                       + IntToStr(lngHA)
                       + ':'
                       + IntToStr(lngTGT)
                       + ':'
                       + IntToStr(lngLUN)
                       + '] ';

      AK.GetCDListInfo(i, strVendor, strProductID, strRevision, strVendorSpec);
      Drives.Items[i] := Drives.Items[i]
                       + trim(strVendor)
                       + ' '
                       + trim(strProductID);

    end;
  end;

end;

end.

[Garfield]

Jetzt habe ich noch 'Holger Dors' Delphi interface to AKRip32.dll', ebenfalls von http://akrip.sourceforge.net/download.html, angesehen. Das Ergebnis ist das selbe. Es wird allerdings nur die akrip32.pas und die akrip32.dll benötigt. Die akrip32.pas unterscheidet sich aber von der oben genannten.

Das sieht dann so aus:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls,
  Forms, Dialogs, ComCtrls, StdCtrls, Buttons, akrip32;

type
  TForm1 = class(TForm)
    Drives: TListBox;
    procedure FormCreate(Sender: TObject);
  private
    { Private-Deklarationen }
  public
    { Public-Deklarationen }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  MyList       : CDLIST;
  i            : Integer;

begin
  Drives.Clear;
  for i := 0 to 25 do
    if GetLogicalDrives and (1 shl i) <> 0
    then
      if GetDriveType(PAnsiChar(Chr(i + Ord('A')) + ':\')) = DRIVE_CDROM
      then Drives.Items.Add(Chr(i + Ord('A')) + ' - ');

  MyList.Max := MAXCDLIST;
  if MyList.Max > 0
  then begin
    GetCDList(MyList);
    for i := 0 to MyList.Num - 1
    do begin
      Drives.Items[i] := Drives.Items[i]
                       + '['
                       + IntToStr(MyList.Cd[i].ha)
                       + ':'
                       + IntToStr(MyList.Cd[i].tgt)
                       + ':'
                       + IntToStr(MyList.Cd[i].lun)
                       + '] '
                       + trim (MyList.Cd[i].info.vendor)
                       + ' '
                       + trim (MyList.Cd[i].info.prodId);
    end;
  end;

end;

end.

Wenn die Zuordnung zu Buchstaben nicht wäre, würde das ja ausreichen.

[Garfield]

Jetzt habe ich BassCD.Dll ausprobiert. Damit bekomme ich das, was ich wollte: Einen Laufwerksbuchstaben und den Namen des Laufswerkes. Dazu benötigt man von der Seite http://www.un4seen.com/bass.html die bass und die basscd. Für das Projekt nimmt man daraus die bass.pas, bass.dll, basscd.pas und basscd.dll. Im Archiv zur basscd ist ein Beispielprojekt. Das habe ich zusammengestrichen. Außerdem noch die Variable LW: String und zwei Befehle eingefügt sowie einen geändert, um die Laufswerkbezeichnung auf den Namen zu kürzen. Das sind unten die drei Befehle nach dem Begin bei Zeile 50/51. Ich habe keine Lust nachzuzählen; auf jeden Fall ist hier die Zeilenhöhe in beiden Spalten unterschiedlich. Die unit1 sieht dann so aus:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, SysUtils, Forms, Classes, Controls, StdCtrls, Bass, BassCD;

type
  TForm1 = class(TForm)
    cmbDrives: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure cmbDrivesChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  MAXDRIVES = 10;

var
  Form1: TForm1;

  curdrive: Integer = 0;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  n: PChar;
  a: Integer;
  lw,
  text: String;
begin
   // check that BASS 2.1 was loaded
   if (BASS_GetVersion <> DWORD(MAKELONG(2,1))) then
  begin
    MessageBox(0, 'BASS version 2.1 was not loaded', 'Error', MB_ICONERROR);
      Halt;
   end;

  // Get list of available drives
  a := 0;
  n := BASS_CD_GetDriveDescription(a);
  while (a < MAXDRIVES) and (n <> nil) do
  begin
    lw := n;
    lw := copy(lw, 0, pos(' v', lw) - 1);
    text := Format('%s: %s', [Char(BASS_CD_GetDriveLetter(a)
          + Ord('A')), lw]); // "letter: description"
    cmbDrives.Items.Add(text);
    a := a + 1;
    n := BASS_CD_GetDriveDescription(a);
  end;
  if (a = 0) then
  begin
    MessageBox(0, 'No CD drives found', 'Error', MB_ICONERROR);
    Halt;
  end;
  cmbDrives.ItemIndex := 0; // select 1st drive

end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  BASS_Free;
end;

procedure TForm1.cmbDrivesChange(Sender: TObject);
begin
  // change current drive
  curdrive := cmbDrives.ItemIndex;
end;

end.

Auf der Form befindet sich nur noch eine ComboBox.

Bleibt nur eine Sache. Die BassCD.Dll findet ein CD-Laufwerk, was am Promise-Raidcontroller hängt, nicht.

PS: Bei Interesse könnte ich auch mal die Projekte anhängen.

[Garfield]

Ich habe mir das Projekt im letzten Beitrag noch mal vorgenommen. Es werden nur noch die bass.dll und basscd.dll benötigt. Die Unit1 sieht dann wie folgt aus:

Delphi-Quellcode:

unit Unit1;

interface

uses
  Windows, SysUtils, Forms, Classes, Controls, StdCtrls;

type
  TForm1 = class(TForm)
    cmbDrives: TComboBox;
    procedure FormCreate(Sender: TObject);
    procedure cmbDrivesChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

const
  MAXDRIVES = 10;
  basscddll = 'basscd.dll';

function BASS_CD_GetDriveDescription(drive:DWORD): PChar; stdcall; external basscddll;
function BASS_CD_GetDriveLetter(drive:DWORD): DWORD; stdcall; external basscddll;

var
  Form1: TForm1;

  curdrive: Integer = 0;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
  n: PChar;
  a: Integer;
  lw,
  text: String;
begin

  // Get list of available drives
  a := 0;
  n := BASS_CD_GetDriveDescription(a);
  while (a < MAXDRIVES) and (n <> nil) do
  begin
    lw := n;
    lw := copy(lw, 0, pos(' v', lw) - 1);
    text := Format('%s: %s', [Char(BASS_CD_GetDriveLetter(a)
          + Ord('A')), lw]); // "letter: description"
    cmbDrives.Items.Add(text);
    a := a + 1;
    n := BASS_CD_GetDriveDescription(a);
  end;
  if (a = 0) then
  begin
    MessageBox(0, 'No CD drives found', 'Error', MB_ICONERROR);
    Halt;
  end;
  cmbDrives.ItemIndex := 0; // select 1st drive

end;

procedure TForm1.cmbDrivesChange(Sender: TObject);
begin
  // change current drive
  curdrive := cmbDrives.ItemIndex;
end;

end.

Im Anhang das Projekt als Source mit DLL.

Nachtrag: Ich hoffe, eine Stunde ist nicht so lang, als dass der Nachtrag nicht mehr gelesen wird.

Die virtuellen Laufwerke auf meinen beiden Rechnern werden als 'Generic' erkannt, während die anderen mit Namen (nur Großbuchstaben) angegeben werden. Kann ich im Umkehrschluss davon ausgehen, dass 'Generic' immer virtuelle Laufwerke sind? Denn dann kann ich wenigsten die schon mal ausschließen.

[Garfield]

Mit der Bass werden die Laufwerke nicht nach dem Laufwerksbuchstaben sortiert. In anhängenden Projekt werden die DLL dynamisch geladen und die Laufwerksbezeichnungen in ein TStringList geschrieben. Die Stringliste wird sortiert und an die ComboBox übergeben.

[Garfield]

Für Windows 9x/ME habe ich bei Blenk Software in den Delphi Tipps unter der Überschrift "Bezeichnung des CD-Rom Laufwerks ermitteln" eine Funktion gefunden, welche die Laufwerksbezeichnung aus der Registry ausliest.

Der Funktion wird der Laufwerksbuchstabe übergeben. Der zurückgegebene String enthält noch überflüssige Leerzeichen, welche mit TRIM entfernt werden.

[Alter Mann]

Hallo,

Du kannst es ja hiermit versuchen (Beispiel):

Code:

unit wmiCDROM;

interface

uses Windows, Classes, Contnrs, Variants;

  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;
  FUserName     := UserName;
  FUserPwd      := UserPwd;
  FComputerName := ComputerName;
  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', '', '', '', '', wbemConnectFlagUseMaxWait, 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.

WMI muss allerdingst installiert bzw. unterstützt werden.

[Garfield]

Das ist so etwas, wie OregonGhost oben vorgeschlagen hatte. Vielen Dank, werde ich morgen früh gleich ausprobieren.

[Garfield]

Moin, moin:

Ich habe mich also noch einmal mit WMI beschäftigt. Zu der Frage der Installation von WMI habe ich folgendes gefunden:

Windows Management Instrumentation:

Zitat:

WMI is preinstalled in Windows Server 2003, Windows XP, Windows Me, and Windows 2000.

INFO: Windows Management Instrumentation (WMI) on Computers Running Windows 98, Windows 98 Second Edition, and Windows Millennium Edition

Zitat:

Systemanforderungen

• Unterstützte Betriebssysteme: Windows 95, Windows 98, Windows NT

Softwareanforderungen:
1. Microsoft® Windows® NT 4 SP 4 oder höher, Windows 95, Windows 98. (WMI ist unter Windows 2000 und Windows Me bereits standardmäßig installiert)
2. DCOM-Version 1.3 für Windows 95

Downloads für ältere Systeme:

• Windows 95/98
• Windows 98/98SE/ME, Alternativdownload zum vorherigen Link.
• Windows NT 4.0.
• SDK für Windows 95/98/NT 4.0

In dem Beispiel habe ich in Zeile 7 ein Type eingefügt. Und nun hänge ich bei den Uses von Zeile 46, weil ich keine WbemScripting_TLB.pas/dcu habe. Über Active X importieren habe ich es leider nicht gefunden. Ich benutze dafür Delphi 7 Personal unter Windows XP.

Nachtrag: Die WbemScripting_TLB.pas habe ich gerade in http://www.delphipraxis.net/internal...ct.php?p=77262 gefunden.

Nachtrag 2: War möglicherweise nicht die richtige bzw eine alte WbemScripting_TLB.pas (Version 1.1). In der wmiCDROM werden unter 'constructor TCDROMDrive.Create(CDROMDeviceID : String);' UserName, UserPwd und ComputerName sowie unter 'TCDROMDrive.SystemValues(CDROMDeviceID : String);' wbemConnectFlagUseMaxWait als undefinierte Bezeichner moniert.

Nachtrag 3: http://www.sysextensions.net/kompone...compdelphi.htm
http://www.online-admin.com/register_wmiset.html

[Garfield]

Zitat:

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.

[Alter Mann]

Hallo

danke für die "Berichtigungen" :wink:

Zitat:

# Zeile 57ff (FUserName := UserName; FUserPwd := UserPwd; FComputerName := ComputerName;) herausgenommen und
# Zeile 85/86 das 'wbemConnectFlagUseMaxWait' durch 0 ersetzt.

Zeile 57ff : war beabsichtigt, damit man weiss wie es Remote geht!
Zeile 85/86: Mit 'wbemConnectFlagUseMaxWait' habe ich sooo meine Erfahrungen; Auf meinem privaten Rechner wurde
der Wert($80) korrekt importiert, auf Arbeit nicht :|
Woran es liegt :?: Habe mich noch nicht auf die Suche gemacht, sondern einfach

Delphi-Quellcode:

interface
...
Const
  wbemConnectFlagUseMaxWait = $80;
...

geschrieben.
Weitere Probleme gab es unter Windows XP nicht, abgesehen davon das nicht immer alle theoretisch Verfügbaren
Properties auch verfügbar sind. Beim Lauf innerhalb der IDE bekommt man zu hauf Unterbrechungen mit der Meldung "Ungültiges Argument" :?
Weiterhin habe ich die Erfahrung gemacht, das im PSK steht, das die Eigenschaft ein Array(also ein Variablenfeld) ist
und versuche es auszulesen, kommt die Meldung das es sich nicht um Array handelt, sondern ein 'einfacher Wert' ist.
Dafür läuft die Sache auf einem anderen Rechner 1a. :?:

Ansonsten scheint es unter W2K Probleme zu geben.

Allgemein gesagt kann man WMI nutzen, die Garantie das alle wünschenswerten Eigenschaften auch tatsächlich vorhanden
sind gibt es scheinbar nicht. :?

Gruß

[Garfield]

Guten Abend,

Zitat:

Zitat von Alter Mann

danke für die "Berichtigungen" :wink:

Wenn ich mit meinen bescheidenen Kenntnissen sonst nicht helfen kann.

Zitat:

Zitat von Alter Mann

Zeile 85/86: Mit 'wbemConnectFlagUseMaxWait' habe ich sooo meine Erfahrungen;

Die 0 hatte ich in einem anderen Source gesehen. Luckie hat mir heute dort gezeigt, wie ich die WbemScripting_TLB importieren muss. Nun habe ich die MS WMI Scripting V1.2 Library (Version 1.2) importiert. Damit erzeugt die Variable wbemConnectFlagUseMaxWait keine Fehlermeldung mehr und wird mit 128 ($80) angegeben. Das Ergebnis ist jedoch gleich geblieben. Die Variable Propval zeigt die String, wie sie in den DeviceClasses in der Registry stehen. ZB 'IDE\CDROMMATSHITA**'.

Leider kann ich Dir dabei nicht weiterhelfen, weil meine Englischkenntnisse noch schlechter als meine Delphikenntnisse sind. :|

Ich habe mir in dem Zusammenhang von http://www.online-admin.com/download.html die Demo StorageInfo heruntergeladen. Diese Demo hat die gewünschten Laufwerksinformationen angezeigt. Die Demo enthält auch die Source ohne die WMI Componente, welche es als Sharewareversion (58 US$) zum Download gibt. Das Archiv enthält die vorcompilierten Komponenten.

Aus Neugier habe ich es dann unter Win98SE getestet. Die unter XP compilierte EXE ergab einen Fehler 'ungültige Variable'. Dann wollte ich es mit Delphi 3 Prof compilieren. Dort habe ich MS WMI Scripting V1.1 Library (Version 1.1) importiert und es gab wieder den Fehler mit dem unbekannten wbemConnectFlagUseMaxWait. CNT : Integer mochte D3 natürlich auch nicht. Und nachdem ich LongInt draus gemacht habe, hat sich der Compiler irgenwohin verlaufen.

Sieht so aus, als würde es wbemConnectFlagUseMaxWait erst in der MS WMI Scripting V1.2 Library geben.

[Luckie]

Zitat:

Zeile 85/86: Mit 'wbemConnectFlagUseMaxWait' habe ich sooo meine Erfahrungen;

Gibt es erst ab Windows XP. Gib da 0 an, wenn es unter 2000 laufen soll.

[Garfield]

Zitat:

Timeout on connection

When connecting to WMI through a call to SWbemLocator.ConnectServer or IWbemLocator::ConnectServer, you can set the wbemConnectFlagUseMaxWait flag (scripting) or the WBEM_FLAG_CONNECT_USE_MAX_WAITin C++ value to 128 (0x80) to impose a 2 minute timeout on the call.

Windows 2000, Windows NT, Windows 98, and Windows 95: The wbemConnectFlagUseMaxWait and WBEM_FLAG_CONNECT_USE_MAX_WAIT flags are not available.

[Luckie]

@Garfield: Und was habe ich anderes gesagt:

Zitat:

Windows 2000, Windows NT, Windows 98, and Windows 95: The wbemConnectFlagUseMaxWait and WBEM_FLAG_CONNECT_USE_MAX_WAIT flags are not available.

[Alter Mann]

OK, danke, muss ich überlesen haben. :?
Ich meinte es noch etwas anders; 2 PC, beide mit Windows XP und WMI Scripting V1.5 Library.
Auf dem einen ist sie (wbemConnectFlagUseMaxWait) deklariert auf dem anderen nicht. Aufgefallen ist mir das, als ich den Source auf dem anderen Rechner compilieren wollte und ich die Meldung "unbekannter Bezeichner" o.s. erhielt.

[Garfield]

Zitat:

Zitat von Luckie

@Garfield: Und was habe ich anderes gesagt:

Entschuldige, ich wollte Dir nicht zu nahe treten. Mir ging es mehr um den ersten Absatz.

Zitat:

Zitat von Alter Mann

Ich meinte es noch etwas anders; 2 PC, beide mit Windows XP und WMI Scripting V1.5 Library. ...

:shock: Ich habe nun mein Projekt auf dem selben Rechner mit Win98SE getestet. Da kam so etwas wie 'Invalid Parameter'. Bei einem anderen Rechner, bei welchem das XP von derselben CD installiert wurde, startete die Projektexe nicht einmal.

[Alter Mann]

Ist ja ok,
habe heute eine w2k+D7-Installation auf VMWare durchgezogen und Versuche mal zu ergründen woran es liegt.
Falls es was gibt melde ich mich.

[Garfield]

Oben hatte ich geschrieben:

Zitat:

Zitat von Garfield

Nun scheint bei Zeile 104, 105 ein Fehler zu sein. Denn (CDROMDeviceID = PropVal) kann nicht eintreten, weil PropVal zum Beispiel 'IDE\CDROM...' ist.

Dies waren die Zeilen:

Delphi-Quellcode:

...
PropVal := (FWMIObj.Properties_.Item('DeviceID', 0) as ISWbemProperty).Get_Value;
if not (VarIsEmpty(PropVal) or VarIsNull(PropVal)) and (CDROMDeviceID = PropVal) then
...

Nach einigem googeln und nachdenken bin ich auf folgendes gekommen: Ich will die Informationen zu einem Laufwerk. Alles was ich habe, ist der Laufwerksbuchstabe. Das ist der DriveLetter. Mit einen : dahinter wird daraus ein Drive.In der Registry kann man - zumindest bei Win9x - Einträge 'Drive' mit zum Beispiel dem Wert 'E:' finden. Also habe ich DeviceID durch Drive ersetzt und als Ergebnis wird mir als '*.Name' mein Laufwerksname zurückgegeben.

Nachtrag:

Unter Win98SE muss die Variable 'wbemConnectFlagUseMaxWait' durch 0 ersetzt und anstelle von '*.Name' '*.Description' verwendet werden. Als '*.Name' wird das Laufwerk zurückgegeben.