1. Reklam


    1. joysro
      ledas
      jungler
      keasro
      zeus
      karantina

VB'de Disk Bilgilerini Öğrenmek


  1. Narqotic

    Narqotic Bilgiliyim rank8

    Kayıt:
    22 Nisan 2007
    Mesajlar:
    1.365
    Beğenilen Mesajlar:
    0
    Ödül Puanları:
    0
    Meslek:
    !!!
    Şehir:
    BeN SeNiN CaNıN İçİN ÖmRüMü BiR KiBRiTiN KaBıNDa T
    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