I have search many pages on the internet but dont know where i put the file path.
Also i changed my mind.
While seaching i see that there is al file list box.
Thinking loud:
I want the drive D: (standard drive no changing options)
Directory Games (standard directorie no changing options)
En show all files in a file list box (the ISO file)
When i select one file in the box it wil start .
Is this posible?
Here is a working code, start new project, add Drive1, Dir1 and File1
Code:
Option Explicit
Private Sub Form_Load()
Mount_ISO_File "path\to\an\ISO\file"
If IsMounted Then
'Switch to the mounted drive. (usually it will be the last one)
Drive1.Drive = Drive1.List(Drive1.ListCount - 1)
MsgBox "The ISO file is ready to use.", vbInformation
Else
MsgBox "Cannot mount the ISO file!", vbExclamation
End If
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
Private Sub File1_Click()
If Right$(File1.Path, 1) = "\" Then
Shell File1.Path & File1.FileName
Else
Shell File1.Path & "\" & File1.FileName
End If
End Sub
Private Sub Mount_ISO_File(ByVal strFile As String)
Shell Environ$("windir") & "\explorer.exe" & " " & strFile, vbMinimizedNoFocus
End Sub
Private Function IsMounted() As Boolean
Dim lngOldCount As Long
Dim sngTimeOut As Single
lngOldCount = Drive1.ListCount
sngTimeOut = Timer
' Wait until the ISO file mounted or passing 5 seconds without something happen, e.g. the file already mounted
Do
Drive1.Refresh
Loop Until (Drive1.ListCount > lngOldCount) Or (Timer > sngTimeOut + 5)
IsMounted = (Drive1.ListCount > lngOldCount)
End Function
I get errors
1: at the start up i get a box with the message "Cannot mount the ISO file!"
2: by select the drive, the directory en then the iso file i ged a run-time error 5: invalid procedure call or argument.
When i click debug is on Shell File1.Path & "\" & File1.FileName.
And the ISO file wil not start..
1: at the start up i get a box with the message "Cannot mount the ISO file!"
This is happen if the ISO already mounted, try to check if the ISO drive letter exist before calling Mount_ISO_File
2: by select the drive, the directory en then the iso file i ged a run-time error 5: invalid procedure call or argument.
Shell used to run app file (*.exe), so if you select other file type e.g. *.txt then you must run the app you want to open the file with and pass that file to the app, here is an example for text files
Code:
Private Sub File1_Click()
Dim strPath As String
strPath = File1.Path
If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Shell Environ$("windir") & "\notepad.exe" & " " & strPath & File1.FileName
End Sub
Even when i select a .exe file i get the same error.
And when the iso is ready.
I want to start a new project programm and open the iso file
I'll make it like before Drive, directory, filelist.
Bud when i mouseklik on the isofile it wil start a simulation drive and start up.
I already showed you how to mount an ISO in VB program and how to start an app using Shell
What i'm understand is that you want to auto start a game in an ISO, the problem is that each game has different exe name, so how to know the game's exe name to auto run it?
Perhaps i can install all games and when i start the game exe file is wil set de iso file to a simulation cd/dvd and start de game.
It will only start when the game's cd/dvd is in a simulation drive.
I tried to change it a littlebit..
Bud it don't work
It show the EXE file bud when i start up i get a debug error
Dim F As Form
'button min
Private Sub Command1_Click()
Form1.WindowState = vbMinimized
End Sub
'button close all forms
Private Sub Command2_Click()
For Each F In Forms
If F.Name <> Me.Name Then
Unload F
End If
Next
Unload Me
End Sub
Private Sub File1_Click()
Dim strPath As String
strPath = File1.Path
If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Shell Environ$("windir") & "Strike Team Hydra.exe" & " " & strPath & File1.FileName
End Sub
Private Sub Form_Load()
File1.Path = "C:\Program Files\Strike Team Hydra"
File1.Pattern = "*.exe"
End Sub
Dim F As Form
'button min
Private Sub Command1_Click()
Form1.WindowState = vbMinimized
End Sub
'button close all forms
Private Sub Command2_Click()
For Each F In Forms
If F.Name <> Me.Name Then
Unload F
End If
Next
Unload Me
End Sub
Private Sub File1_Click()
Dim strPath As String
strPath = File1.Path
If Right$(strPath, 1) <> "\" Then
strPath = strPath & "\"
End If
Shell strPath & File1.FileName
End Sub
Private Sub Form_Load()
File1.Path = "C:\Program Files\Strike Team Hydra"
File1.Pattern = "*.exe"
End Sub
If you have many games and want to run from one list then you can store information about each game in file and run according this info
the attached project is a simple way to do that, all you have to do is editing the file "game list.txt" and store info about your games, each line of that file consist of three field separated by "|"
1- The game title e.g. Strike Team Hydra
2- The full path to the game exe file e.g. C:\Program Files\Strike Team Hydra\Strike Team Hydra.exe
3- (optional) The full path to the game ISO file e.g. D:\games\Strike Team Hydra.iso
I have found it with "List1.Text" i kan change te picture.
With a little cut and past.
If the picture have the same name as the game it shows the picture in the picture box.
One thing i can't find.
Now its onley the JPG files, bud how cam i put more types pictures as bmp, of even een gif
Private Sub List1_Click()
Dim sFile As String
Dim lLen As Long
sFile = "D:\game\" & List1.Text & ".jpg"
On Error Resume Next
lLen = FileLen(sFile)
If Err Then
Picture1.Picture = Nothing
Else
Picture1.Picture = LoadPicture(sFile)
End If
On Error GoTo 0
This part read the .TxT file for info game.
Bud when the .TxT file exist i get a error.
"On error resume next" it freese the program
Can you help me to make that if the .TxT file not exist the Text1.text = No ino.
My code: (found on the internet) It works solong the .TxT file is there
Dim dText As String
Dim sString1 As String, sString2 As String
Open "D:\game\" & List1.Text & ".TxT" For Input As #1
Do While Not EOF(1)
Input #1, sString1, sString2
dText = dText & sString1 & ", " & sString2 & vbCrLf
Loop
Text1.Text = dText
Close
I tried the IsFilkeExist bud where ever i put it i get a error.
I don't know where to put it and how to write
Meaby can you help me with this:
I tried"on error goto 0
and by 0 text1.text gives the text "No game info"
Is this posible i get the same debug error as in post 30
Private Sub List1_Click()
Dim sFile As String
Dim lLen As Long
'load game picture
sFile = "D:\game\" & List1.Text & ".jpg"
On Error Resume Next
lLen = FileLen(sFile)
If Err Then
Picture1.Picture = Nothing
Else
Picture1.Picture = LoadPicture(sFile)
End If
'load game text
On Error GoTo 0
Dim dText As String
Dim sString1 As String, sString2 As String
Open "D:\game\" & List1.Text & ".TxT" For Input As #1
Do While Not EOF(1)
Input #1, sString1, sString2
dText = dText & sString1 & ", " & sString2 & vbCrLf
Loop
On Error GoTo 0
Text1.Text = dText
Close
0
Text1.Text = "No Game info"
End Sub
When the TxT file exist there is no problem it works fine
The problem is that the program tries to read a textfile that not exist.
I tried on error go to 0 bud no succes. it dosnt work
Runtime errot 53
"file not exist"
When i press Debug its on the part:Open "D:\game\" & List1.Text & ".TxT" For Input As #1
On Error GoTo 0
Dim dText As String
Dim sString1 As String, sString2 As String
Open "D:\game\" & List1.Text & ".TxT" For Input As #1
Do While Not EOF(1)
Input #1, sString1, sString2
dText = dText & sString1 & ", " & sString2 & vbCrLf
Loop
On Error GoTo 0
Text1.Text = dText
Close
0
Text1.Text = "No Game info"
End Sub
Private Sub List1_Click()
Dim sDir As String
sDir = "D:\game\"
'load game picture, try to load jpg, gif or bmp
If IsFileExist(sDir & List1.Text & ".jpg") Then
Picture1.Picture = LoadPicture(sDir & List1.Text & ".jpg")
ElseIf IsFileExist(sDir & List1.Text & ".gif") Then
Picture1.Picture = LoadPicture(sDir & List1.Text & ".gif")
ElseIf IsFileExist(sDir & List1.Text & ".bmp") Then
Picture1.Picture = LoadPicture(sDir & List1.Text & ".bmp")
Else
Picture1.Picture = Nothing
End If
'load game text
If IsFileExist(sDir & List1.Text & ".txt") Then
Dim dText As String
Dim sString1 As String, sString2 As String
Dim lFileNumber As Long
lFileNumber = FreeFile
Open sDir & List1.Text & ".txt" For Input As #lFileNumber
Do While Not EOF(1)
Input #lFileNumber, sString1, sString2
dText = dText & sString1 & ", " & sString2 & vbCrLf
Loop
Close #lFileNumber
Text1.Text = dText
Else
Text1.Text = "No Game info"
End If
End Sub
Private Function IsFileExist(strFile As String) As Boolean
IsFileExist = (Dir(strFile) <> vbNullString)
End Function
One problem is that i move the exe file for example to the desktop.
I get a error.
Is this from this part "App.path"
When i left it in the app dir where it was saved in VB6 the it works fine.
The error is Run=time error '380' Invalid propety value
Reply With Quote
Originally Posted by JTvD
