[VB6]光碟機選單程式
參考資料很多=.=
完成如下
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