Override regional settings in VB6

Posted on 2006-05-08
Last Modified: 2011-10-03
Need functions such as CDate etc to use Regional settings other than those in the current locale settings but I don't want to change the system settings.

i.e. Date seperator on the local pc is "." (Germany) but I want the VB code to use "/" (English) as the date seperator.

While other languages (, Delphi) will allow the locale settings to be overwritten within tha application I can't find any method to do this in VB6.

Note: While aware of how to read and change the system regional settings within VB6 I only want to change them for this specific applications, I don't want to affect other applications running on this PC.  

Question by:DeclanFee
    LVL 9

    Expert Comment

    you can simply use the following line to get english date

    strEngDate = Format(Date, "dd/mm/yyyy")

    To get Time as you wish

    strCurTime = Format(Time,"hh:mm:ss")

    thats all.
    It won't affect the system settings and other applications.

    Author Comment

    pradapkumar, Thanks for the comment, unfortunately my problem is a bit more complex than this. I have the source code for a large 3rd party app that I need to run on both german and English locale PCs. The app passes data in XML format to components on a shared server (English locale). The local client PC also read default values from config files which have all values in English locale date and numeric format such as "9,999,999.99" as opposed to German format "9.999.999,99"   -  I want to avoid significant redevelopment work. I'm happy to force users on both locales to enter data in English format ( "." as decimal seperator,  "," as thousand seperator etc.) but I need to force the locale aware functions in VB to use "," as the thousand seperator, "." as the decimal seperator and "/" as the date seperator despite the system locale settings being different.

    Perhaps this isn't possible in VB6 in which case I'd have to persue other options.

    LVL 22

    Expert Comment

    You can do this in your app using following code. It relies heavily on API and you can use any supported Locale(LCID) you want:

    The formatting code is in class Locale.cls where you set the Locale(LCID) and then format your numbers, dates, etc. using a user specified LCID independent of the Regional Settings.

    If you need help with any of this let me know.
    LVL 22

    Accepted Solution

    To read config files in your app and ensure correct numeric and date vars you will also need to use code something like this(Function  ResolveDate and  Function ResolveNumber):

    Option Explicit

    Public Enum DateOrderEnum
       doDefault 'Your locale setting
       doMDY     'Month-Day-Year (U.S.)
       doDMY     'Day-Month-Year (EU, S.A.)
       doYMD     'Year-Month-Day (Japan)
    End Enum

    Public Const LOCALE_SSHORTDATE As Long = &H1F
    Public Const LOCALE_STHOUSAND As Long = &HF
    Public Const LOCALE_SDECIMAL  As Long = &HE

    Public Declare Function GetUserDefaultLCID Lib "kernel32" () As Long
    Public Declare Function GetSystemDefaultLCID Lib "kernel32" () As Long
    Public Declare Function GetLocaleInfoA Lib "kernel32" (ByVal Locale As Long, ByVal LCType As Long, ByVal lpLCData As String, ByVal cchData As Long) As Long

    Public Function GetThousandsSep() As String
       GetThousandsSep = pfGLI(GetUserDefaultLCID(), LOCALE_STHOUSAND)
    End Function

    Public Function GetDecimalSep() As String
       GetDecimalSep = pfGLI(GetUserDefaultLCID(), LOCALE_SDECIMAL)
    End Function

    'Purpose: Assume a date string with English separator "1/4/2006"
    'Returns: Correct Date Variable
    Public Function ResolveDate(ByVal sDate As String) As Date
       Dim sArray() As String
       If InStr(sDate, "/") Then 'Potentially a date string
          sArray = Split(sDate, "/")
          Debug.Print "GetUserDefaultLCID", GetUserDefaultLCID
          Debug.Print "GetSystemDefaultLCID", GetSystemDefaultLCID
          If UBound(sArray) = 2 Then 'We have 3 parts
             Select Case ShortDateOrder2
                Case doMDY '
                   ResolveDate = DateSerial(sArray(2), sArray(0), sArray(1))
                Case doDMY
                   ResolveDate = DateSerial(sArray(2), sArray(1), sArray(0))
                Case doYMD
                   ResolveDate = DateSerial(sArray(0), sArray(1), sArray(2))
             End Select
          End If
       End If
    End Function

    'Purpose: Assume a number string with English separators "123,456.78"
    'Returns: Correct Double Variable
    Public Function ResolveNumber(ByVal sNum As String) As Double
       Dim sTS As String
       Dim sDS As String
       sTS = GetThousandsSep
       sDS = GetDecimalSep
       If (sTS = ",") And (sDS = ".") Then 'English
          'format is OK
          Dim i As Long
          Dim sMid As String
          For i = 1 To Len(sNum)
             Select Case Mid(sNum, i, 1)
                Case ","
                   Mid(sNum, i, 1) = sTS
                Case "."
                   Mid(sNum, i, 1) = sDS
             End Select
       End If
       ResolveNumber = CDbl(sNum)
    End Function

    Public Function ShortDateOrder2() As DateOrderEnum
       'Get ShortDateOrder the hard way
       Dim sShort           As String
       Dim qOn              As Boolean
       Dim i                As Integer
       Dim sChar            As String

       On Error Resume Next

       'Get the Short Date format
       sShort = pfGLI(GetUserDefaultLCID(), LOCALE_SSHORTDATE)

       For i = 1 To Len(sShort)
          sChar = Mid(sShort, i, 1)
          'Ignore items in single quotes (if any)
          If sChar = "'" Then
             qOn = Not qOn
             If Not qOn Then
                Select Case sChar
                   Case "d"
                      ShortDateOrder2 = doDMY
                      Exit Function
                   Case "m"
                      ShortDateOrder2 = doMDY
                      Exit Function
                   Case "y"
                      ShortDateOrder2 = doYMD
                      Exit Function
                End Select
             End If
          End If
    End Function

    Private Function pfGLI(ByVal m_LocaleLCID As Long, ByVal reqInfo As Long) As String
       Dim Buffer As String * 255
       GetLocaleInfoA m_LocaleLCID, reqInfo, Buffer, 255
       pfGLI = StripNull(Buffer)
    End Function

    Public Function StripNull(ByVal StrIn As String) As String
       Dim nul              As Long
       nul = InStr(StrIn, vbNullChar)
       Select Case nul
          Case Is > 1
             StripNull = Left$(StrIn, nul - 1)
          Case 1
             StripNull = ""
          Case 0
             StripNull = Trim$(StrIn)
       End Select
    End Function


    Author Comment

    Danaseaman, thanks for your post, looks like exactly what I need to resolve my problem. Will review code fully and get back to you later today. Thanks

    Write Comment

    Please enter a first name

    Please enter a last name

    We will never share this with anyone.

    Featured Post

    IT, Stop Being Called Into Every Meeting

    Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

    Introduction This article makes the case for using two modules in your VBA/VB6 applications to provide both case-sensitive and case-insensitive text comparison operations.  Recently, I solved an EE question using the LIKE function.  In order for th…
    If you have ever used Microsoft Word then you know that it has a good spell checker and it may have occurred to you that the ability to check spelling might be a nice piece of functionality to add to certain applications of yours. Well the code that…
    As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
    Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

    779 members asked questions and received personalized solutions in the past 7 days.

    Join the community of 500,000 technology professionals and ask your questions.

    Join & Ask a Question

    Need Help in Real-Time?

    Connect with top rated Experts

    12 Experts available now in Live!

    Get 1:1 Help Now