CD eingelegt ?

[Proton]

Hast du deinen eigenen Code-Schnipsel denn schon mal ausprobiert ?


Nochmal langsam zum mitdenken:

- ich lege eine CD ins laufwerk
- dann starte ich mein (dein) Programm

Code: Alles auswählen

Debug FileSize("f:\*.*")

Als Rückgabewert erhalte ich: 44

- ich lege nun eine ANDERE CD ins Laufwerk
- dann starte ich wieder mein (dein) Programm:

Code: Alles auswählen

Debug FileSize("f:\*.*")

Als Rückgabewert erhalte ich nun: 101

Das ganze könnte ich jetzt mit allen meinen 12634 CD's machen und
immer würde ich einen anderen RÜCKGABEWERT erhalten.

WARUM ? Was sagt mir dieser sich ändernde Wert ? Ist das die aktuelle
Temperatur in Chicago in °F ? Oder was ?

[Falko]

PB 3.X? habe das unter PB4 und 3.94 überhaupt nicht. Ich bekomme tatsächlich nur
die Rückgabewerte-1 und -2 heraus, wie in der Hilfe beschrieben.
Warum bei dir was anderes rauskommt ist mir schleierhaft.

Grüße ...Falko

[Proton]

Habs gerade auf V3.94 und V4.0 probiert. Gleiche Ergebnisse.

[Falko]

Die Filegröße, wenn eine gefunden wird, wird zurückgegeben. Hatte bei meinen CD-ROM nur Verzeichnisse und ebenso beim Laufwerk F:.

Steht ja auch in der Hilfe drin.

...Gibt die Größe der angegebenen Datei zurück.

Besondere 'Ergebnis' Werte:
-1: Datei wurde nicht gefunden.
-2: Datei ist ein Verzeichnis.

Gruß ...Falko

[stbi]

Hier ein Code von mir, der mit Disketten- und CD-Laufwerken funktioniert:

Code: Alles auswählen

Procedure.s CheckDriveName(drive.s)
  drive = UCase(Left(drive, 1))
  If Asc(drive) < 65 Or Asc(drive) > 90
    drive = "A"
  EndIf
  drive = drive + ":\"
  ProcedureReturn drive
EndProcedure

Procedure.s GetDriveSerial(drive.s) 
    Protected label.s = Space(256), filesystem.s= Space(256), serial.l , rc.l
    drive = CheckDriveName(drive)
    rc = GetVolumeInformation_(drive, @label, 255, @serial, 0, 0 , @filesystem, 255) 
    If rc
      ProcedureReturn Left(RSet(Hex(serial), 8, "0"), 4) + "-" + Right(RSet(Hex(serial), 8, "0"), 4)
    Else
      ProcedureReturn("")
    EndIf  
EndProcedure

If GetDriveSerial("a:") <> ""
  debug "Disk eingelegt"
else
  debug "nix vernünftiges drinne"
endif 

Die Prozedur CheckDriveName() habe ich deswegen gemacht, weil ich festgestellt habe, dass verschiedene Windows-Versionen sich bei GetVolumeInformation_() unterschiedlich verhalten. Manche funktionieren mit "A:" oder "A", andere nur mit "A:\", aber letzteres funktioniert bei allen Versionen.

[Proton]

Bin jetzt mit dem USB-Stick von Computer zu Computer gelaufen und habe
den FILESIZE("*.*")-Test gemacht.

Ergebnis: 4:1

Das bedeutet, dass 4 Computer bei meiner Test-CD den Wert "105" geliefert
haben, und 1 Rechner "-1".


Beide Werte sind unverständlich. Was 105 bedeuten soll weiss ich nicht. -1 ist
ebenfalls ein Quatsch weil ja Dateien auf der CD enthalten sind.

Scheint irgendwie von der Hardware abhängig zu sein. Auf jeden Fall ist eine
Anwendung der Funktion FILESIZE() bei CD/DVD-Drives mit dem Parameter
"*.*" nicht ratsam.


Kann dieses Verhalten jemand bestätigen

[Falko]

>>>Anwendung der Funktion FILESIZE() mit dem Parameter "*.*" nicht ratsam.

So wie es aussieht hast du Recht. Wenn ich das beim Laufwerk C: mache,
wird komischerweise wohl eine Datei gefunden und die Dateigröße angezeigt,
obwohl dort auch Verzeichnisse vorhanden sind.

Ist keine CD eingelegt, wird korrekt -1 zurückgegeben.
ist aber eine CD mit Dateien und Verzeichnissen eingelegt, wird bei mir
-2 zurück gegeben. Zwar sind Dateien vorhanden, aber anscheinden läuft das
bei CD's anders wie bei Festplatten

Grüße ...Falko

[Shardik]

Was ist mit Leer-CD gemeint? Ein unbeschriebener CD-Rohling jedenfalls wird bei mir unter WinNT 4 SP6 und unter WinXP SP2 nicht als "LEER-CD-ROM eingelegt" angezeigt, sondern als "Keine CD-ROM eingelegt".

War ja zu erwarten, dass es auf NT-Systemen anders läuft.

Hier noch ein Code ( für NT-Systeme ) der testet ob eine CD in Laufwerk liegt, egal ob beschrieben oder nicht.

Code: Alles auswählen

#IOCTL_STORAGE_CHECK_VERIFY = $2D4800

