قفل کردن CD-ROM

[mr_esmaily]

یک سوال در یکی از سایتا دیدم که هیچ کس جواب نداده بود گفتم اینجا بپرسم شاید کسی بدونه! :wink:
من شنیدم که یه API هستش برای قفل کردن در سی دی رام

اگه کسی میدونه اونو معرفی کنه و طرز کارش رو هم بگه

با تشکر قبلی *** موفق و پیروز باشید 8)

[حامدآقا]

'---- in a module
Option Explicit

Public Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000
Public Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804

Public Const MAX_PATH As Long = 260
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const GENERIC_READ As Long = &H80000000
Public Const INVALID_HANDLE_VALUE As Long = -1
Public Const ERROR_FILE_NOT_FOUND As Long = 2


Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_CDROM = 5


Private PreventMediaRemoval As Byte

Enum MEDIATYPE
unknown = 0
F5_1Pt2_512 = 1
F3_1Pt44_512 = 2
F3_2Pt88_512 = 3
F3_20Pt8_512 = 4
F3_720_512 = 5
F5_360_512 = 6
F5_320_512 = 7
F5_320_1024 = 8
F5_180_512 = 9
F5_160_512 = 10
Removable = 11
FixedMedia = 12
End Enum

Public Type DISK_GEOMETRY
Cylinders As Currency 'LARGE_INTEGER (8 bytes)
MEDIATYPE As Long
TracksPerCylinder As Long
SectorsPerTrack As Long
BytesPerSector As Long
End Type


Public Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long

Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" _
(ByVal lpRootPathName As String) As Long

Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Function LockDrive(ByVal sDrive As String, ByVal bLock As Boolean) As Boolean
Dim hDevice As Long, totalBytes As Long
Dim retVal As Long

