Attribute VB_Name = "MODUL_ApplicationBase"
' MODUL_ApplicationBase
' modul for Visual Basic 6
' Copyright (C) 2003 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 String

Public Function AppBase(Optional ByVal ExtensionToAdd As String = vbNullChar) As String
Static xLong1 As Long
Dim xLong2 As Long
'Dim xLong3 As Long
Static xChar1 As String
Static xChar2 As String
Static xChar3 As String

If xChar2 = "" Then
  xChar2 = Trim(GetCommandLineA)
  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
  Do
    xLong1 = InStr(xLong2 + 1, xChar2, "\")
    If xLong1 = 0 Then Exit Do
    xLong2 = xLong1
    Loop
'  If Not xLong2 = 0 Then
    AppBase = Mid(xChar2, xLong2 + 1)
    xChar2 = Left(xChar2, xLong2)
'    End If
  xChar3 = xChar2
  xLong2 = 0
  Do
    xLong1 = InStr(xLong2 + 1, AppBase, ".")
    If xLong1 = 0 Then Exit Do
    xLong2 = xLong1
    Loop
  If Not xLong2 = 0 Then
    xChar1 = Left(AppBase, xLong2)
    Else
    xChar1 = AppBase & "."
    End If
  Select Case xChar1
    Case LCase(xChar1)
      xLong1 = 1
    Case UCase(xChar1)
      xLong1 = 2
    Case Else
      xLong1 = 0
    End Select
  xChar1 = xChar2 & xChar1
  xChar2 = xChar2 & AppBase
  End If

Select Case ExtensionToAdd
  Case Chr(0)
    AppBase = xChar2
  Case Chr(1)
    AppBase = xChar3
  Case LCase(ExtensionToAdd), UCase(ExtensionToAdd)
    If xLong1 = 2 Then
      AppBase = xChar1 & UCase(ExtensionToAdd)
      Else
      AppBase = xChar1 & LCase(ExtensionToAdd)
      End If
  Case Else
    AppBase = xChar1 & ExtensionToAdd
  End Select
End Function

