VB6 QAT SLIPWH modINI

©Don aght groupKOS doght cφm

Option Explicit

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpApplicationName As String, ByVal lpString As String, ByVal lpFileName As String) As Long


Public Function ASCCodeToUnicode(ByVal CodeString As String) As String
    Dim x As Long
    
    For x = 1 To Len(CodeString) Step 2
        ASCCodeToUnicode = ASCCodeToUnicode & Chr(Val(Mid(CodeString, x, 2)))
    Next
End Function

Public Function UnicodeToASCCode(ByVal Unicode As String) As String
    Dim x As Long
    
    For x = 1 To Len(Unicode)
        UnicodeToASCCode = UnicodeToASCCode & CStr(Asc(Mid(Unicode, x, 1)))
    Next
End Function

Public Function INIGetBool( _
            ByVal Section As String, _
            ByVal Key As String, _
            Optional ByVal Default As String = "0" _
            ) As Boolean
   Dim szBool       As String
   Dim lngLength    As Long
    
    '    Load Boolean options
    szBool = String$(6, Chr(0))
    lngLength = GetPrivateProfileString(Section, Key, Default, szBool, 5, App.Path & "\QAT.INI")
    szBool = Left$(szBool, lngLength)
    
    Select Case True
        
       Case Val(szBool) > 0, _
            LCase(szBool) = "true", _
            LCase(szBool) = "yes"
            
            INIGetBool = True
            
   End Select
End Function
     
Public Function INIGetInteger( _
            ByVal Section As String, _
            ByVal Key As String, _
            Optional ByVal Default As String = "" _
            ) As Long
    
   Dim szStr As String
   Dim lngLength As Long
   
   szStr = String$(256, Chr(0))
   lngLength = GetPrivateProfileString(Section, Key, Default, szStr, 255, App.Path & "\QAT.INI")
   szStr = Left$(szStr, lngLength)
   
   INIGetInteger = CInt(szStr)
End Function

Public Function INIGetString( _
            ByVal Section As String, _
            ByVal Key As String, _
            Optional ByVal Default As String = "" _
            ) As String
    
   Dim szStr As String
   Dim lngLength As Long
   
   szStr = String$(256, Chr(0))
   lngLength = GetPrivateProfileString(Section, Key, Default, szStr, 255, App.Path & "\QAT.INI")
   szStr = Left$(szStr, lngLength)
   
   INIGetString = szStr
End Function

Public Function INIGetSection(ByVal Section As String) As String()
    '   Gets the entire section of Name=Value lines as an array of
    '   string values of lines within the section of the INI file.
    Dim strBuffer As String
    
    On Error Resume Next
    
    '   Read the INI section into the buffer string
    strBuffer = String$(2048, " ")
    strBuffer = Left$(strBuffer, GetPrivateProfileSection(Section, strBuffer, Len(strBuffer), App.Path & "\QAT.INI"))
    strBuffer = Left$(strBuffer, Len(strBuffer) - 1)  'remove trailing null
    
    strBuffer = ReplaceChar(strBuffer, Chr$(0), vbCr)
    INIGetSection = Split(strBuffer, vbCr)
End Function
 
Public Sub INIDeleteSection(ByVal Key As String)
   Dim Result As Long
   Dim NullList As String
   
   NullList = Chr(0) & Chr(0)
   Result = WritePrivateProfileSection(Key, NullList, "\QAT.INI")
   Debug.Assert Result <> 0
End Sub

Public Function INIWrite( _
            ByVal Section As String, _
            Optional ByVal Key As String = "", _
            Optional ByVal Value As String = "" _
            ) As Long
    
    '   Writes or deletes Key and Value
    
    Dim strFile As String
    
    strFile = App.Path & "\QAT.INI"
    
    Select Case True
        Case (Len(Key) > 0) And (Len(Value) > 0)
            INIWrite = WritePrivateProfileString(Section, ByVal Key, ByVal Value, strFile)
        Case (Len(Key) > 0) 'delete key's value
            INIWrite = WritePrivateProfileString(Section, ByVal Key, vbNullString, strFile)
        Case Else 'delete entire section
            INIWrite = WritePrivateProfileString(Section, vbNullString, vbNullString, strFile)
    End Select

End Function
 
Public Function ReplaceChar(ByVal Source As String, Char As String, Replace As String) As String
    '   This enables parsing of Win32 null-delimited binary buffers
    '   by replacing null occurrences in Source with a string character.
    Dim s As String
    Dim x As Long
    Dim Y As Long
    
    Y = Len(Source)
    For x = 1 To Y
        s = Mid$(Source, x, 1)
        '   Test for Char and swap with Replace if found
        If Asc(s) = Asc(Char) Then Mid$(Source, x, 1) = Replace
    Next
    ReplaceChar = Source
End Function