Buchempfehlung
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Mikrocomputertechnik mit Controllern der Atmel AVR-RISC-Familie
Umfassend, aber leicht verständlich führt dieses Buch in die Programmierung von ATMEL AVR Mikrocontrollern ein. [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

Code-Beispiel

Code-Beispiele » Dateien und Laufwerke

Alle Laufwerke des Computers ermitteln.

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.MitgliedEternal_Pain 28.01.2011

Quelle:fb@rchive
Author:Benjamin Kunz

Heute zeige ich euch mal, wie ihr alle Laufwerke eines Computers ermitteln könnt.

Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
 (ByVal nDrive As String) As Long
Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
 (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Const DRIVE_REMOVABLE = 2
Const DRIVE_FIXED = 3
Const DRIVE_REMOTE = 4
Const DRIVE_CDROM = 5
Const DRIVE_RAMDISK = 6

Public Function LaufwerksTyp(ByVal Drive As String) As String

  Dim lType As Long

  lType = GetDriveType(Drive)
  Select Case lType
    Case DRIVE_REMOVABLE
      LaufwerksTyp = "Wechselmedium"
    Case DRIVE_FIXED
      LaufwerksTyp = "Festplatte"
    Case DRIVE_REMOTE
      LaufwerksTyp = "Netzlaufwerk"
    Case DRIVE_CDROM
      LaufwerksTyp = "CD-ROM"
    Case DRIVE_RAMDISK
      LaufwerksTyp = "RAM-Disk"
    Case Else
      LaufwerksTyp = "Unbekanntes Medium"
  End Select
End Function

Private Sub GetAllDrives()
  Dim Buffer As String * 255
  Dim Drives As String
  Dim Result As Long
  Dim Drive As String
  Dim sPos As Integer

  Result = GetLogicalDriveStrings(Len(Buffer), Buffer)
  Drives = Left$(Buffer, Result)

  While Len(Drives) > 0
    sPos = InStr(Drives, Chr$(0))
    Drive = Left$(Drives, sPos - 1)
    Drives = Mid$(Drives, sPos + 1)

    Print Left$(Drive, 2);" [";LaufwerksTyp(Drive);"]"
  Wend
End Sub

'Print GetAllDrives 'das kann nicht gehen: GetAllDrives ist eine Sub
GetAllDrives

Sleep
End

..hier nun die ytwinky-version(getestet(!!) mit FB0.181b):

Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
 (ByVal nDrive As String) As Integer
Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" _
 (ByVal nBufferLength As Integer, ByVal lpBuffer As String) As Integer

Function LaufwerksTyp(ByVal Drive As String) As String
'   Enum LwTypes 'nur zum Verständnis der Bezeichner..
'       DRIVE_REMOVABLE = 2
'       DRIVE_FIXED
'       DRIVE_REMOTE
'       DRIVE_CDROM
'       DRIVE_RAMDISK
'   End Enum
    Dim LwType(5) As String={"Unbekanntes Medium", "Wechselmedium", "Festplatte", "Netzlaufwerk", "CD-ROM", "RAM-Disk"}
    Dim lType As Integer=GetDriveType(Drive)
    Return LwType(IIF(lType<2 Or lType>6, 0, lType-1))
End Function

Sub GetAllDrives()
  Dim Buffer As String * 255
  Dim As String Drive, Drives = Left(Buffer, GetLogicalDriveStrings(Len(Buffer), Buffer))
  Dim As Integer sPos

  While Len(Drives) > 0
    sPos = InStr(Drives, Chr(0))
    Drive = Left(Drives, sPos - 1)
    Drives = Mid(Drives, sPos + 1)
    Print Left(Drive, 2) &" [" &LaufwerksTyp(Drive) &"]"
  Wend
End Sub

GetAllDrives()
GetKey
End

Und nun noch ein Version ohne WinAPI(getestet mit FB0.182b):

'Laufwerke auf Anwesenheit prüfen (ohne WinAPI)
'chkdrive.bas ¸ 2007 by ytwinky, MD
Function SkipDisk(Dr As String) As Byte
  Dim s As String*1
  Print "Laufwerk " &Dr &": auslassen[j|n]?";
  Do
    s=lcase(InKey)
    Sleep 1
  Loop Until InStr("jn", s)
  Print s
  Return s="j"
End Function

Dim As String c=CurDir(), Lw="CDEFGHIJKLMNOPQRSTUVWXYZ"
Lw=*IIf(SkipDisk("B"), @"", @"B") &*IIf(SkipDisk("A"), @"", @"A") &Lw
PRINT "Folgende Laufwerke sind z.Z. vorhanden:"
For i As Byte=0 To Len(Lw)-1 'Nur die Laufwerke in Lw testen
  If ChDir(Chr(Lw[i]) &":\")=0 Then Print Chr(Lw[i]) &":"
Next i
ChDir c
Print "Eniki..";
GetKey
End

Zusätzliche Informationen und Funktionen
  • Das Code-Beispiel wurde am 13.06.2007 von MitgliedEternal_Pain angelegt.
  • Die aktuellste Version wurde am 28.01.2011 von Redakteurytwinky gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen