MyDesign | Kod Arivi - Anasayfaya Dn   No banner in farm
Anasayfa Aratr Forum Gelimi Arama Siteniz in En Hit erikler RSS erik Ekle Scriptler Destekleyenler Kadromuz Reklam letiim Giri Sayfas Yap  Sk Kullanlanlara Ekle
Bu Kategorinin En Yeni Kodlar:


Bu Kategorinin En ok Grntlenen Kodlar:






Arama:
Gelimi Arama


No banner in farm



En ok Grntlenen Kodlar:


ye Girii:
 ye Ol



Anasayfa > VisualBasic > Kodlar

Otomatik Çalışan CD-Rom

Seçtiğiniz CD sürüsününü çalıştırır

Kategori : VisualBasic
Gnderen : LonG
Telif :
Tarih : 26 Kasım 2005
rnek Dosya : �ndir
Okunma Says : 9794
Puan
: 7 / 10 (3 Oy)
Puan Verin :
Google Bookmarks  del.icio.us  Digg  Yahoo! MyWeb  Windows Live  Furl
 
 
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
 
 

Otomatik Çalışan CD-Rom iin yazlan yorumlar

Hen�z yorum eklenmedi.

Yorum ekleyin

Anasayfa > VisualBasic > Kodlar > Otomatik Çalışan CD-Rom
Kategoriler:


Forum:



Balantlar:



    En Son Yorumlanan erikler:


    Murat Yavuz | Site Haritas | Gizlilik Bildirimi | 18.204.227.117 | 0,12 Saniye
    © Copyright 2004-2020 MyDesign | Kod Arivi. Tm Haklar Sakldr.
    MyDesign | Kod Arivi, en iyi grnm iin, 1024x768 ve zeri znrlk tavsiye eder.