VERSION 5.00
Begin VB.Form frmStartAnyPortableApp 
   BackColor       =   &H00FFFFFF&
   BorderStyle     =   0  'Kein
   Caption         =   "PortableAppName"
   ClientHeight    =   1965
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   5775
   ControlBox      =   0   'False
   Icon            =   "frmStartPortableApp.frx":0000
   KeyPreview      =   -1  'True
   LinkTopic       =   "Start Any Portable App"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   Moveable        =   0   'False
   NegotiateMenus  =   0   'False
   ScaleHeight     =   1965
   ScaleWidth      =   5775
   ShowInTaskbar   =   0   'False
   StartUpPosition =   2  'Bildschirmmitte
   Begin VB.Timer tiShowMe 
      Enabled         =   0   'False
      Left            =   3120
      Top             =   720
   End
   Begin VB.Label lblCopy 
      Alignment       =   2  'Zentriert
      BackColor       =   &H00FFFFFF&
      Caption         =   "StartAnyPortableApp © 2010 by sméagol.de"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H000080FF&
      Height          =   375
      Left            =   120
      TabIndex        =   1
      Top             =   1440
      Width           =   5655
   End
   Begin VB.Label lblDoing 
      Alignment       =   2  'Zentriert
      BackColor       =   &H00FFFFFF&
      Caption         =   "Starting... PortableAppName"
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   12
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00C00000&
      Height          =   1095
      Left            =   120
      TabIndex        =   0
      Top             =   120
      Width           =   5535
   End
End
Attribute VB_Name = "frmStartAnyPortableApp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private StartExe As String

Private Sub Form_Load()

    Dim strSettingsAll, strFile, strPath, strRoot, strAddExe As String
    
    Dim strSettings() As String
    ReDim strSettings(4)
    
    On Error GoTo FailExit
    
    strPath = App.Path
    strRoot = Split(strPath, ":", , vbTextCompare)(0)
    strFile = strPath & "\Data\Settings.ini"
    If Not TestFileExists(strFile) Then
        If Not WriteFile(strFile, "[StartAnyPortableApp]" & vbCrLf & _
                          vbTab & "[Einstellungen]" & vbCrLf & _
                  vbTab & vbTab & "PortableAppName=[Bezeichnung]" & vbCrLf & _
                  vbTab & vbTab & "PortableAppSubPath=\PfadBeispiel\" & vbCrLf & _
                  vbTab & vbTab & "PortableAppExe=ExeFile.exe" & vbCrLf & _
                  vbTab & vbTab & "ShowMeMillisecond=1337") _
        Then
            GoTo FailExit
        End If
    End If
    Open strFile For Input As #2
        FileLength = LOF(2)
        strSettingsAll = Input(FileLength, #2)
    Close #2
    
    ReDim strSettings(UBound(Split(strSettingsAll, vbCrLf, -1, vbTextCompare)))
    
    strSettings = Split(strSettingsAll, vbCrLf, -1, vbTextCompare)
    
    For i = 0 To UBound(strSettings) - 1
    
        If InStr(1, strSettings(i), "=", vbTextCompare) > 0 Then
        
            strTheSettingName = Split(strSettings(i), "=")(0)
            strTheSettingValue = Split(strSettings(i), "=")(1)
            
            Select Case Replace(strTheSettingName, vbTab, "", 1, -1, vbTextCompare)
                 Case "PortableAppName"
                     lblDoing = "Starting" & vbCrLf & vbCrLf & strTheSettingValue
                 Case "PortableAppSubPath"
                     StartExe = strPath & strTheSettingValue
                 Case "PortableAppExe"
                     strAddExe = strTheSettingValue
                 Case "ShowMeMillisecond"
                     tiShowMe.Interval = CInt(strTheSettingValue)
                 Case Else
                     'coming soon more settings
            End Select
            
        End If
        
    Next
    
    StartExe = StartExe & strAddExe
    If Not TestFileExists(StartExe) Then
        MsgBox "Datei nicht Vorhanden" & vbCrLf & StartExe, vbOKOnly
        Unload Me
        Exit Sub
    End If
    tiShowMe.Enabled = True
    
    
    Exit Sub
    
FailExit:
    MsgBox "Fehler", vbOKOnly, "Fehler, Einstellungen überprüfen."
    tiShowMe.Enabled = False
    Unload Me
    
End Sub

Private Function WriteFile(ByVal sFile As String, ByVal vData As String) As Boolean
    On Error GoTo Bug
    Dim fNr As Byte
    fNr = FreeFile
    Open sFile For Append As #fNr
        Print #fNr, vData
    Close #fNr
    WriteFile = True
    Exit Function
Bug:
    WriteFile = False
    Exit Function
End Function

Private Sub lblDoing_Click()
    tiShowMe.Enabled = False
    DoOpen
End Sub

Private Sub tiShowMe_Timer()
    DoOpen
End Sub

Private Sub DoOpen()
    #If DebugMode Then
        Debug.Print StartExe
        Shell "C:\WINDOWS\System32\calc.exe", 1
    #Else
        Shell StartExe, vbNormalFocus
    #End If
    Unload Me
End Sub

Private Function TestFileExists(ByVal sFile As String) As Boolean
    If sFile <> "" Then
        TestFileExists = (Dir$(sFile) <> "")
    Else
        TestFileExists = False
    End If
End Function