VERIFICAR A DATA DO SISTEMA

Private Sub Form_Load()
    lblDate.Caption = Format(Now, "dd/mm/yyyy") ' Retorna na label a data do systema
End Sub

Global Const HKEY_CLASSES_ROOT = &H80000000
Global Const HKEY_CURRENT_USER = &H80000001
Global Const HKEY_LOCAL_MACHINE = &H80000002
Global Const HKEY_USERS = &H80000003
Global Const HKEY_PERFORMANCE_DATA = &H80000004
Global Const HKEY_CURRENT_CONFIG = &H80000005
Global Const HKEY_DYN_DATA = &H80000006

Global Const KEY_ALL_ACCESS = &H3F
Global Const ERROR_NO_MORE_ITEMS = 259
Global Const REG_SZ = 1

Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long

Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As Long) As Long
Declare Function RegSetValueEx Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal cbData As Long) As Long         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, ByVal cbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As String, ByVal cbData As Long) As Long


Sub Main()
    r = Arrumar_Registros_Windows(".Default\Control Panel\International", "sShortDate", "dd/MM/yyyy", True)
    r = Arrumar_Registros_Windows(".Default\Control Panel\International", "iNegCurr", "2", Not r)
end sub

Function Arrumar_Registros_Windows(Chave As String, Campo As String, Valor As String, ComMensagem As Boolean) As Boolean

    Dim lRet As Long, hKey As Long
    Dim lIndex As Long, aVName$, lVName As Long, lType As Long, aData$, lData As Long
    Dim Achei As Boolean
    
    Arrumar_Registros_Windows = False
    
    lRet = RegOpenKeyEx(HKEY_USERS, Chave, 0, KEY_ALL_ACCESS, hKey)
    If lRet Then Exit Function
    
    Achei = False
    lVName = 100                ' Name buffer length
    aVName$ = Space$(lVName)    ' Name buffer
    lData = 100                 ' Data buffer length
    aData$ = Space$(lData)      ' Data buffer
    lRet = RegEnumValue(hKey, lIndex, aVName$, lVName, 0, lType, aData$, lData)

    Do Until lRet = ERROR_NO_MORE_ITEMS
        If InStr(aVName$, Campo) > 0 Then
            If UCase(Left(aData$, InStr(aData$, Chr(0)) - 1)) = UCase(Valor) Then
                Achei = True
                Exit Do
            Else
                'como achei mas com formato errado, cai fora e arruma
                Exit Do
            End If
        End If
        lVName = 100        ' You MUST reset these buffer lengths, because the RegEnumValue call
        lData = 100         ' changed them to = # of bytes copied
        lIndex = lIndex + 1
        lRet = RegEnumValue(hKey, lIndex, aVName$, lVName, 0, lType, aData$, lData)
    Loop
        
    If Not Achei Then
        lRet = RegSetValueEx(hKey, Campo, 0&, REG_SZ, ByVal Valor, LenB(StrConv(Valor, vbFromUnicode)) + 1)
        If ComMensagem Then MsgBox msgRegWinData & Chr(10) & msgRegWinCorrigeData, vbInformation
        Arrumar_Registros_Windows = True
    End If
    lRet = RegCloseKey(hKey)

End Function