Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!Code-Beispiel
Alle Laufwerke des Computers ermitteln.
| Lizenz: | Erster Autor: | Letzte Bearbeitung: |
| k. A. |  Eternal_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 | |||||||
|---|---|---|---|---|---|---|---|
|
|
||||||
Bearbeiten
Versionen