Public Declare Function GetPrivateProfileInt Lib "kernel32" Alias "GetPrivateProfileIntA" (ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal nDefault 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 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
Public Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long
Public 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 GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.

Public Enum enu_PrivateProfile
   Default = 0
   No_Common = 1
   No_NullSpace = 2
End Enum

Public Enum enu_RegKey
   HKEY_CLASSES_ROOT = &H80000000
   HKEY_CURRENT_CONFIG = &H80000005
   HKEY_CURRENT_USER = &H80000001
   HKEY_DYN_DATA = &H80000006
   HKEY_LOCAL_MACHINE = &H80000002
   HKEY_PERFORMANCE_DATA = &H80000004
   HKEY_USERS = &H80000003
End Enum

Public Enum enu_RegKeyType
   REG_BINARY = 3                     ' Free form binary
   REG_DWORD = 4                      ' 32-bit number
   REG_EXPAND_SZ = 2                  ' Unicode nul terminated string
   REG_LINK = 6                       ' Symbolic Link (unicode)
   REG_MULTI_SZ = 7                   ' Multiple Unicode strings
   REG_NONE = 0                       ' No value type
   REG_SZ = 1                         ' Unicode nul terminated string
End Enum

Private Const BufferString = 256

Public Function myRegQueryValue(ByVal lpstrRegKey As String)

Dim hKey As Long
Dim lpType As enu_RegKeyType
Dim lpData() As Byte
Dim lpcbData As Long
Dim hRegKey As enu_RegKey, lpSubKey As String, lpValueName As String

hRegKey = myGetRegKey(lpstrRegKey)
lpSubKey = myGetSubKey(lpstrRegKey)
lpValueName = myGetValueName(lpstrRegKey)

If lpSubKey = "" And lpValueName <> "" Then
   lpSubKey = lpValueName
   lpValueName = vbNullString
End If

summy = RegOpenKey(hRegKey, lpSubKey, hKey)

If summy = 0 Then

   ReturnCode = RegQueryValueEx(hKey, lpValueName, 0, lpType, ByVal 0, lpcbData)
      
   If lpcbData > 0 Then
      ReDim lpData(1 To lpcbData) As Byte
      ReturnCode = RegQueryValueEx(hKey, lpValueName, 0, 0, lpData(1), lpcbData)
   End If

   summy = RegCloseKey(hKey)
End If

Select Case lpType
Case REG_NONE
   myRegQueryValue = Empty
Case REG_SZ
    tStr = StrConv(CStr(lpData), vbUnicode)
    myRegQueryValue = Left(tStr, Len(tStr) - 1)
End Select

End Function

Private Function myGetValueName(ByVal lpstrRegKey As String) As String

Dim i As Long

lpstrRegKey = Mid(lpstrRegKey, InStr(lpstrRegKey, "\") + 1)

Do
   i = InStr(i + 1, lpstrRegKey, "\")
Loop Until InStr(i + 1, lpstrRegKey, "\") = 0

myGetValueName = Mid(lpstrRegKey, i + 1)

End Function

Private Function myGetSubKey(ByVal lpstrRegKey As String) As String

Dim i As Long

lpstrRegKey = Mid(lpstrRegKey, InStr(lpstrRegKey, "\") + 1)

Do
   i = InStr(i + 1, lpstrRegKey, "\")
Loop Until InStr(i + 1, lpstrRegKey, "\") = 0

If i > 0 Then
   myGetSubKey = Left(lpstrRegKey, i - 1)
Else
   myGetSubKey = vbNullString
End If

End Function

Private Function myGetRegKey(ByVal lpstrRegKey As String) As enu_RegKey

tLoc = InStr(lpstrRegKey, "\")
If tLoc = 0 Then
   lpstrRegKey = UCase(lpstrRegKey)
Else
   lpstrRegKey = UCase(Left(lpstrRegKey, tLoc - 1))
End If

Select Case lpstrRegKey
Case "HKEY_CLASSES_ROOT"
   myGetRegKey = HKEY_CLASSES_ROOT
Case "HKEY_CURRENT_CONFIG"
   myGetRegKey = HKEY_CURRENT_CONFIG
Case "HKEY_CURRENT_USER"
   myGetRegKey = HKEY_CURRENT_USER
Case "HKEY_DYN_DATA"
   myGetRegKey = HKEY_DYN_DATA
Case "HKEY_LOCAL_MACHINE"
   myGetRegKey = HKEY_LOCAL_MACHINE
Case "HKEY_PERFORMANCE_DATA"
   myGetRegKey = HKEY_PERFORMANCE_DATA
Case "HKEY_HKEY_USERS"
   myGetRegKey = HKEY_HKEY_USERS
Case Else
   myGetRegKey = 0
End Select

End Function

Public Function myGetWindowsDirectory() As String

Dim lpString As String
lpString = String(BufferString, 0)

GetWindowsDirectory lpString, BufferString

myGetWindowsDirectory = Left(lpString, InStr(lpString, Chr(0)) - 1)

End Function

Public Function WritePrivateProfileVal(ByVal lpApplicationName As String, ByVal lpKeyName As String, ByVal lpVal As Variant, ByVal lpFileName As String) As Variant

summyL = WritePrivateProfileString(lpApplicationName, lpKeyName, CStr(lpVal), lpFileName)
WritePrivateProfileVal = lpVal

End Function

Public Function myGetPrivateProfileSection(ByVal lpApplicationName As String, ByVal lpFileName As String, Optional ByVal nSize As Long = 4096) As String

Dim IniBuffer As String

IniBuffer = String(nSize, Chr(0))

summy = GetPrivateProfileSection(lpApplicationName, IniBuffer, nSize, lpFileName)
myGetPrivateProfileSection = StrConv(MidB(StrConv(IniBuffer, vbFromUnicode), 1, summy), vbUnicode)

End Function

Public Function myGetPrivateProFileString(ByVal lpApplicationName As String, ByVal lpKeyName As String, Optional ByVal lpDefault As String, Optional ByVal lpFileName As String, Optional ByVal nSize As Long = 1024) As String

Dim IniBuffer As String

If IsMissing(lpDefault) Then
   lpDefault = ""
End If

IniBuffer = String(nSize, Chr(0))

summy = GetPrivateProfileString(lpApplicationName, lpKeyName, lpDefault, IniBuffer, nSize, lpFileName)

myGetPrivateProFileString = StrConv(MidB(StrConv(IniBuffer, vbFromUnicode), 1, summy), vbUnicode)

End Function

Public Function myGetPrivateProFileVal(ByVal lpApplicationName As String, ByVal lpKeyName As String, Optional ByVal lpValDefault, Optional ByVal lpFileName As String) As Variant

Dim tmpDefault As String
Dim lpSize As Long

If IsMissing(lpValDefault) Then
   tmpDefault = ""
Else
   tmpDefault = CStr(lpValDefault)
End If
lpSize = 32

tmpVal = myGetPrivateProFileString(lpApplicationName, lpKeyName, tmpDefault, lpFileName, lpSize)

If tmpVal = "" Then
   myGetPrivateProFileVal = Empty
Else
   myGetPrivateProFileVal = Val(tmpVal)
End If

End Function

Public Function myGetPrivateProFileDate(ByVal lpApplicationName As String, ByVal lpKeyName As String, Optional ByVal lpDateDefault, Optional ByVal lpFileName As String) As Date

Dim tmpDefault As String
Dim lpSize As Long

If IsMissing(lpDateDefault) Then
   lpDateDefault = Now
End If
lpSize = 32

tmpDefault = CStr(lpDateDefault)
tmpVal = myGetPrivateProFileString(lpApplicationName, lpKeyName, tmpDefault, lpFileName, lpSize)
If tmpVal = "" Then
   myGetPrivateProFileDate = Empty
Else
   myGetPrivateProFileDate = CDate(tmpVal)
End If

End Function

Public Function myMutiLineGetPrivateProfileSection(ByVal lpApplicationName As String, ByVal lpFileName As String, Optional ByVal nSize As Long = 16384, Optional ByVal wFlags As enu_PrivateProfile = Default)

Dim IniBuffer As String
ReDim tmpStr(1 To 1)
Dim NoSpace As Boolean, NoCommon As Boolean

IniBuffer = String(nSize, Chr(0))

summy = GetPrivateProfileSection(lpApplicationName, IniBuffer, nSize, lpFileName)
tmpMutiLine = StrConv(MidB(StrConv(IniBuffer, vbFromUnicode), 1, summy), vbUnicode)

If tmpMutiLine = "" Then
   tmpStr(1) = ""
   myMutiLineGetPrivateProfileSection = tmpStr
   Exit Function
End If

i = 1
TotalLine = 0
Do
   tmpLoc = InStr(i, tmpMutiLine, Chr(0))
   If tmpLoc <> 0 Then
      TotalLine = TotalLine + 1
      ReDim Preserve tmpStr(1 To TotalLine)
      
      tmpStr(TotalLine) = Mid(tmpMutiLine, i, tmpLoc - i)
      i = tmpLoc + 1
   Else
      Exit Do
   End If
Loop

If wFlags > Default Then
   tBin = Binary(wFlags)
   NoCommon = CBool(Right(tBin, 1))
   NoSpace = CBool(Mid(tBin, Len(tBin) - 1, 1))
   
   For i = TotalLine To 1 Step -1
      If NoCommon Then
         summy = InStr(LCase(tmpStr(i)), "rem ") Or InStr(LCase(tmpStr(i)), "' ")
         If summy > 0 Then
            tmpStr(i) = Mid(tmpStr(i), 1, summy - 1)
         End If
      End If
      If NoSpace And Trim(tmpStr(i)) = "" Then
         MySwap tmpStr(i), tmpStr(TotalLine)
         TotalLine = TotalLine - 1
      End If
   Next i
   
   ReDim Preserve tmpStr(1 To TotalLine)
End If

myMutiLineGetPrivateProfileSection = tmpStr

End Function

Public Function myGetPrivateProfileSectionEx(ByVal lpApplicationName As String, ByVal lpFileName As String) As String

IniBuffer = myGetPrivateProFileAll(lpFileName)

lpApplicationName = "[" + lpApplicationName + "]" + vbNewLine

tLoc = InStr(1, IniBuffer, lpApplicationName, 1)
If tLoc = 0 Then
   myGetPrivateProfileSectionEx = ""
   Exit Function
End If

tLoc = tLoc + Len(lpApplicationName)
tEnd = InStr(tLoc - Len(vbNewLine), IniBuffer, vbNewLine + "[")

If tEnd = 0 Then
   myGetPrivateProfileSectionEx = Mid(IniBuffer, tLoc)
Else
   myGetPrivateProfileSectionEx = Mid(IniBuffer, tLoc, tEnd - tLoc)
End If

End Function

Public Function myMutiLineGetPrivateProfileSectionEx(ByVal lpApplicationName As String, ByVal lpFileName As String, Optional ByVal wFlags As enu_PrivateProfile = Default)

ReDim tmpStr(1 To 1)

tmpMutiLine = myGetPrivateProfileSectionEx(lpApplicationName, lpFileName)

i = 1
TotalLine = 0
Do
   tmpLoc = InStr(i, tmpMutiLine, vbNewLine)
   If tmpLoc <> 0 Then
      TotalLine = TotalLine + 1
      ReDim Preserve tmpStr(1 To TotalLine)
      
      tmpStr(TotalLine) = Mid(tmpMutiLine, i, tmpLoc - i)
      i = tmpLoc + Len(vbNewLine)
   Else
      Exit Do
   End If
Loop

If wFlags > Default Then
   For i = TotalLine To 1 Step -1
      If (wFlags And No_Common) Then
         summy = InStr(1, tmpStr(i), "rem ", vbTextCompare) Or InStr(tmpStr(i), "' ")
         If summy > 0 Then
            tmpStr(i) = Mid(tmpStr(i), 1, summy - 1)
         End If
      End If
      If (wFlags And No_NullSpace) And Trim(tmpStr(i)) = "" Then
         MySwap tmpStr(i), tmpStr(TotalLine)
         TotalLine = TotalLine - 1
      End If
   Next i
   
   ReDim Preserve tmpStr(1 To TotalLine)
End If

myMutiLineGetPrivateProfileSectionEx = tmpStr

End Function

Public Function myGetPrivateProFileStringEx(ByVal lpApplicationName As String, ByVal lpKeyName As String, Optional ByVal lpDefault As String, Optional ByVal lpFileName As String) As String

myGetPrivateProFileStringEx = lpDefault

lpKeyName = vbNewLine + lpKeyName + "="

tSection = myGetPrivateProfileSectionEx(lpApplicationName, lpFileName)

tLoc = InStr(1, tSection, lpKeyName, 1)
If tLoc = 0 Then
   Exit Function
End If

tLoc = tLoc + Len(lpKeyName)
tEnd = InStr(tLoc, tSection, vbNewLine)

If tEnd = 0 Then
   tSection = Mid(tSection, tLoc)
Else
   tSection = Mid(tSection, tLoc, tEnd - tLoc)
End If

myGetPrivateProFileStringEx = tSection

End Function

Public Function myGetPrivateProFileValEx(ByVal lpApplicationName As String, ByVal lpKeyName As String, Optional ByVal lpValDefault, Optional ByVal lpFileName As String) As Variant

Dim tmpDefault As String

myGetPrivateProFileValEx = lpValDefault
tVal = myGetPrivateProFileStringEx(lpApplicationName, lpKeyName, "", lpFileName)

If tVal <> "" Then
   myGetPrivateProFileValEx = Val(tVal)
End If

End Function

Public Function StrGetPrivateProfileSection(ByVal lpApplicationName As String, lpIniFile)
   Dim nlLen As Long, tLoc As Long, tEnd As Long, tStart As Long
   Dim tIniFile As String
   
   tIniFile = vbNewLine + lpIniFile
   lpApplicationName = "[" + lpApplicationName + "]" + vbNewLine
   nlLen = Len(vbNewLine)
   
   tStart = InStr(LCase(tIniFile), LCase(lpApplicationName))
   If tStart = 0 Then
      StrGetPrivateProfileSection = ""
      Exit Function
   End If
   
   tLoc = tStart + Len(lpApplicationName)
   tEnd = InStr(tLoc - nlLen, tIniFile, vbNewLine + "[")
   
   If tEnd = 0 Then
      StrGetPrivateProfileSection = Mid(tIniFile, tLoc)
   Else
      StrGetPrivateProfileSection = Mid(tIniFile, tLoc, tEnd - tLoc)
   End If
End Function

Public Function StrMutiLineGetPrivateProfileSection(ByVal lpApplicationName As String, lpIniFile, Optional ByVal wFlags As enu_PrivateProfile = Default)
   StrMutiLineGetPrivateProfileSection = StrMultiLineGetPrivateProfileSection(lpApplicationName, lpIniFile, wFlags)
End Function

Public Function StrMultiLineGetPrivateProfileSection(ByVal lpApplicationName As String, lpIniFile, Optional ByVal wFlags As enu_PrivateProfile = Default)
   ReDim tmpStr(0)
   
   tmpMultiLine = StrGetPrivateProfileSection(lpApplicationName, lpIniFile)
   
   i = 1
   TotalLine = 0
   Do
      tmpLoc = InStr(i, tmpMultiLine, vbNewLine)
      If tmpLoc <> 0 Then
         TotalLine = TotalLine + 1
         ReDim Preserve tmpStr(TotalLine - 1)
         
         tmpStr(TotalLine - 1) = Mid(tmpMultiLine, i, tmpLoc - i)
         i = tmpLoc + Len(vbNewLine)
      Else
         Exit Do
      End If
   Loop
   
   If wFlags > 0 Then
      For i = TotalLine - 1 To 0 Step -1
         If (wFlags And No_Common) Then
            summy = InStr(1, tmpStr(i), "rem ", vbTextCompare) Or InStr(tmpStr(i), "' ")
            If summy > 0 Then
               tmpStr(i) = Mid(tmpStr(i), 1, summy - 1)
            End If
         End If
         If (wFlags And No_NullSpace) And Trim(tmpStr(i)) = "" Then
            MySwap tmpStr(i), tmpStr(TotalLine - 1)
            TotalLine = TotalLine - 1
         End If
      Next
      
      ReDim Preserve tmpStr(TotalLine - 1)
   End If
   
   If TotalLine > 0 Then
      StrMultiLineGetPrivateProfileSection = tmpStr
   Else
      StrMultiLineGetPrivateProfileSection = Empty
   End If
End Function

Public Function StrGetPrivateProFileString(ByVal lpApplicationName As String, ByVal lpKeyName As String, Optional ByVal lpDefault As String, Optional ByVal lpIniFile As String) As String

StrGetPrivateProFileString = lpDefault

lpKeyName = vbNewLine + lpKeyName + "="

tSection = StrGetPrivateProfileSection(lpApplicationName, lpIniFile)

tLoc = InStr(1, tSection, lpKeyName, 1)
If tLoc = 0 Then
   Exit Function
End If

tLoc = tLoc + Len(lpKeyName)
tEnd = InStr(tLoc, tSection, vbNewLine)

If tEnd = 0 Then
   tSection = Mid(tSection, tLoc)
Else
   tSection = Mid(tSection, tLoc, tEnd - tLoc)
End If

StrGetPrivateProFileString = tSection

End Function

Public Function StrGetPrivateProFileVal(ByVal lpApplicationName As String, ByVal lpKeyName As String, Optional ByVal lpValDefault, Optional ByVal lpIniFile As String) As Variant

Dim tmpDefault As String

StrGetPrivateProFileVal = lpValDefault
tVal = StrGetPrivateProFileString(lpApplicationName, lpKeyName, "", lpIniFile)

If tVal <> "" Then
   StrGetPrivateProFileVal = Val(tVal)
End If

End Function

Public Function myGetPrivateProFileAll(ByVal lpFileName As String) As String

Dim IniBuffer As String

FLen = FileLen(lpFileName)
IniBuffer = String(FLen, Chr(0))

hFile = FreeFile
Open lpFileName For Binary As hFile
Get #hFile, 1, IniBuffer
Close hFile

IniBuffer = StrConv(LeftB(StrConv(IniBuffer, vbFromUnicode), FLen), vbUnicode)

myGetPrivateProFileAll = IniBuffer

End Function