Sabit Disk Bilgileri

1 - bir -I

(Modul)(General)(Declaration)
Option Explicit
Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLength As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

Private Sub rgbGetVolumeInformationRDI(PathName$, DrvVolumeName$, DrvSerialNo$)
Dim r As Long
Dim pos As Integer
Dim HiWord As Long
Dim HiHexStr As String
Dim LoWord As Long
Dim LoHexStr As String
Dim VolumeSN As Long
Dim MaxFNLen As Long
Dim UnusedStr As String
Dim UnusedVal1 As Long
Dim UnusedVal2 As Long
DrvVolumeName$ = Space$(14)
UnusedStr$ = Space$(32)

r& = GetVolumeInformation(PathName$, DrvVolumeName$, Len(DrvVolumeName$), VolumeSN&, UnusedVal1&, UnusedVal2&, UnusedStr$, Len(UnusedStr$))

If r& = 0 Then Exit Sub
pos% = InStr(DrvVolumeName$, Chr$(0))
If pos% Then DrvVolumeName$ = Left$(DrvVolumeName$, pos% - 1)
If Len(Trim$(DrvVolumeName$)) = 0 Then DrvVolumeName$ = "(no label)"
HiWord& = GetHiWord(VolumeSN&) And &HFFFF&
LoWord& = GetLoWord(VolumeSN&) And &HFFFF&
HiHexStr$ = Format$(Hex(HiWord&), "0000")
LoHexStr$ = Format$(Hex(LoWord&), "0000")
DrvSerialNo$ = HiHexStr$ & "-" & LoHexStr$
End Sub

Function GetHiWord(dw As Long) As Integer
If dw& And &H80000000 Then
GetHiWord% = (dw& \ 65535) - 1
Else
GetHiWord% = dw& \ 65535
End If
End Function


Function GetLoWord(dw As Long) As Integer
If dw& And &H8000& Then
GetLoWord% = &H8000 Or (dw& And &H7FFF&)
Else
GetLoWord% = dw& And &HFFFF&
End If
End Function


Private Sub form_Click()
Dim r As Long
Dim PathName As String
Dim DrvVolumeName As String
Dim DrvSerialNo As String
PathName$ = " C:\"
rgbGetVolumeInformationRDI PathName$, DrvVolumeName$, DrvSerialNo$
Print: Print " Sürücü", , ": "; UCase$(PathName$)
Print: Print " Sürücü Etiketi", ": "; DrvVolumeName$
Print: Print " Seri Numarası", ": "; DrvSerialNo$
End Sub

2 - iki - II

(General)(Declaration)
Private Declare Function GetDiskFreeSpace Lib "kernel32" Alias "GetDiskFreeSpaceA" _
(ByVal lpRootPathName As String, lpSectorsPerCluster As Long, lpBytesPerSector As _
Long, lpNumberOfFreeClusters As Long, lpTotalNumberOfClusters As Long) As Long

Private Sub Form_click()
Dim x As Long
Dim sectorpercluster As Long
Dim bytepersector As Long
Dim freecluster As Long
Dim totalcluster As Long
x = GetDiskFreeSpace("c:\", sectorpercluster, bytepersector, _
freecluster, totalcluster)
Label1.Caption = sectorpercluster
Label2.Caption = bytepersector
Label3.Caption = freecluster
Label4.Caption = totalcluster
Label5.Caption = freecluster * sectorpercluster * bytepersector / 1024 / 1024 & "MB"
Label6.Caption = totalcluster * sectorpercluster * bytepersector / 1024 / 1024 & "MB"
End Sub