Delphi-PRAXiS
Seite 2 von 4     12 34      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi Name des CD-ROM-Laufwerks (zB LITEON LTD163D) (https://www.delphipraxis.net/37722-name-des-cd-rom-laufwerks-zb-liteon-ltd163d.html)

Kernel32.DLL 10. Jan 2005 20:38

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
:duck:
Bei uns an der Schule Win98!!

Wishmaster 11. Jan 2005 04:44

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
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 11. Jan 2005 12:59

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
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 11. Jan 2005 19:11

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 11. Jan 2005 21:24

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 11. Jan 2005 23:23

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 12. Jan 2005 07:50

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 12. Jan 2005 17:29

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
Liste der Anhänge anzeigen (Anzahl: 1)
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 15. Jan 2005 16:08

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
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 15. Jan 2005 18:53

Re: Name des CD-ROM-Laufwerks (zB LITEON LTD163D)
 
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.


Alle Zeitangaben in WEZ +1. Es ist jetzt 06:19 Uhr.
Seite 2 von 4     12 34      

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024-2025 by Thomas Breitkreuz