Attribute VB_Name = "International"
Option Explicit

Private Declare Function GetSystemDefaultLCID Lib "Kernel32" () As Long

Private Declare Function lstrlenW Lib "Kernel32" (lpString As Any) As Long
Private Declare Function WideCharToMultiByte Lib "Kernel32" (ByVal codepage As Long, ByVal dwFlags As Long, lpWideCharStr As Any, ByVal cchWideChar As Long, lpMultiByteStr As Any, ByVal cchMultiByte As Long, ByVal lpDefaultChar As String, ByRef lpUsedDefaultChar As Long) As Long

' Returns the string up to the first Null Char
Private Function GetStrFromANSIBuffer(sBuf As Variant) As Variant
    If InStr(sBuf, Chr(&H0)) > 0 Then
        GetStrFromANSIBuffer = Left(sBuf, InStr(sBuf, Chr(&H0)) - 1)
    Else
        GetStrFromANSIBuffer = sBuf ' no null, so don't worry about it
    End If
End Function

' Return ANSI string from a pointer to a Unicode string.
Private Function GetStrFromPtrW(ByVal lpszW As Long, ByVal al_CodePage As Long, ByRef lpUsedDefaultChar) As Variant
    Dim sRV As String
    Dim llReturn As Long
    
    sRV = String$(lstrlenW(ByVal lpszW), Chr(&H0))  ' 2 bytes/char
     
    ' copy from Unicode string into new buffer
    WideCharToMultiByte al_CodePage, 1024, ByVal lpszW, -1, ByVal sRV, Len(sRV), Chr(&H0), lpUsedDefaultChar
    GetStrFromPtrW = GetStrFromANSIBuffer(sRV)
End Function

' Return ANSI string from a pointer to a Unicode string.
Private Function GetBoolFromPtrW(lpszW As Long, ByVal al_CodePage As Long) As Boolean
Dim ll_UsedDefaultChar
         
    GetBoolFromPtrW = False
    
    GetStrFromPtrW lpszW, al_CodePage, ll_UsedDefaultChar
    If ll_UsedDefaultChar = 0 Then
        GetBoolFromPtrW = True
    End If

End Function

'convert code page into charset integer
Public Function GetCharSetFromCodePage(ByVal al_CodePage As Long) As Long

    On Error GoTo Trace_Err

    Select Case CStr(al_CodePage)
        Case 932 ' Japanese
            GetCharSetFromCodePage = 128
        Case 936 ' Simplified Chinese
            GetCharSetFromCodePage = 134
        Case 949 ' Korean
            GetCharSetFromCodePage = 129
        Case 950 ' Traditional Chinese
            GetCharSetFromCodePage = 136
        Case 1250 ' Eastern Europe
            GetCharSetFromCodePage = 238
        Case 1251 ' Russian
            GetCharSetFromCodePage = 204
        Case 1252 ' Western European Languages
            GetCharSetFromCodePage = 0
        Case 1253 ' Greek
            GetCharSetFromCodePage = 161
        Case 1254 ' Turkish
            GetCharSetFromCodePage = 162
        Case 1255 ' Hebrew
            GetCharSetFromCodePage = 177
        Case 1256 ' Arabic
            GetCharSetFromCodePage = 178
        Case 1257 ' Baltic
            GetCharSetFromCodePage = 186
        Case Else
            GetCharSetFromCodePage = 0
    End Select
    
    Exit Function
    
Trace_Err:
End Function

Public Function GetCodePageFromLCID(ByVal al_LCID As Long) As Long

    On Error GoTo Trace_Err

    Select Case al_LCID
        Case 1041 ' Japanese
            GetCodePageFromLCID = 932
        Case 2052 ' Simplified Chinese
            GetCodePageFromLCID = 936
        Case 1042 ' Korean
            GetCodePageFromLCID = 949
        Case 1028 ' Traditional Chinese
            GetCodePageFromLCID = 950
        Case 1045 ' Eastern Europe
            GetCodePageFromLCID = 1250
        Case 1049 ' Russian
            GetCodePageFromLCID = 1251
        Case 1033 ' Western European Languages
            GetCodePageFromLCID = 1252
        Case 1032 ' Greek
            GetCodePageFromLCID = 1253
        Case 1055 ' Turkish
            GetCodePageFromLCID = 1254
        Case 1037 ' Hebrew
            GetCodePageFromLCID = 1255
        Case 1025 ' Arabic
            GetCodePageFromLCID = 1256
        Case 1061 ' Baltic
            GetCodePageFromLCID = 1257
        Case Else
            GetCodePageFromLCID = 1252
    End Select
    
    Exit Function
    