Procedure VerifyMedia(LW.s)
    ;Check for Media
    Protected hLwStatus.l
    hLwStatus = CreateFile_("\\."+LW,#GENERIC_READ|#GENERIC_WRITE, 0, 0, #OPEN_EXISTING, 0, 0)
    If hLwStatus
        Retval.l = DeviceIoControl_(hLwStatus, #IOCTL_STORAGE_CHECK_VERIFY,0,0,0,0,@RetBuffer,0)
        CloseHandle_(hLwStatus)
    EndIf
    ProcedureReturn Retval
EndProcedure

Select = VerifyMedia("P:");Pfad anpassen
  Case 1
    Debug "CD im Laufwerk"
  Case 0
    Debug "Keine CD im Laufwerk"
EndSelect

Dieses Beispiel funktioniert bei NT-Systemen leider auch nicht korrekt. Zunächst einmal sollte #GENERIC_WRITE aus CreateFile() herausgenommen werden:

Code: Alles auswählen

    hLwStatus = CreateFile_("\\."+LW,#GENERIC_READ, 0, 0, #OPEN_EXISTING, 0, 0)

Dann werden beschriebene CD-Rs als "CD im Laufwerk" angezeigt. Leider wird ein unbeschriebener Rohling immer noch genauso behandelt wie eine nicht eingelegte CD, nämlich mit der Meldung "Keine CD im Laufwerk". In beiden Fällen gibt DeviceIoControl() den Rückgabewert 0 und GetLastError() den Fehler 21 ("Das Gerät ist nicht bereit") aus.

[Falko]

Hiermit müsste das gehen. Wenn jemand das von VB nach PB
Portieren könnte wäre sehr nett.

http://artsoft.agava.ru/winapi2.htm

Und zwar Kaptitel bzw. Nummer 19. was hier noch einmal als Source abgebildet ist.

19. How to detect when a CD-ROM is inserted? Download this sample Top

Public Declare Function CallWindowProc Lib "user32" _
Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, _
ByVal hwnd As Long, _
ByVal Msg As Long, _
ByVal wParam As Long, _
ByVal lParam As Long) As Long

Public Declare Function GetWindowLong Lib "user32" _
Alias "GetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long) As Long

Public Declare Function SetWindowLong Lib "user32" _
Alias "SetWindowLongA" (ByVal hwnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long

Public Const GWL_WNDPROC = (-4)
Public Const WM_DEVICECHANGE = &H219

Public glngPrevWndProc As Long



Public Function MyWindowProc(ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If Msg = WM_DEVICECHANGE Then
Select Case wParam

' If device (CD-ROM) is inserted...
Case &H8000&
Call Form1.DeviceArrival

' If CD-ROM has been ejected...
Case &H8004&
Call Form1.DeviceRemoveComplete
End Select
MyWindowProc = 0
Exit Function
End If

' pass the rest messages onto VB's own Window Procedure
MyWindowProc = CallWindowProc(glngPrevWndProc, hwnd, Msg, wParam, lParam)
End Function

Using: Make a form and put this code there:

Private Sub Form_Load()
' Redirect Windows messages to our Window Procedure
' Module1.MyWindowProc
glngPrevWndProc = GetWindowLong(hwnd, GWL_WNDPROC)
SetWindowLong hwnd, GWL_WNDPROC, AddressOf MyWindowProc
End Sub

Private Sub Form_Unload(Cancel As Integer)
' pass control back to VB
SetWindowLong hwnd, GWL_WNDPROC, glngPrevWndProc
End Sub

Sub DeviceArrival()
' Here place your code that will run when a CD-ROM is inserted
Label1.Caption = "Device has appeared"
End Sub


Sub DeviceRemoveComplete()
' Here place your code that will run when the CD-ROM is ejected
Label1.Caption = "Device has disappeared"
End Sub

Gruß ...Falko

[edel]

Hiermit müsste das gehen. Wenn jemand das von VB nach PB
Portieren könnte wäre sehr nett. [...]

Code: Alles auswählen

#DBT_DEVICEARRIVAL        = $8000
#DBT_DEVICEREMOVECOMPLETE = $8004
#DBT_DEVTYP_VOLUME        = $0002

Procedure.s GetDevice(Bits) 
  For i = 'A' To 'Z' 
    If Bits & 1 = 1
      Laufwerk.s = Chr(i)
    EndIf
    Bits = Bits >> 1 
  Next
  ProcedureReturn Laufwerk
EndProcedure

Procedure CB(hwnd,msg,wParam,lParam)
  
  Protected *db.DEV_BROADCAST_HDR
  Protected *dbv.DEV_BROADCAST_VOLUME
  
  If msg = #WM_DEVICECHANGE
    Select wParam 
      Case #DBT_DEVICEARRIVAL        
        
        *db = lParam 
        
        If *db\dbch_devicetype = #DBT_DEVTYP_VOLUME 
          *dbv = *db 
          Laufwerk.s = GetDevice(*dbv\dbcv_unitmask) + ":" 
          Debug Laufwerk  + " = insert Media"
        EndIf
        
      Case #DBT_DEVICEREMOVECOMPLETE
        
        *db = lParam 
        
        If *db\dbch_devicetype = #DBT_DEVTYP_VOLUME
          *dbv = *db 
          Laufwerk.s = GetDevice(*dbv\dbcv_unitmask) + ":" 
          Debug Laufwerk + " = remove Media"
        EndIf 
        
    EndSelect
    ProcedureReturn 1
  EndIf
  
  ProcedureReturn #PB_ProcessPureBasicEvents
EndProcedure

hwnd = OpenWindow(0,#PB_Ignore,#PB_Ignore,200,200,"")

SetWindowCallback(@CB(),0)

Repeat : Until WaitWindowEvent() = #WM_CLOSE