Attribute VB_Name = "Common"

Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

'the format that dates are to be displayed throughout Table Maintenance
Public Const gblDateDisplayFormat As String = "mm-dd-yyyy"
'the format that date/times are to be displayed throughout Table Maintenance
Public Const gblDateTimeDisplayFormat As String = "mm-dd-yyyy hh:mm:ss"

Option Explicit

'***********************************************************************
'Returns Windows login name
'***********************************************************************
Public Function GetLoginName() As String
Dim strBuffer As String * 256
Dim lngSize As Long
Dim lngReturnCode As Long
On Error GoTo ErrorHandler
    
    'Does anyone really have a name this long?
    lngSize = 256
    
    lngReturnCode = GetUserName(strBuffer, lngSize)
    
    If Len(Left(strBuffer, lngSize)) <> 0 Then
        GetLoginName = Left(strBuffer, lngSize - 1)
      Else
        GetLoginName = ""
    End If

Exit Function
ErrorHandler:
    Got_Error "Common", "GetLoginName()"
End Function


'***********************************************************************
' Comments   : Checks whether arguement is
'                Null, Empty, empty string, or Nothing
' Parameters : varArg ==> the control or variable being checked
' Returns    : true if it is Null, Empty, empty string, or Nothing
' Created    : Enterprise Software Solutions [05/26/1999]
' Modified   : Enterprise Software Solutions [09/24/2001] check array for 0 elements
'***********************************************************************
Public Function IsNothing(varArg As Variant) As Boolean
On Error GoTo ErrorHandler

    Select Case VarType(varArg)
        Case vbEmpty
            IsNothing = True
        Case vbNull
            IsNothing = True
        Case vbString
            If Len(varArg) = 0 Then
                IsNothing = True
            End If
        Case vbObject
            If varArg Is Nothing Then
                IsNothing = True
            End If
        Case Is >= vbArray
            'error will occur for empty array
            If UBound(varArg) < 0 Then
                IsNothing = True
            End If
    End Select

Exit Function
ErrorHandler:
    IsNothing = True
End Function

'***************************************************************************
' Comments   : converts a delimited string into an array
' Parameters : strTheString     ==> string to be parced into the array
'              strDelimiterChar    ==> the text that delimits the string
' Returns    : nothing
' Created    : Enterprise Software Solutions (03-21-2000)
' Modified   :
'***************************************************************************
Public Function CArray(ByVal strTheString As String, _
        Optional ByVal strDelimiterChar As String = "|") As String()
Dim iCount As Integer
Dim iPosition As Integer
Dim ilenAssigned As Integer
Dim iCurrentStrLen As Integer
Dim strTempArray() As String
        
    ' Initialize variables:
    iCount = 0
    iPosition = 1
    ilenAssigned = 1
    iCurrentStrLen = Len(strTheString)
    Do
        ReDim Preserve strTempArray(0 To iCount)
        iCurrentStrLen = (InStr(iPosition, strTheString, strDelimiterChar) - iPosition)
        If iCurrentStrLen < 0 Then
            strTempArray(iCount) = Right(strTheString, (Len(strTheString) - (ilenAssigned - 1)))
            Exit Do
          Else
            strTempArray(iCount) = Mid(strTheString, iPosition, iCurrentStrLen)
        End If
        ilenAssigned = ilenAssigned + (Len(strTempArray(iCount)) + Len(strDelimiterChar))
        iPosition = ilenAssigned
        iCount = iCount + 1
    Loop
    
    'delete the last element (if it is empty)
    ' and there is more than on element in the array
    If (IsNothing(strTempArray(UBound(strTempArray)))) _
            And (UBound(strTempArray) > LBound(strTempArray)) Then
        ReDim Preserve strTempArray(LBound(strTempArray) To _
                (UBound(strTempArray) - 1))
    End If
    
    'copy the arrays
    CArray = strTempArray
    
    '*** usage ***
'    Dim WorkArray() As String
'    WorkArray() = CArray({String to be Parced}, {optional delimiter (if not pipe)

End Function


'***************************************************************************
' Comments   : highlights text within a text box
' Parameters : TextControl = the textbox ; istart = starting position to highlight
'              iLength = how many characters after start to highlight
'                (if unspecified, it defaults to all text)
' Returns    : nothing
' Created    : Enterprise Software Solutions (05-26-1999)
' Modified   :
'***************************************************************************
Public Sub Highlight_Text(TextControl As Control, Optional iStart As Variant, Optional iLength As Variant)
On Error Resume Next
    
    TextControl.SetFocus
    'make sure that text box isn't blank
    If TextControl <> "" Then
        'set start position (bason on iStart parameter if given)
        If (IsMissing(iStart) = True) Or (CInt(iStart) > Len(TextControl.Text)) Then
            TextControl.SelStart = 0
          Else
            TextControl.SelStart = CInt(iStart)
        End If
        If IsMissing(iLength) = True Then
            TextControl.SelLength = Len(TextControl.Text)
          Else
            TextControl.SelLength = (CInt(iLength) - TextControl.SelStart)
        End If
    End If
End Sub


'***************************************************************************
' Comments   : Get text in the middle of 2 strings
' Parameters : LeadingText, TrailingText
' Returns    : text in the middle
' Created    : Enterprise Software Solutions (05-26-1999)
' Modified   :
'***************************************************************************
Public Function MidStr(StringToSearch As String, _
        Optional LeadingText As String, _
        Optional TrailingText As String) As String
    MidStr = StringToSearch
    'strip off beginning of string
    If InStr(1, UCase(MidStr), UCase(LeadingText)) <> 0 And LeadingText <> "" Then
        MidStr = Mid(MidStr, _
                InStr(1, UCase(MidStr), UCase(LeadingText)) _
                + Len(LeadingText))
    End If
    'strip off ending of string
    If InStr(1, UCase(MidStr), UCase(TrailingText)) <> 0 And TrailingText <> "" Then
        MidStr = Mid(MidStr, 1, InStr(1, UCase(MidStr), UCase(TrailingText)) - 1)
    End If
End Function


'***********************************************************************
' Comments   : determines whether or not a file exists
' Parameters : the file path to look for
' Returns    : Returns TRUE if file does exist, FALSE is not
' Created    : Enterprise Software Solutions [06/11/1999]
' Modified   :
'***********************************************************************
Public Function FileExists(strFilePath As String) As Boolean
Dim objFileSystem As New FileSystemObject
On Error GoTo ErrorHandler

    'check if file exists
    FileExists = objFileSystem.FileExists(strFilePath)
    
ExitCleanup:
    'clean up
    Set objFileSystem = Nothing
Exit Function
ErrorHandler:
    RaiseSameError "FileExists()" & vbCrLf & "Path=" & strFilePath
End Function


'Returns the path to the Windows directory as a string.
Function GetWinDir() As String
Dim lpBuffer As String * 144
Dim Length%
On Error GoTo ErrorHandler

   Length% = GetWindowsDirectory(lpBuffer, Len(lpBuffer))
   GetWinDir = Left(lpBuffer, Length%)
Exit Function
ErrorHandler:
    RaiseSameError "GetWinDir()"
End Function


'Returns the path to the Windows System directory as a string.
Function GetSysDir() As String
Dim lpBuffer As String * 144
Dim Length%
On Error GoTo ErrorHandler

   Length% = GetSystemDirectory(lpBuffer, Len(lpBuffer))
   GetSysDir = Left(lpBuffer, Length%)
Exit Function
ErrorHandler:
    RaiseSameError "GetSysDir()"
End Function