hDevice = CreateFile("\\.\" & sDrive, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0&, 0&)
PreventMediaRemoval = bLock 'CByte(Abs(bLock))
retVal = DeviceIoControl(hDevice, IOCTL_STORAGE_MEDIA_REMOVAL, PreventMediaRemoval, Len(PreventMediaRemoval), 0&, 0&, totalBytes, 0&)

CloseHandle hDevice

LockDrive = CBool(retVal)
End Function

[mr_esmaily]

میشه یک مثال برای استفادشم بزنید چون من امتحان کردم نشد؟!

[حامدآقا]

برای قفل کردن :
LockDrive "I:", True
و برای از قفل درآوردن :
LockDrive "I:", False
که در اینجا I: نام درایو CD مورد نظر می باشد.

[mr_esmaily]

بازم نشد! :cry:

[حامدآقا]

من روی CD های Samsung , Teac ازش جواب گرفتم. سی دی شما چیه؟
درضمن با گذاشتن یک Button و استفاده از دستور :

LockDrive "I:",true

باز هم مشکل داری؟

دوستان دیگه آیا می تونن این برنامه رو تست کنند؟

[mr_esmaily]

مال منم Asus هست در ضمن یک دگمه هم گذاشتم بازم نشد! :cry:

[(سیدشریفی)]

آقا مسعود یه نگاهی به فایل بینداز
چون من هم وقتی خواستم آن را دانلود کنم همان پیغامی را میدهد که آقای اسماعیلی میگویند.

[alimalekiani]

با سلام به بچه های مخ برنامه نویس
این کد را توی یک ماژول کپی کنید
in a module'

Option Explicit

Public Const IOCTL_DISK_GET_DRIVE_GEOMETRY As Long = &H70000
Public Const IOCTL_STORAGE_MEDIA_REMOVAL As Long = &H2D4804

Public Const MAX_PATH As Long = 260
Public Const FILE_SHARE_READ As Long = &H1
Public Const FILE_SHARE_WRITE As Long = &H2
Public Const OPEN_EXISTING As Long = 3
Public Const GENERIC_READ As Long = &H80000000
Public Const INVALID_HANDLE_VALUE As Long = -1
Public Const ERROR_FILE_NOT_FOUND As Long = 2


Public Const DRIVE_REMOVABLE = 2
Public Const DRIVE_CDROM = 5


Private PreventMediaRemoval As Byte

Enum MEDIATYPE
unknown = 0
F5_1Pt2_512 = 1
F3_1Pt44_512 = 2
F3_2Pt88_512 = 3
F3_20Pt8_512 = 4
F3_720_512 = 5
F5_360_512 = 6
F5_320_512 = 7
F5_320_1024 = 8
F5_180_512 = 9
F5_160_512 = 10
Removable = 11
FixedMedia = 12
End Enum

Public Type DISK_GEOMETRY
Cylinders As Currency 'LARGE_INTEGER (8 bytes)
MEDIATYPE As Long
TracksPerCylinder As Long
SectorsPerTrack As Long
BytesPerSector As Long
End Type


Public Declare Function DeviceIoControl Lib "kernel32" (ByVal hDevice As Long, ByVal dwIoControlCode As Long, lpInBuffer As Any, ByVal nInBufferSize As Long, lpOutBuffer As Any, ByVal nOutBufferSize As Long, lpBytesReturned As Long, lpOverlapped As Any) As Long

Public Declare Function GetLogicalDriveStrings Lib "kernel32" _
Alias "GetLogicalDriveStringsA" _
(ByVal nBufferLength As Long, _
ByVal lpBuffer As String) As Long

Public Declare Function GetDriveType Lib "kernel32" _
Alias "GetDriveTypeA" _
(ByVal lpRootPathName As String) As Long

Public Declare Function CreateFile Lib "kernel32" Alias "CreateFileA" (ByVal lpFileName As String, ByVal dwDesiredAccess As Long, ByVal dwShareMode As Long, ByVal lpSecurityAttributes As Any, ByVal dwCreationDisposition As Long, ByVal dwFlagsAndAttributes As Long, ByVal hTemplateFile As Long) As Long
Public Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long

Public Function LockDrive(ByVal sDrive As String, ByVal bLock As Boolean) As Boolean
Dim hDevice As Long, totalBytes As Long
Dim retVal As Long

hDevice = CreateFile("\\.\" & sDrive, GENERIC_READ, FILE_SHARE_READ Or FILE_SHARE_WRITE, ByVal 0&, OPEN_EXISTING, 0&, 0&)
PreventMediaRemoval = bLock 'CByte(Abs(bLock))
retVal = DeviceIoControl(hDevice, IOCTL_STORAGE_MEDIA_REMOVAL, PreventMediaRemoval, Len(PreventMediaRemoval), 0&, 0&, totalBytes, 0&)

CloseHandle hDevice

LockDrive = CBool(retVal)
End Function

بعد توی form دو command button بذارید و توی یکی آن
برای قفل کردن :
کد زیر را بنویسید
LockDrive "I:", True

و توی command button دومی
برای از قفل درآوردن :
کد زیر را بنویسید
LockDrive "I:", False
فقط یک چیز در اول form این عبارت را حتما بنویسید
Option Explicit
بجای I شما حرفی که مشخصه cdrom شما است را بگذارید

موفق باشید :wink: :wink: :wink:

[mr_esmaily]

سلام
خیلی ممنون ولی بازم نشد! :cry:

[(سیدشریفی)]

آقا من هم این برنامه را امتحان کردم جواب داد
در سی دی رام های زیر :
ASUS
TEAC
:lol: :lol: :lol:

[M-Gheibi]

ببخشید که کمی دیر جواب دادم. من فایل رو چک کردم هیچ مشکلی از نظر Attachment ندارد :roll: :wink:

[Ahmad-VB]

سلام به همگی
آقا حرف سر این نیست که سی دی رام شما نمی د.نم asus یا چیز دیگه مشکل این برنامه اینه که توی ویندوز xp وشاید 2000 اجرا میشه. همین . :lol:

[mr_esmaily]

سلام به همگی
آقا حرف سر این نیست که سی دی رام شما نمی د.نم asus یا چیز دیگه مشکل این برنامه اینه که توی ویندوز xp وشاید 2000 اجرا میشه. همین . :lol:

دستت درد نکنه برا منم کار کرد!