چک کردن CDrom و پورت USB فعال !

[mehran8]

سلام .

می خوام برنامه ای بنویسم که بفهمه الآن درایو سی دی رام ویندوز کدومه و همچنین تشخیص بده کدام یک از درایو های سیستم USB و در حالت فعال است ؟!!

در قسمت سی دی رام : اگه بشه فهمید که توی کدوم درایو ، سی دی وجود داره که خیلی عالی می شه . چون ممکنه یه کامپیوتر 2 تا سی دی رام داشته باشه !

از دوستان گرامی خواهشمند است مرا در این زمینه راهنمایی کنید . :خجالت:

[__siavash__]

با تابع GetDriveType میتونی تشخیص بدی که درایو مورد نظر داریو سی دس رام هست یا به طور کلی چه نوع درایوی هستش

[mehran8]

آقا سیاوش خیلی ممنون از راهنماییتون ولی خواهشن این جوری جواب ندید . من جواب کامل می خوام . اگه مشکلی نیست .

ممنون

[__siavash__]

خوب الان مشکل کجاست؟
مگه نمیخوای درایو سی دس رام رو پیدا کنی ؟
این طوری

GetDriveType("A:\")
اگه مقدار برگشتی تابع 5 باشه یعنی درایوی که به تابع دادی مربوط میشه به سی دس رام
به همین ترتیب اگه 2 باشه مربوط به یک فلاپی درایو یا Removable درایو خواهد بود و اگه 6 باشه یک Ram Disk و اگه 3 باشه یعنی یکی از درایو های هارد هستش اگرم 1 باشه یعنی اینکه پارتیشن یا درایو ورودی به تابع وجود ندارد!
حالا شما تمام حروف A تا Z رو تو یه حلقه بده به تابع و نتیجه برگشتی رو بررسی کن !!!
حالا اگه دوتا سی دی درایو هم وجود داشته باشه میتونی پیداشون کنی.

[mehran8]

مرسی . دستت درد نکنه - اون USB رو هم اگه زحمتشو بکشی ...

[__siavash__]

مرسی . دستت درد نکنه - اون USB رو هم اگه زحمتشو بکشی ...
برای USB هم با همون تابع بالا اگه تست کنی 2 برمیگردونه فقط اینکه چه طوری باید از فلاپی درایو متمایز بشه فعلا نمیدنم !
بررسی میکنم اگه جواب گرفتم بهت میگم !

[mehran8]

آقا این تابع GetDriveType که کار نداد .
مگه ماله kernel32 نیست ؟

[__siavash__]

آقا این تابع GetDriveType که کار نداد .
مگه ماله kernel32 نیست ؟
اینه:

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
طرز استفادشم همون طوری که بالا گفتم!

[adaman]

Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long
Private Sub Form_Load()
'KPD-Team 1998
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
'Set the graphic mode to persistent
Me.AutoRedraw = True
'Get information about the C:\
Select Case GetDriveType("C:\")
Case 2
Me.Print "Removable"
Case 3
Me.Print "Drive Fixed"
Case Is = 4
Me.Print "Remote"
Case Is = 5
Me.Print "Cd-Rom"
Case Is = 6
Me.Print "Ram disk"
Case Else
Me.Print "Unrecognized"
End Select
End Sub





'Example by Alexey (alexeyka2001@rambler.ru)
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
' returns errors for UNC Path
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Function fGetDrives() As String
'Returns all mapped drives
Dim lngRet As Long
Dim strDrives As String * 255
Dim lngTmp As Long
lngTmp = Len(strDrives)
lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
fGetDrives = Left(strDrives, lngRet)
End Function
Private Function fGetUNCPath(strDriveLetter As String) As String
On Local Error GoTo fGetUNCPath_Err

Dim Msg As String, lngReturn As Long
Dim lpszLocalName As String
Dim lpszRemoteName As String
Dim cbRemoteName As Long
lpszLocalName = strDriveLetter
lpszRemoteName = String$(255, Chr$(32))
cbRemoteName = Len(lpszRemoteName)
lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _
cbRemoteName)
Select Case lngReturn
Case ERROR_BAD_DEVICE
Msg = "Error: Bad Device"
Case ERROR_CONNECTION_UNAVAIL
Msg = "Error: Connection Un-Available"
Case ERROR_EXTENDED_ERROR
Msg = "Error: Extended Error"
Case ERROR_MORE_DATA
Msg = "Error: More Data"
Case ERROR_NOT_SUPPORTED
Msg = "Error: Feature not Supported"
Case ERROR_NO_NET_OR_BAD_PATH
Msg = "Error: No Network Available or Bad Path"

