registry.bas

此文件为OPC client VBTend 源代码,在VB开发环境下调试运行

Attribute VB_Name = "Module2"
'///////////////////////////////////////////////////////////////////////////
'
'  OPC Trend VB Client: registry.bas
'                       (Source File)
'
'///////////////////////////////////////////////////////////////////////////
'
'          Author: Raphael Imhof
'    Initial Date: 11/04/98
'       $Workfile: REGISTRY.bas $
'       $Revision: 1 $
'           $Date: 7/27/99 5:13p $
'   Target System: Microsoft Windows NT 4.0
'     Environment: Visual Basic 6.0 / OPC DataAccess 2.0
'         Remarks:
'
'///////////////////////////////////////////////////////////////////////////
'
'     Description: implementation of the registry (WIN32 API) module
'
'
'///////////////////////////////////////////////////////////////////////////
'
'  History of Changes     (Please remove very old comments and blank lines!)
'            $Log: /IDK/OPCServer/clients/VB/Trend/REGISTRY.bas $
' 
' 1     7/27/99 5:13p Imhof
' 
' 1     7/27/99 4:37p Imhof
' 
' 5     5/07/99 4:25p Imhof
' Made negative time offset negative
'
' 4     5/08/99 5:13a Imhof
' Corrected negative timezone offset problem.
'
' 3     1/20/99 3:09p Imhof
' Header: updated log
'
'
'  $Nokeywords:$ (To avoid useless search while checking in.)
'///////////////////////////////////////////////////////////////////////////
'  Copyright (C) 1999, Siemens Building Technologies, Inc. Landis Division
'
'  SIEMENS BUILDING TECHNOLOGIES, INC. IS PROVIDING THE FOLLOWING EXAMPLES
'  OF CODE AS SAMPLE ONLY.
'  SIEMENS BUILDING TECHNOLOGIES, INC. MAKES NO REPRESENTATIONS OR WARRANTIES
'  OF ANY KIND WITH RESPECT TO THE VALIDTY OF THE CODES OR DESIRED RESULTS
'  AND DISCLAIMS ALL SUCH REPRESENTATIONS AND WARRANTIES, INCLUDING FOR EXAMPLE,
'  WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
'  SIEMENS BUILIDNG TECHNOLOGIES, INC. DOES NOT REPRESENT OR WARRANT THAT
'  THE FOLLOWING CODE SAMPLES ARE ACCURATE, VALID, COMPLETE OR CURRENT.
'
'///////////////////////////////////////////////////////////////////////////

Option Explicit

Option Base 1
Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
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
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
Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcbValueName As Long, lpReserved As Long, lpType As Long, lpData As Byte, lpcbData As Long) As Long
Declare Function RegLoadKey Lib "advapi32.dll" Alias "RegLoadKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal lpFile As String) As Long
Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_DYN_DATA = &H80000006
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_USERS = &H80000003
Public Const KEY_QUERY_VALUE = &H1
Public Const ERROR_NO_MORE_ITEMS = 259&
Public Const REG_BINARY = 3
Public Const REG_DWORD = 4
Public Const REG_DWORD_BIG_ENDIAN = 5
Public Const REG_DWORD_LITTLE_ENDIAN = 4
Public Const REG_EXPAND_SZ = 2
Public Const REG_LINK = 6
Public Const REG_MULTI_SZ = 7
Public Const REG_NONE = 0
Public Const REG_SZ = 1
Public Const REG_RESOURCE_LIST = 8
Public Const REG_FULL_RESOURCE_DESCRIPTOR = 9

' returns the difference between UTC and local time zone in minutes
Public Function GetTimeBias() As Long
    ' should be able to retrieve the timezone from the system
    ' current way: integrate the Win32 API registry calls
    ' and get the value out of the registry
    ' Note: the registry key needs probably be changed for Win95/98
    
    Dim lHandle As Long
    Dim Data As String
    Dim nBufferSize As Long
    Dim nType As Long 'assume DWORD
    Dim offset As Long
    nBufferSize = 4
    
    offset = 6 * 60 'default: CST
    
    Data = Space(nBufferSize)
 
    If RegOpenKey(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control\TimeZoneInformation", lHandle) = 0 Then
       If RegQueryValueEx(lHandle, ByVal "ActiveTimeBias", 0&, nType, ByVal Data, nBufferSize) = 0 Then
            If Asc(Mid$(Data, 4, 1)) = 255 Then '0xFF => neg timeoffset
                offset = -1 * (1 + ((255 - Asc(Mid$(Data, 1, 1))) + &H100& * (255 - Asc(Mid$(Data, 2, 1))) + &H10000 * (255 - Asc(Mid$(Data, 3, 1))) + &H1000000 * (255 - CDbl(Asc(Mid$(Data, 4, 1))))))
            Else
                offset = Asc(Mid$(Data, 1, 1)) + &H100& * Asc(Mid$(Data, 2, 1)) + &H10000 * Asc(Mid$(Data, 3, 1)) + &H1000000 * CDbl(Asc(Mid$(Data, 4, 1)))
            End If
       End If
    RegCloseKey (lHandle)
    End If
    
    GetTimeBias = offset
    Exit Function
    
End Function