MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração


Participe do fórum, é rápido e fácil

MaximoAccess

Caro Usuário, antes de postar pela primeira vez, leia as regras do fórum.

https://www.maximoaccess.com/t48-regras-do-forum

Obrigado

Administração

MaximoAccess

Gostaria de reagir a esta mensagem? Crie uma conta em poucos cliques ou inicie sessão para continuar.

Dicas Ms Access, Exemplos Ms Access, Codigos VBA Ms Access, SQL Ms Access


    [Resolvido]Alterando o Fuso horário do sistema via VBA

    avatar
    Convidado
    Convidado


    [Resolvido]Alterando o Fuso horário do sistema via VBA Empty Alterando o Fuso horário do sistema via VBA

    Mensagem  Convidado 18/7/2011, 15:37

    tenho este código que carrega uma lista com os fusos do sistema...
    Ate ai esta tudo bem..

    Carrega os fusos na lista...

    Mas no dblClick da lista teria que alterar o fuso...

    Não está alterando.. se puderem me ajudar fico grato



    ***********************************************************************************


    Option Compare Database
    Private Declare Function SetSystemTime Lib "kernel32" (lpSystemTime As SYSTEMTIME) As Long

    ' Operating System version information declares

    Private Const VER_PLATFORM_WIN32_NT = 2
    Private Const VER_PLATFORM_WIN32_WINDOWS = 1

    Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128 ' Maintenance string
    End Type

    Private Declare Function GetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" (lpVersionInformation As OSVERSIONINFO) As Long

    ' Time Zone information declares

    Private Type SYSTEMTIME
    wYear As Integer
    wMonth As Integer
    wDayOfWeek As Integer
    wDay As Integer
    wHour As Integer
    wMinute As Integer
    wSecond As Integer
    wMilliseconds As Integer
    End Type

    Private Type REGTIMEZONEINFORMATION
    bias As Long
    StandardBias As Long
    DaylightBias As Long
    StandardDate As SYSTEMTIME
    DaylightDate As SYSTEMTIME
    End Type

    Private Type TIME_ZONE_INFORMATION
    bias As Long
    StandardName(0 To 63) As Byte ' used to accommodate Unicode strings
    StandardDate As SYSTEMTIME
    StandardBias As Long
    DaylightName(0 To 63) As Byte ' used to accommodate Unicode strings
    DaylightDate As SYSTEMTIME
    DaylightBias As Long
    End Type

    Private Const TIME_ZONE_ID_INVALID = &HFFFFFFFF
    Private Const TIME_ZONE_ID_UNKNOWN = 0
    Private Const TIME_ZONE_ID_STANDARD = 1
    Private Const TIME_ZONE_ID_DAYLIGHT = 2

    Private Declare Function GetTimeZoneInformation Lib "kernel32" _
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

    Private Declare Function SetTimeZoneInformation Lib "kernel32" _
    (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long

    ' Registry information declares
    Private Const REG_SZ As Long = 1
    Private Const REG_BINARY = 3
    Private Const REG_DWORD As Long = 4

    Private Const HKEY_CLASSES_ROOT = &H80000000
    Private Const HKEY_CURRENT_USER = &H80000001
    Private Const HKEY_LOCAL_MACHINE = &H80000002
    Private Const HKEY_USERS = &H80000003

    Private Const ERROR_SUCCESS = 0
    Private Const ERROR_BADDB = 1
    Private Const ERROR_BADKEY = 2
    Private Const ERROR_CANTOPEN = 3
    Private Const ERROR_CANTREAD = 4
    Private Const ERROR_CANTWRITE = 5
    Private Const ERROR_OUTOFMEMORY = 6
    Private Const ERROR_ARENA_TRASHED = 7
    Private Const ERROR_ACCESS_DENIED = 8
    Private Const ERROR_INVALID_PARAMETERS = 87
    Private Const ERROR_NO_MORE_ITEMS = 259

    Private Const KEY_ALL_ACCESS = &H3F

    Private Const REG_OPTION_NON_VOLATILE = 0

    Private 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

    Private Declare Function RegQueryValueEx Lib "advapi32.dll" _
    Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpszValueName As String, _
    ByVal lpdwReserved As Long, _
    lpdwType As Long, _
    lpData As Any, _
    lpcbData As Long) _
    As Long

    Private Declare Function RegQueryValueExString Lib "advapi32.dll" _
    Alias "RegQueryValueExA" ( _
    ByVal hKey As Long, _
    ByVal lpValueName As String, _
    ByVal lpReserved As Long, _
    lpType As Long, _
    ByVal lpData As String, _
    lpcbData As Long) _
    As Long

    Private Declare Function RegEnumKey Lib "advapi32.dll" _
    Alias "RegEnumKeyA" ( _
    ByVal hKey As Long, _
    ByVal dwIndex As Long, _
    ByVal lpName As String, _
    ByVal cbName As Long) _
    As Long

    Private Declare Function RegCloseKey Lib "advapi32.dll" ( _
    ByVal hKey As Long) _
    As Long

    ' Registry Constants
    Const SKEY_NT = "SOFTWARE\Microsoft\Windows NT\CurrentVersion\Time Zones"
    Const SKEY_9X = "SOFTWARE\Microsoft\Windows\CurrentVersion\Time Zones"

    ' The following declaration is different from the one in the API viewer.
    ' To disable implicit ANSI<->Unicode conversion, it changes the
    ' variable types of lpMultiByteStr and lpWideCharStr to Any.
    '
    Private Declare Function MultiByteToWideChar Lib "kernel32" ( _
    ByVal CodePage As Long, _
    ByVal dwFlags As Long, _
    lpMultiByteStr As Any, _
    ByVal cchMultiByte As Long, _
    lpWideCharStr As Any, _
    ByVal cchWideChar As Long) As Long

    ' The above Declare and the following Constants are used to make
    ' this sample compatible with Double Byte Character Systems (DBCS).
    Private Const CP_ACP = 0
    Private Const MB_PRECOMPOSED = &H1
    Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" ( _
    ByRef Destination As Any, _
    ByRef Source As Any, _
    ByVal numbytes As Long)
    Dim SubKey As String

    Sub CarregaFuso() 'Aqui aplico no comando ao carregar do form.. e preenche a lista com os fusos (List1)
    Dim lRetVal As Long, lResult As Long, lCurIdx As Long
    Dim lDataLen As Long, lValueLen As Long, hKeyResult As Long
    Dim strvalue As String
    Dim osV As OSVERSIONINFO

    ' Win9x and WinNT have a slightly different registry structure. Determine
    ' the operating system and set a module variable to the correct subkey.

    osV.dwOSVersionInfoSize = Len(osV)
    Call GetVersionEx(osV)
    If osV.dwPlatformId = VER_PLATFORM_WIN32_NT Then
    SubKey = SKEY_NT
    Else
    SubKey = SKEY_9X
    End If

    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey, 0, _
    KEY_ALL_ACCESS, hKeyResult)

    If lRetVal = ERROR_SUCCESS Then

    lCurIdx = 0
    lDataLen = 32
    lValueLen = 32

    Do
    strvalue = String(lValueLen, 0)
    lResult = RegEnumKey(hKeyResult, lCurIdx, strvalue, lDataLen)

    If lResult = ERROR_SUCCESS Then
    List1.AddItem Left(strvalue, lValueLen)
    End If

    lCurIdx = lCurIdx + 1

    Loop While lResult = ERROR_SUCCESS

    RegCloseKey hKeyResult
    Else
    List1.AddItem "Could not open registry key"
    End If
    End Sub




    Private Sub List1_DblClick(Cancel As Integer)
    Dim TZ As TIME_ZONE_INFORMATION, oldTZ As TIME_ZONE_INFORMATION
    Dim rTZI As REGTIMEZONEINFORMATION
    Dim bytDLTName(32) As Byte, bytSTDName(32) As Byte
    Dim cbStr As Long, dwType As Long
    Dim lRetVal As Long, hKeyResult As Long, lngData As Long

    lRetVal = RegOpenKeyEx(HKEY_LOCAL_MACHINE, SubKey & "\" & List1, _
    0, KEY_ALL_ACCESS, hKeyResult)

    If lRetVal = ERROR_SUCCESS Then
    lRetVal = RegQueryValueEx(hKeyResult, "TZI", 0&, ByVal 0&, _
    rTZI, Len(rTZI))


    If lRetVal = ERROR_SUCCESS Then
    TZ.bias = rTZI.bias
    TZ.StandardBias = rTZI.StandardBias
    TZ.DaylightBias = rTZI.DaylightBias
    TZ.StandardDate = rTZI.StandardDate
    TZ.DaylightDate = rTZI.DaylightDate

    cbStr = 32
    dwType = REG_SZ

    lRetVal = RegQueryValueEx(hKeyResult, "Std", _
    0&, dwType, bytSTDName(0), cbStr)

    If lRetVal = ERROR_SUCCESS Then
    Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, _
    bytSTDName(0), cbStr, TZ.StandardName(0), 32)
    Else
    RegCloseKey hKeyResult
    Exit Sub
    End If

    cbStr = 32
    dwType = REG_SZ

    lRetVal = RegQueryValueEx(hKeyResult, "Dlt", _
    0&, dwType, bytDLTName(0), cbStr)


    If lRetVal = ERROR_SUCCESS Then
    Call MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, _
    bytDLTName(0), cbStr, TZ.DaylightName(0), 32)
    Else
    RegCloseKey hKeyResult
    Exit Sub
    End If

    lRetVal = GetTimeZoneInformation(oldTZ)
    MsgBox lRetVal

    If lRetVal = TIME_ZONE_ID_INVALID Then
    MsgBox "Error getting original TimeZone Info"
    RegCloseKey hKeyResult
    Exit Sub
    Else
    If TZ.DaylightDate.wMonth <> 0 And TZ.DaylightBias <> 0 Then
    lRetVal = SetTimeZoneInformation(TZ)
    Else
    Call CopyMemory(TZ.DaylightName(0), TZ.StandardName(0), 64)
    TZ.DaylightBias = 0
    lRetVal = SetTimeZoneInformation(TZ)
    End If
    MsgBox "Time Zone Changed, Click OK to restore"
    'lRetVal = SetTimeZoneInformation(oldTZ)
    End If
    End If

    RegCloseKey hKeyResult

    End If
    End Su
    avatar
    Convidado
    Convidado


    [Resolvido]Alterando o Fuso horário do sistema via VBA Empty Re: [Resolvido]Alterando o Fuso horário do sistema via VBA

    Mensagem  Convidado 21/7/2011, 17:04

    Darei este tópico por resolvido, pois decidi não alterar o fuso do sistema via código, porém se alguem tiver uma solução pode postar que será bem vinda!

    Saudações

      Data/hora atual: 23/11/2024, 09:23