Case ERROR_NO_NETWORK
Msg = "Error: No Network Available"
Case ERROR_NOT_CONNECTED
Msg = "Error: Not Connected"
Case NO_ERROR
' all is successful...
End Select
If Len(Msg) Then
MsgBox Msg, vbInformation
Else
fGetUNCPath = Left$(lpszRemoteName, cbRemoteName)
End If
fGetUNCPath_End:
Exit Function
fGetUNCPath_Err:
MsgBox Err.Description, vbInformation
Resume fGetUNCPath_End
End Function

Private Function fDriveType(strDriveName As String) As String
Dim lngRet As Long
Dim strDrive As String
lngRet = GetDriveType(strDriveName)
Select Case lngRet
Case DRIVE_UNKNOWN 'The drive type cannot be determined.
strDrive = "Unknown Drive Type"
Case DRIVE_ABSENT 'The root directory does not exist.
strDrive = "Drive does not exist"
Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
strDrive = "Removable Media"
Case DRIVE_FIXED 'The disk cannot be removed from the drive.
strDrive = "Fixed Drive"
Case DRIVE_REMOTE 'The drive is a remote (network) drive.
strDrive = "Network Drive"
Case DRIVE_CDROM 'The drive is a CD-ROM drive.
strDrive = "CD Rom"
Case DRIVE_RAMDISK 'The drive is a RAM disk.
strDrive = "Ram Disk"
End Select
fDriveType = strDrive
End Function

Sub sListAllDrives()
Dim strAllDrives As String
Dim strTmp As String

strAllDrives = fGetDrives
If strAllDrives <> "" Then
Do
strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
Select Case fDriveType(strTmp)
Case "Removable Media":
Debug.Print "Removable drive : " & strTmp
Case "CD Rom":
Debug.Print " CD Rom drive : " & strTmp
Case "Fixed Drive":
Debug.Print " Local drive : " & strTmp
Case "Network Drive":
Debug.Print " Network drive : " & strTmp
Debug.Print " UNC Path : " & _
fGetUNCPath(Left$(strTmp, Len(strTmp) - 1))
End Select
Loop While strAllDrives <> ""
End If
End Sub

Private Sub Form_Load()
Debug.Print "All available drives: "
sListAllDrives
End Sub

[mehran8]

آقا دستت درد نکنه خیلی ممنون . جبران می کنم

فقط اون کد دومیه چیکار می کنه ؟

[adaman]

فقط اون کد دومیه چیکار می کنه ؟
http://i4.tinypic.com/54misz9.jpg
اینو ببین :

'Example by Alexey (alexeyka2001@rambler.ru)
Private Const DRIVE_UNKNOWN = 0
Private Const DRIVE_ABSENT = 1
Private Const DRIVE_REMOVABLE = 2
Private Const DRIVE_FIXED = 3
Private Const DRIVE_REMOTE = 4
Private Const DRIVE_CDROM = 5
Private Const DRIVE_RAMDISK = 6
' returns errors for UNC Path
Private Const ERROR_BAD_DEVICE = 1200&
Private Const ERROR_CONNECTION_UNAVAIL = 1201&
Private Const ERROR_EXTENDED_ERROR = 1208&
Private Const ERROR_MORE_DATA = 234
Private Const ERROR_NOT_SUPPORTED = 50&
Private Const ERROR_NO_NET_OR_BAD_PATH = 1203&
Private Const ERROR_NO_NETWORK = 1222&
Private Const ERROR_NOT_CONNECTED = 2250&
Private Const NO_ERROR = 0

