PDA

View Full Version : بدست آوردن نام درایو سی دی رام



VB6.0
یک شنبه 02 آذر 1382, 15:11 عصر
با سلام
آیا تابعی, چیزی برای بدست آوردن نام این درایو (CD-ROM) در VB6 وجود داره؟

روح اله معینی زاده
یک شنبه 02 آذر 1382, 17:02 عصر
سلام دوست گرامی

اینو از توی همین سایت قبلاً گرفتم. ببخشید که ذکر منبع نمی کنم چون نمی دانم کجا بوده

Const DRIVE_CDROM = 5

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 Declare Function GetVolumeSerialNumber 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

Public Function GetCdRomDrive() As String
Dim tmp As Integer
Dim tmpStr As String
Dim Drives As String
Dim CDsCount As Integer
Dim CDsLetters As String
Dim ret As Long

Drives = Space(255)
ret = GetLogicalDriveStrings(Len(Drives), Drives)
For tmp = 1 To ret Step 4
tmpStr = Mid(Drives, tmp, 3)
If GetDriveType(tmpStr) = DRIVE_CDROM Then
CDsLetters = Left(tmpStr, 3)
Exit For
End If
Next tmp
GetCdRomDrive = CDsLetters
End Function

با احترام- خدانگهدار

VB6.0
یک شنبه 02 آذر 1382, 22:42 عصر
با سلام
دستت درد نکنه!
اما آیا روش ساده تری هم وجود داره؟
در ضمن چه جوری میشه وجود سی دی رو تو یکی از درایوهای سی دی رام تشخیص داد؟

روح اله معینی زاده
دوشنبه 03 آذر 1382, 08:25 صبح
سلام عزیزجان

اگه من خودم نوشته بودم که در خدمتتون بودم ولی چون خودم هم از جای دیگه ای کپی کردم، شرمنده. :(
اگه کسی جواب بده متشکرش می شیم.

با احترام - خدانگهدار

Abbas Arizi
دوشنبه 03 آذر 1382, 12:41 عصر
مثالی که دوستمون گفتن با استفاده از API بود ولی مثال من با استفاده ازشیی File System هست. با استفاده از این تابع میتونید درایوهای CD روی یک کامپیوتر که در ضمن سی دی توی درایوشون هست رو پیدا کنید:

Function GetCDDrives() As String()
Dim FSO As New FileSystemObject
Dim drv As Drive
Dim i As Integer
Dim strTmp() As String

For Each drv In FSO.Drives
If drv.DriveType = CDRom Then
If drv.IsReady Then
ReDim Preserve strTmp(i)
strTmp(i) = drv.DriveLetter
i = i + 1
End If
End If
Next

GetCDDrives = strTmp
End Function

از اونجایی که توی یک سیستم امکان داره بیش از یک درایو سی دی وجود داشته باشه این تابع یک آرایه رشته ای از نام درایوها رو بر میگردونه.
خصوصیت IsReady در شیی Drive وجود وجود دیسک در درایو رو بررسی میکنه.
روش استفاده از این تابع هم به این شکله:

Dim strArray() As String
strArray = GetCDDrives()
Dim i As Integer
For i = 0 To UBound(strArray)
List1.AddItem strArray(i)
Next
کد بالا نام درایوها رو توی یک ListBox قرار میده.
برای استفاده از شیی File System قبلا از منوی Project->Refrences باید Microsoft Scripting Runtime رو به پروژه اضافه کنید.

کم حوصله
دوشنبه 03 آذر 1382, 15:52 عصر
GetCDDrives = strTmp
آقای عریضی عزیز کار این کد چیه؟؟؟

Abbas Arizi
دوشنبه 03 آذر 1382, 15:53 عصر
مفدار برگشتی تابع رو تعیین میکنه.

mehran901
شنبه 24 اسفند 1392, 23:33 عصر
دوست عزیز ی راه ساده استفاده از متغییر های fso هست
به طور مثال قطعه کد زیر رو به صورت واضح براتون نوشتم


Dim k As New FileSystemObject, kk As Drive


For Each kk In k.Drives
If kk.DriveType = 4 Then MsgBox kk.DriveLetter


Next kk


رفرنس microsoft scripting runtime رو از بخش رفرنس ادد کنید