Otomatik Çalışan CD-Rom

Option Explicit
'NAME - AUTORUN CD
'AIM - TO RUN A CD

'PROJECT TYPE - STANDARD EXE

'COMPONENTS
'FORM
'A.CONTROLS
'1 COMMAND BUTTON
'1 LABEL
'1 DRIVE BOX
'B.REFERENCES
'1.MICROSOFT SHELL & AUTOMATION LIBRARY
'2.MICROSOFT SRIPTING LIBRARY

'AUTORUN FILES:
'AUTORUN FILES ARE THOSE WHICH MAKE A
'CD TO BE RUN AUTOMATICALLY WHEN THE CD
'IS INSERTED INTO THE DRIVE
'FOR EXAMPLE
'MAGAZINES SUCH AS CHIP, DIGIT, PC QUEST
'COMP@HOME ETC. OPEN UP IN INTERNET EXPLORER
'SOON AFTER THEIR ARE INSERTED.

'THIS IS BECAUSE THE AUTORUN.INF FILE.
'THESE FILES CONTAIN THE NAME OF THE FILE
'TO BE RUN.

'THUS WHEN A CD IS INSERTED, THE SYSTEM CHECKS FOR THE
'AUTORUN FILE & GET THE FILE TO BE RUN.

'THIS PROGRAM THUS THE SAME.

'SOME SAMPLE AUTORUN HAVE BEEN
'ATTACHED SO THAT YOU CAN SEE THE FORMAT OF THE FILE






'METHOD
' 1.GET THE DRIVE
' 2.CHECK WHETHER THE DRIVE IS A CD-ROM
' 3.CHECK WHETHER THERE IS A CD IN THE DRIVE
' 4.CHECK WHETHER THERE IS AUTORUN.INF FILE IN THE ROM
' 5.IF THE FILE IS NOT THERE THEN OPEN THE CD IN EXPLORER
' 6.IF THE FILE EXISTS THEN GET THE FILE TO BE RUN. THE FILE WILL
' BE RETURN IN THE AUTORUN.INF FILE
' 7.EXECUTE THE FILE USING SHELLEXECUTE API FUNCTION
' 8.IF THE FILE CANNOT BE EXECUTED THEN OPEN THE CD IN EXPLORER








'public variable
Dim autofile As String
'to store the name of the file
'to be run


'this is an api function used to run any file
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpoperation As String, ByVal lpfile As String, ByVal lpparametera As String, _
ByVal lpdirectory As String, ByVal nshowcmd As Long) As Long



Private Sub Run_CD()
'THIS IS THE MAIN PART OF THE PROGRAM
Dim a As New FileSystemObject
Dim b As Drive
Dim s1 As String
Dim F As New Shell
Dim result As Long



'b = SELECTED DRIVE
Set b = a.GetDrive(Left(Drive1.Drive, 2))
'I AM USING LEFT(,2) FUNCTION BECAUSE
'THE DRIVEBOX WILL RETURN THE DRIVE NAME WITH
'ITS VOLUME NAME. THIS WILL CAUSE ERROR.
'SO IAM GETTING ONLY THE DRIVE LETTER & COLON(:)
'E.G
'D:\[DIR1_VOLA]
'HERE THE DRIVE WILL RETURN THE FULL NAME
'SO USING THE LEFT FUNCTION THE RETURN WILL BE D:




'check whether the selected drive is
'a CDROM
If b.DriveType <> CDRom Then
'if it is not then
MsgBox "The selected drive is not a CD Drive ! " & vbCrLf & "Please select the CD Drive and RUN.", vbCritical + vbOKOnly
Exit Sub
End If
'if the cd is not in the drive then disp error message
If b.IsReady = False Then GoTo error_noCD
'STEP 3:
'if it a CDROM then check the File autorun.inf exist
If a.FileExists(Drive1.Drive & "autorun.inf") = True Then
'if it exists then get the file to br run.
GetAutorunFilename 'TRANSFER TO THE SUB
'EXECUTE THE FILE USING API FUNCTION
result = ShellExecute(Form1.hwnd, "open", autofile, vbNullString, Drive1.Drive, 1)
If result <= 32 Then
s1 = "Unable to run the CD !" & vbCrLf
s1 = "Do you want me to open the Drive in Explorer"
result = MsgBox(s1, vbYesNo)
If result = vbYes Then F.Open Drive1.Drive 'OPEN THE DRIVE IN EXPLORER USING SHELL LIB
Exit Sub
End If
Exit Sub
Else
F.Open Drive1.Drive
End If
Exit Sub
error_noCD:
MsgBox "There is no CD in the Drive !", vbCritical
End Sub
Private Sub GetAutorunFilename()
Dim n As Integer, s As String, s1 As String
'THE FORMAT OF THE AUTORUN.INF FILE WILL BE SOMETHING LIKE THIS

'[AUTORUN]
'OPEN = CODE.HTML
'ICON= MFICON.ICO

'THE WORD 'OPEN' WILL BE BEFORE THE FILENAME
'SO THAT LINE IS ALONE WANTED

'NOW WE HAVE THE LINE. WE HAVE TO EXTRACT THE FILENAME FROM IT
'FROM THE RIGHT I GET THE FILE NAME UNTIL THERE IS '=' OR ' '(SPACE)

'SOMETIMES THE FILE MAY NOT BE DIRECTLY IN THE DRIVE
'IT MAY BE INSIDE A FOLDER IN THE DRIVE
'THEN THE FORMAT OF THE FILE WILLBE

'[AUTORUN]
'OPEN=MAIN\CODE.HTML
'ICON=ICON.ICO

'THUS THE FILENAME OBTAINED IS STORED TO THE PUBLIC VARIABLE
'AUTOFILE.
'THIS IS THEN OPEN USING THE AIP FUNCTION

'I HAVE INCLUDED DEBUG.PRINT STATEMENTS SO THAT YOU CAN UNDERSTAND HOW THE FILE NAME IS EXTRACTED

Open Drive1.Drive & "autorun.inf" For Input As 1
Do While Not EOF(1)
Line Input #1, s
If LCase(Left(s, 4)) = "open" Then GoTo exitloop
Loop
exitloop:
Close #1
n = 0
Debug.Print s
s1 = s
Debug.Print vbCrLf & s1 & vbCrLf & vbCrLf
checknextchar:
If Right(s, 1) = " " Or Right(s, 1) = "=" Then
s = Right(s1, n)
GoTo printpath
Debug.Print "path= " & s
Else
n = n + 1
s = Left(s, Len(s) - 1)
Debug.Print s & vbCrLf
GoTo checknextchar
End If
printpath:
If Left(s, 1) = "\" Then
s = Drive1.Drive & s
Else
s = Drive1.Drive & s
End If
Debug.Print "file" & " " & s
autofile = s
End Sub
Private Sub Command1_Click()
'when the button is clicked
'the control is transfered
'to the sub RUN_CD
Run_CD
End Sub

Yorum Yapabilmek İçin Üye Girişi Yapmanız Gerekmektedir.

otomatik � alışan cd-rom