Private Declare Function WNetGetConnection Lib "mpr.dll" Alias _
"WNetGetConnectionA" (ByVal lpszLocalName As String, _
ByVal lpszRemoteName As String, cbRemoteName As Long) As Long
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias _
"GetLogicalDriveStringsA" (ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" _
(ByVal nDrive As String) As Long
Private Function fGetDrives() As String
'Returns all mapped drives
Dim lngRet As Long
Dim strDrives As String * 255
Dim lngTmp As Long
lngTmp = Len(strDrives)
lngRet = GetLogicalDriveStrings(lngTmp, strDrives)
fGetDrives = Left(strDrives, lngRet)
End Function
Private Function fGetUNCPath(strDriveLetter As String) As String
On Local Error GoTo fGetUNCPath_Err

Dim Msg As String, lngReturn As Long
Dim lpszLocalName As String
Dim lpszRemoteName As String
Dim cbRemoteName As Long
lpszLocalName = strDriveLetter
lpszRemoteName = String$(255, Chr$(32))
cbRemoteName = Len(lpszRemoteName)
lngReturn = WNetGetConnection(lpszLocalName, lpszRemoteName, _
cbRemoteName)
Select Case lngReturn
Case ERROR_BAD_DEVICE
Msg = "Error: Bad Device"
Case ERROR_CONNECTION_UNAVAIL
Msg = "Error: Connection Un-Available"
Case ERROR_EXTENDED_ERROR
Msg = "Error: Extended Error"
Case ERROR_MORE_DATA
Msg = "Error: More Data"
Case ERROR_NOT_SUPPORTED
Msg = "Error: Feature not Supported"
Case ERROR_NO_NET_OR_BAD_PATH
Msg = "Error: No Network Available or Bad Path"

Case ERROR_NO_NETWORK
Msg = "Error: No Network Available"
Case ERROR_NOT_CONNECTED
Msg = "Error: Not Connected"
Case NO_ERROR
' all is successful...
End Select
If Len(Msg) Then
MsgBox Msg, vbInformation
Else
fGetUNCPath = Left$(lpszRemoteName, cbRemoteName)
End If
fGetUNCPath_End:
Exit Function
fGetUNCPath_Err:
MsgBox Err.Description, vbInformation
Resume fGetUNCPath_End
End Function

Private Function fDriveType(strDriveName As String) As String
Dim lngRet As Long
Dim strDrive As String
lngRet = GetDriveType(strDriveName)
Select Case lngRet
Case DRIVE_UNKNOWN 'The drive type cannot be determined.
strDrive = "Unknown Drive Type"
Case DRIVE_ABSENT 'The root directory does not exist.
strDrive = "Drive does not exist"
Case DRIVE_REMOVABLE 'The drive can be removed from the drive.
strDrive = "Removable Media"
Case DRIVE_FIXED 'The disk cannot be removed from the drive.
strDrive = "Fixed Drive"
Case DRIVE_REMOTE 'The drive is a remote (network) drive.
strDrive = "Network Drive"
Case DRIVE_CDROM 'The drive is a CD-ROM drive.
strDrive = "CD Rom"
Case DRIVE_RAMDISK 'The drive is a RAM disk.
strDrive = "Ram Disk"
End Select
fDriveType = strDrive
End Function

Sub sListAllDrives()
Dim strAllDrives As String
Dim strTmp As String

strAllDrives = fGetDrives
If strAllDrives <> "" Then
Do
strTmp = Mid$(strAllDrives, 1, InStr(strAllDrives, vbNullChar) - 1)
strAllDrives = Mid$(strAllDrives, InStr(strAllDrives, vbNullChar) + 1)
Select Case fDriveType(strTmp)
Case "Removable Media":
Me.Print "Removable drive : " & strTmp
Case "CD Rom":
Me.Print " CD Rom drive : " & strTmp
Case "Fixed Drive":
Me.Print " Local drive : " & strTmp
Case "Network Drive":
Me.Print " Network drive : " & strTmp
Me.Print " UNC Path : " & _
fGetUNCPath(Left$(strTmp, Len(strTmp) - 1))
End Select
Loop While strAllDrives <> ""
End If
End Sub

Private Sub Form_Load()
Me.AutoRedraw = True
Me.Print "All available drives: "
sListAllDrives
End Sub

[__siavash__]

یه لیست باکس و یه کامند باتن به فرمت اضافه کن:


Option Explicit
Dim Drive() As String
Dim i As Integer
Private Declare Function GetLogicalDriveStrings Lib "kernel32" Alias "GetLogicalDriveStringsA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
Private Declare Function GetDriveType Lib "kernel32" Alias "GetDriveTypeA" (ByVal nDrive As String) As Long

Private Sub Command1_Click()
Dim Buffer As String
Buffer = String(255, 0)
List1.Clear
GetLogicalDriveStrings 255, Buffer
Buffer = Left(Buffer, InStrRev(Buffer, "\"))
Drive = Split(Buffer, Chr(0))
For i = 0 To UBound(Drive)
List1.AddItem Drive(i) & " " & DriveType(Drive(i))
Next
End Sub

Private Function DriveType(ByVal DriveName As String) As String
Dim RetVal As Integer
RetVal = GetDriveType(Drive(i))
Select Case RetVal
Case 0
تابع با خطا مواجه شده !"
Case 1
DriveType = "This Drive do not Exist"
Case 2
DriveType = "Removable Drive"
Case 3
DriveType = "Drive Fixed"
Case 4
DriveType = "Remote Or Network"
Case 5
DriveType = "CD-ROM"
Case 6
DriveType = "Ram Disk"
End Select
End Function