'Date: 09\06/2012
'Description: Automatically load game in Dosbox
'Author: Nightwalker83
'Version: 1.0
'Website: http://aaronspehr.net/
Option Explicit
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Declare Function OpenProcess Lib "kernel32" (ByVal dwDesiredAccess As Long, ByVal bInheritHandle As Long, ByVal dwProcessId As Long) As Long
Private Declare Function WaitForSingleObject Lib "kernel32" (ByVal hHandle As Long, ByVal dwMilliseconds As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Const SYNCHRONIZE = &H100000
Private Const INFINITE = -1&
Dim ff As Integer
' Start the indicated program and wait for it
' to finish, hiding while we wait.
Private Sub ShellAndWait(ByVal program_name As String)
Dim process_id As Long
Dim process_handle As Long
' Start the program.
On Error GoTo ShellError
process_id = Shell(program_name, vbNormalFocus)
On Error GoTo 0
' Hide.
Me.Visible = False
DoEvents
' Wait for the program to finish.
' Get the process handle.
process_handle = OpenProcess(SYNCHRONIZE, 0, process_id)
If process_handle <> 0 Then
WaitForSingleObject process_handle, INFINITE
CloseHandle process_handle
End If
' Reappear.
Me.Visible = True
Exit Sub
ShellError:
MsgBox "Error running '" & program_name & _
"'" & vbCrLf & Err.Description
End Sub
Private Sub Command1_Click()
commands
loadDosbox
End Sub
Private Sub commands()
ff = FreeFile
Open "C:\Users\Aaron\AppData\Local\DOSBox\" & "dosbox-0.74.conf" For Append As #ff
Print #ff, "mount c e:\dosgames -freesize 1000"
Print #ff, "mount d e:\dosgames\dfcd -t cdrom -label Daggerfall"
Print #ff, "d:"
Print #ff, "install"
Print #ff, "mount c e:\dosgames -freesize 1000"
Print #ff, "mount d c:\dosgames\dfcd -t cdrom -label Daggerfall"
Print #ff, "c:"
Print #ff, "cd/dagger"
Print #ff, "dagger"
Close #ff
End Sub
Private Sub loadDosbox()
Dim sYourCommand As String
sYourCommand = """" & "C:\Program Files (x86)\DOSBox-0.74\DOSBox.exe"
ShellAndWait sYourCommand
End Sub