اريد كود يحعل البرنامج يشتغل على قرص معين

الأخ الفاضل ...

لجعل البرنامج يعمل فقط من أى وسيط غير ثابت (فلاش أو ديسك) يمكنك أستخدام:

Private Const DRIVE_REMOVABLE As Long = 2

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

Private Sub Form_Load()
	If GetDriveType(Left$(App.Path, InStr(3, App.Path, "\"))) <> DRIVE_REMOVABLE Then End
End Sub

وبالطبع يمكنك تحديد أى نوع بنفس الطريقة:

Private Const DRIVE_REMOVABLE			   As Long = 2
Private Const DRIVE_FIXED				   As Long = 3
Private Const DRIVE_REMOTE				  As Long = 4
Private Const DRIVE_CDROM				   As Long = 5
Private Const DRIVE_RAMDISK				 As Long = 6

شكراً

اقتباس

وبالطبع يمكنك تحديد أى نوع بنفس الطريقة

لم افهم قصدق

عفوا فهمت لكن انا لا اريد اي سي دي او اي يو اس بي يشتغل عليه اريد الفلاش الممري الي انا احدد رقمه المسلسل

الأخ الفاضل ...

راجع: الرقم المسلسل لـمكونات الكمبيوتر من داخل البرامج

Private Declare Function Drv_GetType Lib "HWInfo.dll" (ByVal Drv As Long, ByVal Buffer As String, ByVal BuffSize As Long) As Long
Private Declare Function Drv_GetInfo Lib "HWInfo.dll" (ByVal Drv As Long, ByVal Vol As String, ByVal FileSys As String, ByVal BuffSize As Long) As Long

Private Function CheckSerialNumber() As Boolean
	Dim nDrv As Long
	Dim lSN As Long
	Dim s As String
	Dim Vol As String
	Dim FileSys As String

	For nDrv = Asc("A") To Asc("Z")
		s = Space(32)
		Vol = Space(64)
		FileSys = Space(64)
		If Drv_GetType(nDrv, s, 32) <> 0 Then
			lSN = Drv_GetInfo(nDrv, Vol, FileSys, 64)
			If lSN = &Hxxxxxxxx Then  ' &Hxxxxxxxx Your Serial Number
				CheckSerialNumber = True
				Exit Function
			End If
		End If
	Next nDrv

	CheckSerialNumber = False
End Function

أو

Private Declare Function HD_GetSerialNumber Lib "HWInfo.dll" (ByVal Drive As Long, ByVal Buffer As String, ByVal BuffSize As Long) As Boolean
Private Declare Function HD_GetCapacitySize Lib "HWInfo.dll" (ByVal Drive As Long) As Long

Private Function CheckSerialNumber() As Boolean
	Dim nDrv As Long
	Dim lVar As Long
	Dim s As String

	For nDrv = 0 To 3
		lVar = HD_GetCapacitySize(nDrv)

		If lVar Then
			s = Space(32)

			HD_GetSerialNumber nDrv, s, 32
			If s = "xxxxxxxx" Then  ' xxxxxxxx Your Serial Number
				CheckSerialNumber = True
				Exit Function
			End If
		End If
	Next nDrv

	CheckSerialNumber = False
End Function

شكراً

مشكور يا اخي

لكن انا اعرف رقم التسلسلي للفلاش ممري هو : -924747627

بس انا ابغا طريقة اخلي البرنامج ما يشتغل الي على هذا الرقم فقط

هل من طريقة ؟

Private Declare Function Drv_GetType Lib "HWInfo.dll" (ByVal Drv As Long, ByVal Buffer As String, ByVal BuffSize As Long) As Long
Private Declare Function Drv_GetInfo Lib "HWInfo.dll" (ByVal Drv As Long, ByVal Vol As String, ByVal FileSys As String, ByVal BuffSize As Long) As Long

Private Function CheckSerialNumber() As Boolean
	Dim nDrv As Long
	Dim lSN As Long
	Dim s As String
	Dim Vol As String
	Dim FileSys As String

	For nDrv = Asc("A") To Asc("Z")
		s = Space(32)
		Vol = Space(64)
		FileSys = Space(64)
		If Drv_GetType(nDrv, s, 32) <> 0 Then
			lSN = Drv_GetInfo(nDrv, Vol, FileSys, 64)
			If lSN =  -924747627 Then  '  -924747627 Your Serial Number
				CheckSerialNumber = True
				Exit Function
			End If
		End If
	Next nDrv

	CheckSerialNumber = False
End Function

مشكور اخي بس اين اضع هذا الكود

و ارجوا ان ترفق لي المشروع مع الكود

up up

اقتباس

لكن انا اعرف رقم التسلسلي للفلاش ممري هو : -924747627

هو أنت كيف حصلت على هذا الرقم

عندي برنامج يقرا الرقم التسلسلي لاي درايفر انت تحدده

ارجوا الرد علي يا Eng. Usama El-Mokadem

اين اضع الكود الذي اعطيتني هو

بسرعة لاني مستعجل

فى حدث الـ Form_Load طبعا

لم ينفع الكود يا اخ msayed2004

ارجوا ان ترفق لي المشروع مع الكود الي حطه الاخ Eng. Usama El-Mokadem

Private Declare Function Drv_GetType Lib "HWInfo.dll" (ByVal Drv As Long, ByVal Buffer As String, ByVal BuffSize As Long) As Long
Private Declare Function Drv_GetInfo Lib "HWInfo.dll" (ByVal Drv As Long, ByVal Vol As String, ByVal FileSys As String, ByVal BuffSize As Long) As Long

Private Function CheckSerialNumber() As Boolean
	Dim nDrv As Long
	Dim lSN As Long
	Dim s As String
	Dim Vol As String
	Dim FileSys As String

	For nDrv = Asc("A") To Asc("Z")
		s = Space(32)
		Vol = Space(64)
		FileSys = Space(64)
		If Drv_GetType(nDrv, s, 32) <> 0 Then
			lSN = Drv_GetInfo(nDrv, Vol, FileSys, 64)
			If lSN =  -924747627 Then  '  -924747627 Your Serial Number
				CheckSerialNumber = True
				Exit Function
			End If
		End If
	Next nDrv

	CheckSerialNumber = False
End Function

اين اضعه هذا ارجوا الرد العاجل لي ثلاث ايام طارح الموضوع

الأخ الفاضل ...

طريقة الإضافة فى Form_Load:

Private Sub Form_Load()
	If CheckSerialNumber() = False Then End
End Sub

شكراً

مشطور يا اخي لكن لوجد خطا في الكود الاول يقول

file not found : HWInfo.dll

ما هي المشكلة

الملف موجود بتوقيع المهندس أسامه