Attribute VB_Name = "mod_AppBase"
' modul for Visual Basic 6
' Copyright (C) 2003-2007 Jan Vorel

' This program is free software; you can redistribute it and/or modify
' it under the terms of the GNU General Public License as published by
' the Free Software Foundation; either version 2 of the License, or
' (at your option) any later version.

' This program is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
' GNU General Public License for more details.

' You should have received a copy of the GNU General Public License
' along with this program; if not, write to the Free Software
' Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

' This is a shared modul, class modul, usercontrol or form. It is also
' published under the GNU General Public License.

' If you have any questions, suggestions or bug reports about this product,
' contact me: info@ctuser.net; Do not contact me about general B.A.S.I.C.
' language or A.P.I. issues

Option Explicit
Option Base 0

Private Declare Function GetCommandLineA Lib "kernel32" () As Long
Private Declare Function GetCommandLineW Lib "kernel32" () As Long
Private Declare Function lstrcpynA Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long

' "" -> No extension (light)
' <0> -> exename     (exeonly, finishing .)
' <1> -> path        (pathonly, finishing \)


'#AppBase_FlagA:
'  0 = Default (Mixed)
'  1 = Default, less case sensitive
' (F)= Disabled

' 10 = Exename
' 11 = PathOnly
' 12 = NoExtension

'100 = FilteredCmd

#If (AppBase_FlagA And &H1F) >= &H10 And (AppBase_FlagA And &H1F&) <= &H12& Then
  Public Function AppBase() As String
    Dim xLong1 As Long
    #If (AppBase_FlagA And &H1F&) = &H12& Then
      Dim xLong2 As Long
      #End If
    Static xChar1 As String
    
    If Not xChar1 = "" Then
      AppBase = xChar1
      Else
      'xLong1 = GetCommandLineW
      If xLong1 = 0& Then
        xLong1 = GetCommandLineA
        If Not xLong1 = 0& Then
          AppBase = String(65535, vbNullChar)
          Call lstrcpynA(AppBase, xLong1, 65534)
          AppBase = Trim(Left(AppBase, InStr(AppBase & vbNullChar, vbNullChar) - 1&))
          End If
        Else
        
        End If
      If Left(AppBase, 1&) = Chr(34&) Then
        AppBase = Mid(AppBase, 2&)
        xLong1 = Len(AppBase)
        If Not xLong1 = 0 Then
          AppBase = Left(AppBase, xLong1 - 1&)
          End If
        xLong1 = InStr(AppBase, Chr(34&))
        Else
        xLong1 = InStr(AppBase, " ")
        End If
      If Not xLong1 = 0& Then
        AppBase = Left(AppBase, xLong1 - 1&)
        End If
      #If (AppBase_FlagA And &H1F&) = &H10& Then
        xChar1 = AppBase
        #Else
        xLong1 = InStrRev(AppBase, "\")
        #If (AppBase_FlagA And &H1F&) = &H11& Then
          If xLong1 = 0& Then
            xChar1 = AppBase & "\"
            Else
            xChar1 = Left(AppBase, xLong1)
            End If
          AppBase = xChar1
          #Else
          '' = #AppBase_NoExtension (AppBase_FlagA=12)
          xLong2 = InStrRev(AppBase, ".")
          If xLong2 = 0& Or xLong2 < xLong1 Then
            xChar1 = AppBase & "."
            Else
            xChar1 = Left(AppBase, xLong2)
            End If
          AppBase = xChar1
          #End If
        #End If
      End If
    End Function
  #ElseIf ((AppBase_FlagA And &HF&) = 0& Or (AppBase_FlagA And &HF&) = &H1&) Then
  Public Function AppBase(Optional ByVal ExtensionToAdd As String = vbNullChar) As String
    Static xLong1 As Long
    Static xChar1 As String
    Static xChar2 As String
    Static xChar3 As String
    
    If xLong1 = 0& Then
      xLong1 = GetCommandLineA
      xChar2 = String(65535, vbNullChar)
      Call lstrcpynA(ByVal xChar2, xLong1, 65534)
      xChar2 = Trim(Left(xChar2, InStr(xChar2, vbNullChar) - 1&))
    
      If Left(xChar2, 1&) = Chr(34&) Then
        xChar2 = Mid(xChar2, 2&)
        xLong1 = Len(xChar2)
        If Not xLong1 = 0& Then
          xChar2 = Left(xChar2, xLong1 - 1&)
          End If
        xLong1 = InStr(xChar2, Chr(34&))
        Else
        xLong1 = InStr(xChar2, " ")
        End If
      If Not xLong1 = 0& Then
        xChar2 = Left(xChar2, xLong1 - 1&)
        End If
    
      xLong1 = InStrRev(xChar2, "\")
      AppBase = Mid(xChar2, xLong1 + 1&)
      xChar2 = Left(xChar2, xLong1)
      xChar3 = xChar2
      xLong1 = InStrRev(AppBase, ".")
      If xLong1 = 0& Then
        xChar1 = AppBase & "."
        Else
        xChar1 = Left(AppBase, xLong1)
        End If
      #If AppBase_FlagA = 2 Then
        xLong1 = 1&
        #Else
        Select Case xChar1
          Case LCase(xChar1)
            xLong1 = 1&
          Case UCase(xChar1)
            xLong1 = 2&
          Case Else
            xLong1 = 3&
          End Select
        #End If
      xChar1 = xChar2 & xChar1
      xChar2 = xChar2 & AppBase
      End If
    
    Select Case ExtensionToAdd
      Case vbNullChar
        AppBase = xChar2
      Case Chr(1&)
        AppBase = xChar3
#If AppBase_FlagA = 2 Then
  #Else
      Case LCase(ExtensionToAdd), UCase(ExtensionToAdd)
        If xLong1 = 2& Then
          AppBase = xChar1 & UCase(ExtensionToAdd)
          ElseIf xLong1 = 1& Then
          AppBase = xChar1 & LCase(ExtensionToAdd)
          Else
          AppBase = xChar1 & ExtensionToAdd
          End If
  #End If
      Case Else
        AppBase = xChar1 & ExtensionToAdd
      End Select
    'MsgBox AppBase
    End Function
  #End If


#If (AppBase_FlagA And &H100) = &H100& Then
  Public Function FilteredCMD(ByVal xParam As String) As String
    Dim xLong1 As Long
    FilteredCMD = xParam
    
    xLong1 = InStr(FilteredCMD, Chr(34&))
    If xLong1 = 0& Then
      FilteredCMD = Trim(FilteredCMD)
      Do
        Select Case Left(FilteredCMD, 1&)
          Case "/", "-"
            xLong1 = InStr(FilteredCMD, " ")
            If xLong1 = 0& Then
              FilteredCMD = ""
              Exit Function
              End If
            FilteredCMD = Trim(Mid(FilteredCMD, xLong1 + 1&))
          Case Else
            Exit Do
          End Select
        Loop
      xLong1 = InStr(FilteredCMD, "/")
      If xLong1 = 0 Then Exit Function
      FilteredCMD = Left(FilteredCMD, xLong1 - 1&)
      Else
      FilteredCMD = Mid(FilteredCMD, xLong1 + 1&)
      xLong1 = InStr(FilteredCMD, Chr(34&))
      If xLong1 = 0& Then
        FilteredCMD = ""
        Else
        FilteredCMD = Left(FilteredCMD, xLong1 - 1&)
        End If
      End If
    End Function
  #End If

