ما هو الكود الذي يقوم بقراءة رقم الهاردسك

وين الاخوان لحل هذا السؤال

أشكرك على هذا الوصلة الجميلة :D

:) :) :) :) :)

Public 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

هذا مرادك

يمدحون المثال يا استاذ طارق

لووووووووووووووووووووووووووول

عزيزي mmm أنا عبد الغني محسن عضو جديد في المنتدى أرسل لك هذا البرنامج عسى ان تجد فيه ماتطلب.

قم بإنشاء مشروع جديد وانسخ الكود التالي إلى نافذة الشيفرة:

Option Explicit

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

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 Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long

Private Const DRIVE_UNKNOWN = 0

Private Const DRIVE_NOTEXIST = 1

Private Const DRIVE_REMOVABLE = 2

Private Const DRIVE_FIXED = 3

Private Const DRIVE_REMOTE = 4

Private Const DRIVE_RAMDISK = 6

Private Const DRIVE_CDROM = 5

Private Sub cboDrives_Click()

Dim lSectorsPerCluster As Long

Dim lBytesPerSector As Long

Dim lFreeClusters As Long

Dim lTotalClusters As Long

Dim lReturn As Long

Dim sDrive As String

Dim lMbFactor As Long

Dim dByteSize As Double

Dim dSpace As Double

sDrive = cboDrives.List(cboDrives.ListIndex)

lReturn = GetDriveType(sDrive)

Select Case lReturn

Case DRIVE_UNKNOWN

lblInfo(0).Caption = "Unknown"

Case DRIVE_NOTEXIST

lblInfo(0).Caption = "Not Found"

Case DRIVE_REMOVABLE

lblInfo(0).Caption = "Removable"

Case DRIVE_FIXED

lblInfo(0).Caption = "Fixed"

Case DRIVE_REMOTE

lblInfo(0).Caption = "Remote"

Case DRIVE_RAMDISK

lblInfo(0).Caption = "Ram Disk"

Case DRIVE_CDROM

lblInfo(0).Caption = "CD-ROM"

End Select

lReturn = GetDiskFreeSpace(sDrive, lSectorsPerCluster, lBytesPerSector, lFreeClusters, lTotalClusters)

lblInfo(1).Caption = lSectorsPerCluster

lblInfo(2).Caption = lBytesPerSector

lblInfo(3).Caption = lFreeClusters

lblInfo(4).Caption = lTotalClusters

lMbFactor = 1024 ^ 2

dByteSize = CDbl(lSectorsPerCluster) * CDbl(lBytesPerSector) * CDbl(lFreeClusters)

lblInfo(5).Caption = Format$(dByteSize / lMbFactor, "###,##0")

dByteSize = CDbl(lSectorsPerCluster) * CDbl(lBytesPerSector) * CDbl(lTotalClusters)

lblInfo(6).Caption = Format$(dByteSize / lMbFactor, "###,##0")

End Sub

Private Sub Form_Load()

Dim sDriveNames As String

Dim lBuffer As Long

Dim lReturn As Long

Dim nLoopCtr As Integer

Dim nOffset As Integer

Dim sTempStr As String

lBuffer = 26 * 4 + 1

sDriveNames = Space$(lBuffer)

lReturn = GetLogicalDriveStrings(lBuffer, sDriveNames)

nOffset = 1

Do

sTempStr = Mid$(sDriveNames, nOffset, 3)

If Left$(sTempStr, 1) = vbNullChar Then Exit Do

cboDrives.AddItem sTempStr

nOffset = nOffset + 4

Loop

cboDrives.ListIndex = 0

End Sub

أرجو أن يكون هذا ماتبحث عنه.

اشكر الاخوة الذين قامو في المساهمة في حل هذا السؤال

ولقد وجدت كود رائع وهو

قم بانشاء صفحة جديدة

Option Explicit

Private Const MAX_FILENAME_LEN = 256

Private Declare Function GetVolumeInformation& Lib "kernel32" Alias "GetVolumeInformationA" _

(ByVal lpRootPathName As String, ByVal pVolumeNameBuffer As String, _

ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, _

lpMaximumComponentLength As Long, lpFileSystemFlags As Long, _

ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long)

Dim Seri

Private Sub Command1_Click()

Dim Msg

Dim Style

Dim Title

Dim Clinic

Dim n

Msg = " Serial Number Is " & GetSerialNumber("c") & " "

Style = vbInformation + vbDefaultButton1

Title = " Clinic Tec "

Clinic = MsgBox(Msg, Style, Title)

End Sub

'in the general:

'***************

'this function will get you the serail number

Public Function GetSerialNumber(sDrive As String) As Long

Dim ser As Long

Dim s As String * MAX_FILENAME_LEN

Dim s2 As String * MAX_FILENAME_LEN

Dim i As Long

Dim j As Long

Call GetVolumeInformation(sDrive + ":" & Chr$(0), s, MAX_FILENAME_LEN, ser, i, j, s2, MAX_FILENAME_LEN)

GetSerialNumber = ser

End Function

Private Sub Command2_Click()

Unload Me

End Sub

Private Sub Form_Load()

With Me

.Top = (Screen.Height - .Height) / 2

.Left = (Screen.Width - .Width) / 2

End With

End Sub

ولماذا القرص الصلب الذي يمكن أن يصيبه العطب ، لماذا لا تجعله للوحة الأم ؟

أنا عندي الكود docesam@yahoo.com

شكراً

Public Declare Sub GetMem1 Lib "msvbvm50.dll" (ByVal MemAddress As Long, var As Byte)

Public Function GetBIOSDate() As String

Dim p As Byte, MemAddr As Long, sBios As String

Dim i As Integer

'MemAddr = &HFFFF5

MemAddr = &HFEC71

For i = 0 To 25

Call GetMem1(MemAddr + i, p)

sBios = sBios & Chr$(p)

Next i

GetBIOSDate = sBios

End Function