Disk Bilgilerini Öğrenelim

Aşağıdaki programcık dilediğiniz sürücünün seri numarasını ve etiketini komut butonuna basıldığında size veriyor. "PathName$ = " satırını değiştirerek istediğiniz sürücüyü seçebilirsiniz...

' Formdan ayrı bir BAS modülüne girecek:
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

'Aşağıdaki kodların hepsi formun General -
Declarations bölümüne girecek
Private Sub cmdVolumeInfo_Click()
Dim r As Long
Dim PathName As String
Dim DrvVolumeName As String
Dim DrvSerialNo As String
PathName$ = "c:\"

rgbGetVolumeInformationRDI PathName$,
DrvVolumeName$, DrvSerialNo$

'Sonuçları Görüntüle
Print: Print " Sürücü İstatistikleri ", ": "; UCase$(PathName$)
Print: Print " Disk Etiketi ", ": "; DrvVolumeName$
Print " Seri Numarası", ": "; DrvSerialNo$
End Sub

Private Sub Form_Load()
Me.Move (Screen.Width - Me.Width) \ 2,
(Screen.Height - Me.Height) \ 2
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 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

Ayrıntılı Konu Bilgileri
Konu BaşlığıKonu: Disk Bilgilerini Öğrenelim	Cevap SayısıCevap Sayısı: 0 cevap var
Okunma SayısıOkunma Sayısı 41 defa	Konuyu Görüntüleyenler0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Benzer Konular
	Konu Başlığı	Başlatan	Yanıtlar	Görüntülenme	Son Mesaj
	Hasta bilgilerini içeren çipi deri altına yerleştirme olasılığı Bilim & Net haberleri	@kif1905	0	27	Temmuz 08, 2007, 10:41:28 ÖS Gönderen: @kif1905
	Almanca Cümle Kurmayı Öğrenelim Almanca & İng. & Fransızca	Crazy_ManN	0	42	Eylül 07, 2007, 09:56:46 ÖS Gönderen: Crazy_ManN
	Humaxınıza yazılım yüklemeden önce Mutlaka cihaz bilgilerini bir kenara yazın Digital Uydu Alıcıları (Popüler Markalar)	Crazy_ManN	0	48	Eylül 13, 2007, 09:12:18 ÖS Gönderen: Crazy_ManN
	CPU-Z 1.43 (Bilgisayarınızın Tüm Bilgilerini Verir ; Anakart, Bios, vs ) Çöplük	Crazy_ManN	6	101	Mart 15, 2008, 03:44:10 ÖS Gönderen: _SYMANTEC_
	6 milyon kişinin kişisel bilgilerini internete düştü Network / İnternet	Crazy_ManN	0	70	Mayıs 12, 2008, 02:04:19 ÖS Gönderen: Crazy_ManN

	Gönderen	Konu: Disk Bilgilerini Öğrenelim (Okunma Sayısı 41 defa)
0 Üye ve 1 Ziyaretçi konuyu incelemekte.