[VB6]光碟機選單程式

[VB6]光碟機選單程式

參考資料很多=.=

autorun inf 語法

自動執行檔﹙Autorun.inf﹚的寫法

安裝光碟 AutoRun 時的選單功能製作?

VB如何宣告使用Windows API(教學)

完成如下

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long

Private Sub Command1_Click()
    Unload Me
End Sub

Private Sub Command2_Click()
    Dim wshShell As Object
    Set wshShell = CreateObject("WScript.Shell")
    Dim SelectCount As Integer
    Dim StrExeFile As String
    For i = 0 To List2.ListCount - 1
        If List2.Selected(i) = True Then
            SelectCount = i
        End If
    Next
    Call wshShell.Run(List2.List(SelectCount), 1, True)
End Sub

Private Sub Form_Load()
    Dim StrExeFile As String
    StrExeFile = App.Path
    If Right(StrExeFile, 1) <> "\" Then StrExeFile = StrExeFile & "\"
    Dim FileName() As String
    Dim FileLength As Integer
    Dim HelpName() As String
    Dim HelpLength As Integer
    FileName = GetInfContent("NAME")
    FileLength = GetContentCount("NAME")
    HelpName = GetInfContent("HELP")
    HelpLength = GetContentCount("HELP")
    For l = 0 To FileLength - 1
        List1.AddItem (FileName(l))
    Next
    For m = 0 To HelpLength - 1
        List2.AddItem (StrExeFile & HelpName(m))
    Next
    List1.Selected(0) = True
    List2.Selected(0) = True
End Sub



Private Sub Command4_Click()
    
    Dim FilePath() As String
    Dim FilePathCount As Integer
    Dim SelectCount As Integer
    FilePath = GetInfContent("PATH")
    FilePathCount = GetContentCount("PATH")
    SelectCount = List1.SelCount
    Dim strSelectedItem As String
    Dim strTemp() As String
    For i = 0 To FilePathCount - 1
             strSelectedItem = strSelectedItem & FilePath(i) & vbCrLf
    Next
    For i = 0 To List1.ListCount - 1
        If List1.Selected(i) = True Then
            SelectCount = i
        End If
    Next
    strTemp = Split(strSelectedItem, vbCrLf)
    Dim wshShell As Object
    Set wshShell = CreateObject("WScript.Shell")
    Dim StrExeFile As String
    StrExeFile = App.Path
    If Right(StrExeFile, 1) <> "\" Then StrExeFile = StrExeFile & "\"
    StrExeFile = StrExeFile & strTemp(SelectCount)
    
    Call wshShell.Run(StrExeFile, 1, True)
    
End Sub
'***************************************************************
'讀取autorun.inf內容
'NAME : 安裝項目名稱
'PATH : 安裝路徑
'HELP : 說明文件
'***************************************************************
Private Function GetInfContent(Choice As String) As String()
    Dim StrExeFile As String
    StrExeFile = App.Path
    If Right(StrExeFile, 1) <> "\" Then StrExeFile = StrExeFile & "\"
    StrExeFile = StrExeFile & "AUTORUN.INF"
    Dim str() As String
    Dim FileName(100) As String
    Dim FilePath(100) As String
    Dim Help(100) As String
    Dim FileNameCount As Integer
    Dim FilePathCount As Integer
    Dim HelpCount As Integer
    FileNameCount = 0
    FilePathCount = 0
    HelpCount = 0
    str = Split(ReadFile(StrExeFile), vbCrLf)
    
    For i = 0 To UBound(str)
    
        If Left(str(i), 4) = "NAME" Then
            FileName(FileNameCount) = Right(str(i), Len(str(i)) - 5)
            FileNameCount = FileNameCount + 1
        End If
        If Left(str(i), 4) = "PATH" Then
            FilePath(FilePathCount) = Right(str(i), Len(str(i)) - 5)
            FilePathCount = FilePathCount + 1
        End If
        If Left(str(i), 4) = "HELP" Then
            Help(HelpCount) = Right(str(i), Len(str(i)) - 5)
            HelpCount = HelpCount + 1
        End If
    Next
    If Choice = "NAME" Then
        GetInfContent = FileName
    End If
    If Choice = "PATH" Then
        GetInfContent = FilePath
    End If
    If Choice = "HELP" Then
        GetInfContent = Help
    End If
End Function
'***************************************************************
'讀取autorun.inf項目總數
'NAME : 安裝項目名稱
'PATH : 安裝路徑
'HELP : 說明文件
'***************************************************************
Private Function GetContentCount(Choice As String) As Integer
    Dim StrExeFile As String
    StrExeFile = App.Path
    If Right(StrExeFile, 1) <> "\" Then StrExeFile = StrExeFile & "\"
    StrExeFile = StrExeFile & "AUTORUN.INF"
    Dim str() As String
    Dim FileNameCount As Integer
    Dim FilePathCount As Integer
    Dim HelpCount As Integer
    FileNameCount = 0
    FilePathCount = 0
    HelpCount = 0
    str = Split(ReadFile(StrExeFile), vbCrLf)
    For i = 0 To UBound(str)
        If Left(str(i), 4) = "NAME" Then
            FileNameCount = FileNameCount + 1
        End If
        If Left(str(i), 4) = "PATH" Then
            FilePathCount = FilePathCount + 1
        End If
        If Left(str(i), 4) = "HELP" Then
            HelpCount = HelpCount + 1
        End If
    Next
    If Choice = "NAME" Then
        GetContentCount = FileNameCount
    End If
    If Choice = "PATH" Then
        GetContentCount = FilePathCount
    End If
    If Choice = "HELP" Then
        GetContentCount = HelpCount
    End If
End Function
'***************************************************************
'讀取檔案第N行
'***************************************************************
Private Function ReadLineN(N As Integer, FileName As String)
    '取FileName的第N行
    Open FileName For Input As #1
    i = 0
    While Not EOF(1)
    i = i + 1
    Line Input #1, S
    If i = N Then
    ReadLineN = S
    Exit Function
    End If
    Wend
    Close #1
End Function

'***************************************************************
'讀取檔案全部內容
'***************************************************************
Private Function ReadFile(FilePath As String) As String
    Dim fileStr As String
    Open FilePath For Input As #1
    
    Do While Not EOF(1)
    Line Input #1, tem
    fileStr = fileStr & tem & vbCrLf
    Loop
    Close #1
    ReadFile = fileStr
End Function
'***************************************************************
'執行exe檔案
'***************************************************************
Private Function StartUpExe(FilePath As String)
    Dim wshShell As Object
    Set wshShell = CreateObject("WScript.Shell")
    Dim StrExeFile As String
    StrExeFile = App.Path
    If Right(StrExeFile, 1) <> "\" Then StrExeFile = StrExeFile & "\"
    StrExeFile = StrExeFile & FilePath
    Print StrExeFile
    Call wshShell.Run(StrExeFile, 1, True)
End Function
'***************************************************************
'開啟網頁瀏覽
'***************************************************************
Private Sub Picture1_Click()
    Call ShellExecute(Me.hwnd, "open", "http://www.google.com.tw/", "", "", vbNormalFocus)
End Sub

autorun.inf內容

OPEN=autorun.exe
ICON=LOGO.ico
HELP=使用說明.doc
NAME=測試安裝項目一
PATH=InstallTest1\setup.exe