Trace_Err:
End Function

Public Function GetLCIDFromCodePage(ByVal al_CodePage As Long) As Long

    On Error GoTo Trace_Err

    Select Case al_CodePage
        Case 932 ' Japanese
            GetLCIDFromCodePage = 1041
        Case 936 ' Simplified Chinese
            GetLCIDFromCodePage = 2052
        Case 949 ' Korean
            GetLCIDFromCodePage = 1042
        Case 950 ' Traditional Chinese
            GetLCIDFromCodePage = 1028
        Case 1250 ' Eastern Europe
            GetLCIDFromCodePage = 1045
        Case 1251  ' Russian
            GetLCIDFromCodePage = 1049
        Case 1252  ' Western European Languages
            GetLCIDFromCodePage = 1033
        Case 1253 ' Greek
            GetLCIDFromCodePage = 1032
        Case 1254 ' Turkish
            GetLCIDFromCodePage = 1055
        Case 1255 ' Hebrew
            GetLCIDFromCodePage = 1037
        Case 1256 ' Arabic
            GetLCIDFromCodePage = 1025
        Case 1257 ' Baltic
            GetLCIDFromCodePage = 1061
        Case Else
            GetLCIDFromCodePage = 1033
    End Select
    
    Exit Function
    
Trace_Err:
End Function

Public Function DetectCodePageFromUnicode(ByVal av_String As Variant) As Long

    If GetBoolFromPtrW(StrPtr(av_String), 1252) Then
        DetectCodePageFromUnicode = 1252
        Exit Function
    End If
    If GetBoolFromPtrW(StrPtr(av_String), 1250) Then
        DetectCodePageFromUnicode = 1250
        Exit Function
    End If
    If GetBoolFromPtrW(StrPtr(av_String), 1251) Then
        DetectCodePageFromUnicode = 1251
        Exit Function
    End If
    If GetBoolFromPtrW(StrPtr(av_String), 1253) Then
        DetectCodePageFromUnicode = 1253
        Exit Function
    End If
    If GetBoolFromPtrW(StrPtr(av_String), 1254) Then
        DetectCodePageFromUnicode = 1254
        Exit Function
    End If
    If GetBoolFromPtrW(StrPtr(av_String), 1255) Then
        DetectCodePageFromUnicode = 1255
        Exit Function
    End If
    If GetBoolFromPtrW(StrPtr(av_String), 1256) Then
        DetectCodePageFromUnicode = 1256
        Exit Function
    End If
    If GetBoolFromPtrW(StrPtr(av_String), 1257) Then
        DetectCodePageFromUnicode = 1257
        Exit Function
    End If
    
    DetectCodePageFromUnicode = 1252
    
End Function

Public Function ConvertCodePageFromUnicode(ByVal av_String As Variant, al_CodePage As Long) As Variant
Dim ll_UsedCodePage As Long

    ConvertCodePageFromUnicode = GetStrFromPtrW(StrPtr(av_String), al_CodePage, ll_UsedCodePage)
    
End Function

Public Function ConvertCodePageFromAnsi(ByVal av_String As Variant, al_CodePage As Long) As Variant
Dim ll_UsedCodePage As Long

    ConvertCodePageFromAnsi = StrConv(StrConv(av_String, vbFromUnicode, 1033), vbUnicode, GetLCIDFromCodePage(al_CodePage))
    
End Function

Public Function UCaseInternational(ByVal av_Text As Variant, ByVal al_CodePage As Long) As Variant

    UCaseInternational = ConvertCodePageFromUnicode(UCase(ConvertCodePageFromAnsi(av_Text, al_CodePage)), al_CodePage)

End Function

Public Function LCaseInternational(ByVal av_Text As Variant, ByVal al_CodePage As Long) As Variant

    LCaseInternational = ConvertCodePageFromUnicode(LCase(ConvertCodePageFromAnsi(av_Text, al_CodePage)), al_CodePage)

End Function


