PureBoard

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

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

Andreas hat geschrieben:

Shardik hat geschrieben: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

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

VB hat geschrieben: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

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

#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