Attribute VB_Name = "MODUL_ApplicationBase"
' modul for Visual Basic 6
' Copyright (C) 2003,2004 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 lstrcpynA Lib "kernel32" (ByVal lpString1 As String, ByVal lpString2 As Long, ByVal iMaxLength As Long) As Long

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

If xChar2 = "" 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
  Do
    xLong1 = InStr(xLong2 + 1&, xChar2, "\")
    If xLong1 = 0& Then Exit Do
    xLong2 = xLong1
    Loop
  AppBase = Mid(xChar2, xLong2 + 1&)
  xChar2 = Left(xChar2, xLong2)
  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 vbNullChar
    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

