[AccessD] Registry tweaks

MartyConnelly martyconnelly at shaw.ca
Tue Dec 2 19:15:20 CST 2003


Well, if you are really stuck, I suppose this is the ultimate definition.

Free ISO 3166 country code- It lists name and 2 character code as csv, 
html  and xml files

These 2 character codes  will match with Federal Express IATA codes and 
IANA Internet ccTLD's Top Level Domains
and ISO 4217 Codes for the representation of currencies and funds

Heck there is even an Access 2000 mdb version for only the small sum of 
294 Swiss Francs
with additional sub region codes.

http://www.iso.org/iso/en/prods-services/iso3166ma/02iso-3166-code-lists/index.html

Charlotte Foust wrote:

>Don't blame Microsoft for the way area codes are allocated around the
>globe.  They don't have *quite* that much pull ... Yet. <VBG>  I ran
>into this issue years ago when I worked for a company that handled event
>registration and discovered that area codes and even country codes
>aren't quite the indicator of country that you might expect.
>
>Charlotte Foust
>
>-----Original Message-----
>From: MartyConnelly [mailto:martyconnelly at shaw.ca] 
>Sent: Tuesday, December 02, 2003 11:15 AM
>To: Access Developers discussion and problem solving
>Subject: Re: [AccessD] Registry tweaks
>
>
>Yes, I see what you mean. I didn't realize Guantanamo Bay was a seperate
>
>country.
>Recognized by the soverign state of Microsoft, no doubt ;)
>
>Charlotte Foust wrote:
>
>  
>
>>The one caution I would suggest here is that the country names are 
>>coming from a telephony key.  The problem is that there are separate 
>>"countries" which happen to be islands and which share an area code, so
>>    
>>
>
>  
>
>>some of those country names may not be entirely reliable.
>>
>>I always have to refresh my memory on callbacks as well, but it's 
>>perfectly possible to create a recordset entirely in memory using ADO 
>>and then persist it to either an ADTG or XML format instead of creating
>>    
>>
>
>  
>
>>a table.
>>
>>Charlotte Foust
>>
>>-----Original Message-----
>>From: MartyConnelly [mailto:martyconnelly at shaw.ca]
>>Sent: Monday, December 01, 2003 6:39 PM
>>To: Access Developers discussion and problem solving
>>Subject: Re: [AccessD] Registry tweaks
>>
>>
>>
>>Just use sortcountrylist  function as intial call. You don't have to
>>QuikSort just put in a query after moving to a table
>>I was going to put into an array at one point. Should give you 230 
>>countries.
>>
>>I find it a pain to use callbacks. I keep having to refresh my memory 
>>as
>>
>>to how to use them.
>>
>>
>>Public Const HKEY_CLASSES_ROOT As Long = &H80000000
>>Public Const HKEY_CURRENT_USER = &H80000001
>>Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
>>Public Const HKEY_USERS As Long = &H80000003
>>Public Const HKEY_PERFORMANCE_DATA As Long = &H80000004
>>Public Const HKEY_CURRENT_CONFIG As Long = &H80000005
>>Public Const HKEY_DYN_DATA As Long = &H80000006
>>
>>Const ValueName As String = "Name"
>>Const MasterKey As String =
>>"SOFTWARE\Microsoft\Windows\CurrentVersion\Telephony\Country List\"
>>Public Function getregcountries() As String 'Enumerate the keys inside
>>the Registry key: ' parts of this from
>>http://www.vb-helper.com/howto_list_countries.html
>>'    HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\
>>'    CurrentVersion\Telephony\Country List\
>>  
>>   Dim KeyCol As Collection
>>   Dim CountryCol As Collection
>>   Dim strCountry As String
>>   strCountry = ""
>>   If CheckRegistryKey(HKEY_LOCAL_MACHINE, MasterKey) Then
>>
>>       Set KeyCol = EnumRegistryKeys(HKEY_LOCAL_MACHINE, MasterKey)
>>       Dim TheKey As Variant
>>       Set CountryCol = New Collection
>>
>>       For Each TheKey In KeyCol
>>            If TheKey <> "800" And 
>>GetRegistryValue(HKEY_LOCAL_MACHINE,
>>
>>MasterKey & TheKey, "InternationalRule", "") <> "00EFG#" Then
>>               'CboCountry.AddItem 
>>GetRegistryValue(HKEY_LOCAL_MACHINE,
>>
>>MasterKey & TheKey, ValueName, "")
>>               Debug.Print GetRegistryValue(HKEY_LOCAL_MACHINE,
>>MasterKey & TheKey, ValueName, "")
>>               strCountry = strCountry & 
>>GetRegistryValue(HKEY_LOCAL_MACHINE, MasterKey & TheKey, ValueName, "")
>>    
>>
>
>  
>
>>& ";"
>>            End If
>>       Next
>>   End If
>>   getregcountries = strCountry
>>End Function
>>
>>
>>Function SortCountriesString() As String
>>Dim arrtemp As Variant
>>Dim arrCountries(300) As String
>>Dim strCountries As String
>>Dim strOutCountries As String
>>Dim i As Long
>>' Get Countries from Registry
>> strCountries = getregcountries
>> ' Move countries string to array unsorted
>> arrtemp = Split(strCountries, ";")
>> 'put variant array into string array
>>  For i = LBound(arrtemp) To UBound(arrtemp)
>>       arrCountries(i) = arrtemp(i)
>>  Next i
>>  ' now sort array by country name
>> Quicksort arrCountries, LBound(arrtemp), UBound(arrtemp)
>>  'put array into string for combobox maybe too long > 2048 bytes
>>   For i = LBound(arrtemp) To UBound(arrtemp)
>>     strOutCountries = strOutCountries & arrCountries(i) & ";"
>>   Next i
>>  
>>   SortCountriesString = strOutCountries
>> 'Debug.Print Len(SortCountriesString)
>> ' put sorted array into table
>>
>>  MoveIntoTable arrCountries(), UBound(arrtemp)
>>End Function
>>
>>Function MoveIntoTable(arrCountries() As String, imax As Long) Dim rs 
>>As Recordset Dim iRow As Integer, iCol As Integer Dim db As Database 
>>Set db = CurrentDb 'pre create table with 1 text field "Country Name" 
>>Set rs =
>>db.OpenRecordset("CountryName") If rs.RecordCount > 1 Then
>>  MsgBox "table exists already"
>>  Exit Function
>>End If
>>With rs
>>   For iRow = 0 To imax
>>       .AddNew
>>       ' 0'th field is autonumber
>>           .Fields(1) = arrCountries(iRow)
>>       .Update
>>   Next
>>   .Close
>>End With
>>Set rs = Nothing
>>
>>End Function
>>
>>Public Sub Quicksort(list() As String, ByVal min As Long, _
>>   ByVal max As Long)
>>Dim med_value As String
>>Dim hi As Long
>>Dim lo As Long
>>Dim i As Long
>>
>>   ' If min >= max, the list contains 0 or 1 items so it
>>   ' is sorted.
>>   If min >= max Then Exit Sub
>>
>>   ' Pick the dividing value.
>>   i = Int((max - min + 1) * Rnd + min)
>>   med_value = list(i)
>>
>>   ' Swap it to the front.
>>   list(i) = list(min)
>>
>>   lo = min
>>   hi = max
>>   Do
>>       ' Look down from hi for a value < med_value.
>>       Do While list(hi) >= med_value
>>           hi = hi - 1
>>           If hi <= lo Then Exit Do
>>       Loop
>>       If hi <= lo Then
>>           list(lo) = med_value
>>           Exit Do
>>       End If
>>
>>       ' Swap the lo and hi values.
>>       list(lo) = list(hi)
>>      
>>       ' Look up from lo for a value >= med_value.
>>       lo = lo + 1
>>       Do While list(lo) < med_value
>>           lo = lo + 1
>>           If lo >= hi Then Exit Do
>>       Loop
>>       If lo >= hi Then
>>           lo = hi
>>           list(hi) = med_value
>>           Exit Do
>>       End If
>>      
>>       ' Swap the lo and hi values.
>>       list(hi) = list(lo)
>>   Loop
>>  
>>   ' Sort the two sublists.
>>   Quicksort list(), min, lo - 1
>>   Quicksort list(), lo + 1, max
>>End Sub
>>
>>'registry utilities in seperate module
>>
>>Option Compare Database
>>Option Explicit
>>
>>Public Const HKEY_CLASSES_ROOT As Long = &H80000000
>>Public Const HKEY_CURRENT_USER = &H80000001
>>Public Const HKEY_LOCAL_MACHINE As Long = &H80000002
>>Public Const HKEY_USERS As Long = &H80000003
>>Public Const HKEY_PERFORMANCE_DATA As Long = &H80000004
>>Public Const HKEY_CURRENT_CONFIG As Long = &H80000005
>>Public Const HKEY_DYN_DATA As Long = &H80000006
>>
>>
>>
>>
>>Const REG_SZ = 1
>>Const REG_EXPAND_SZ = 2
>>Const REG_BINARY = 3
>>Const REG_DWORD = 4
>>Const REG_MULTI_SZ = 7
>>Const ERROR_MORE_DATA = 234
>>Const KEY_READ = &H20019  ' ((READ_CONTROL Or KEY_QUERY_VALUE Or
>>                         ' KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And 
>>(Not
>>                         ' SYNCHRONIZE))
>>Const REG_OPENED_EXISTING_KEY = &H2
>>
>>Const KEY_WRITE = &H20006  '((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
>>                          ' KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
>>
>>
>>Private 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
>>
>>
>>Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
>>   "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String)
>>As Long
>>
>>
>>
>>Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory"
>>(dest As _
>>   Any, source As Any, ByVal numBytes 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 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, _
>>   lpData As Any, lpcbData As Long) As Long
>>  
>>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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As
>>Long) As _
>>   Long
>>
>>
>>Private Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
>>   "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
>>   ByVal Reserved As Long, ByVal lpClass As Long, ByVal dwOptions As
>>Long, _
>>   ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, _
>>   phkResult As Long, lpdwDisposition As Long) As Long
>>
>>
>>Private 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
>>
>>Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias
>>"RegDeleteKeyA" _
>>   (ByVal hKey As Long, ByVal lpSubKey As String) As Long
>>
>>
>>
>>Sub DeleteRegistryKey(ByVal hKey As Long, ByVal KeyName As String)
>>   RegDeleteKey hKey, KeyName
>>End Sub
>>
>>
>>
>>
>>Function DeleteRegistryValue(ByVal hKey As Long, ByVal KeyName As 
>>String, _
>>   ByVal ValueName As String) As Boolean
>>   Dim handle As Long
>>  
>>   ' Open the key, exit if not found
>>   If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then Exit 
>>Function
>>  
>>   ' Delete the value (returns 0 if success)
>>   DeleteRegistryValue = (RegDeleteValue(handle, ValueName) = 0)
>>   ' Close the handle
>>   RegCloseKey handle
>>End Function
>>
>>Function CheckRegistryKey(ByVal hKey As Long, ByVal KeyName As String) 
>>As _
>>   Boolean
>>   Dim handle As Long
>>   ' Try to open the key
>>   If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) = 0 Then
>>       ' The key exists
>>       CheckRegistryKey = True
>>       ' Close it before exiting
>>       RegCloseKey handle
>>   End If
>>End Function
>>
>>
>>Function CreateRegistryKey(ByVal hKey As Long, ByVal KeyName As String)
>>    
>>
>
>  
>
>>As _
>>   Boolean
>>   Dim handle As Long, disposition As Long
>>  
>>   If RegCreateKeyEx(hKey, KeyName, 0, 0, 0, 0, 0, handle, 
>>disposition)
>>
>>Then
>>       Err.Raise 1001, , "Unable to create the registry key"
>>   Else
>>       ' Return True if the key already existed.
>>       CreateRegistryKey = (disposition = REG_OPENED_EXISTING_KEY)
>>       ' Close the key.
>>       RegCloseKey handle
>>   End If
>>End Function
>>
>>
>>Function EnumRegistryKeys(ByVal hKey As Long, ByVal KeyName As String) 
>>As _
>>   Collection
>>   Dim handle As Long
>>   Dim length As Long
>>   Dim index As Long
>>   Dim subkeyName As String
>>  
>>   ' initialize the result collection
>>   Set EnumRegistryKeys = New Collection
>>  
>>   ' Open the key, exit if not found
>>   If Len(KeyName) Then
>>       If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit
>>Function
>>       ' in all case the subsequent functions use hKey
>>       hKey = handle
>>   End If
>>  
>>   Do
>>       ' this is the max length for a key name
>>       length = 260
>>       subkeyName = Space$(length)
>>       ' get the N-th key, exit the loop if not found
>>       If RegEnumKey(hKey, index, subkeyName, length) Then Exit Do
>>      
>>       ' add to the result collection
>>       subkeyName = Left$(subkeyName, InStr(subkeyName, vbNullChar) -
>>1)
>>       EnumRegistryKeys.Add subkeyName, subkeyName
>>       ' prepare to query for next key
>>       index = index + 1
>>   Loop
>> 
>>   ' Close the key, if it was actually opened
>>   If handle Then RegCloseKey handle
>>      
>>End Function
>>
>>
>>Function EnumRegistryValues(ByVal hKey As Long, ByVal KeyName As 
>>String)
>>
>>As _
>>   Collection
>>   Dim handle As Long
>>   Dim index As Long
>>   Dim valueType As Long
>>   Dim name As String
>>   Dim nameLen As Long
>>   Dim resLong As Long
>>   Dim resString As String
>>   Dim dataLen As Long
>>   Dim valueInfo(0 To 1) As Variant
>>   Dim retVal As Long
>>  
>>   ' initialize the result
>>   Set EnumRegistryValues = New Collection
>>  
>>   ' Open the key, exit if not found.
>>   If Len(KeyName) Then
>>       If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit
>>Function
>>       ' in all cases, subsequent functions use hKey
>>       hKey = handle
>>   End If
>>  
>>   Do
>>       ' this is the max length for a key name
>>       nameLen = 260
>>       name = Space$(nameLen)
>>       ' prepare the receiving buffer for the value
>>       dataLen = 4096
>>       ReDim resBinary(0 To dataLen - 1) As Byte
>>      
>>       ' read the value's name and data
>>       ' exit the loop if not found
>>       retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&,
>>valueType, _
>>           resBinary(0), dataLen)
>>      
>>       ' enlarge the buffer if you need more space
>>       If retVal = ERROR_MORE_DATA Then
>>           ReDim resBinary(0 To dataLen - 1) As Byte
>>           retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&,
>>    
>>
>
>  
>
>>_
>>               valueType, resBinary(0), dataLen)
>>       End If
>>       ' exit the loop if any other error (typically, no more values)
>>       If retVal Then Exit Do
>>      
>>       ' retrieve the value's name
>>       valueInfo(0) = Left$(name, nameLen)
>>      
>>       ' return a value corresponding to the value type
>>       Select Case valueType
>>           Case REG_DWORD
>>               CopyMemory resLong, resBinary(0), 4
>>               valueInfo(1) = resLong
>>           Case REG_SZ, REG_EXPAND_SZ
>>               ' copy everything but the trailing null char
>>               resString = Space$(dataLen - 1)
>>               CopyMemory ByVal resString, resBinary(0), dataLen - 1
>>               valueInfo(1) = resString
>>           Case REG_BINARY
>>               ' shrink the buffer if necessary
>>               If dataLen < UBound(resBinary) + 1 Then
>>                   ReDim Preserve resBinary(0 To dataLen - 1) As Byte
>>               End If
>>               valueInfo(1) = resBinary()
>>           Case REG_MULTI_SZ
>>               ' copy everything but the 2 trailing null chars
>>               resString = Space$(dataLen - 2)
>>               CopyMemory ByVal resString, resBinary(0), dataLen - 2
>>               valueInfo(1) = resString
>>           Case Else
>>               ' Unsupported value type - do nothing
>>       End Select
>>      
>>       ' add the array to the result collection
>>       ' the element's key is the value's name
>>       EnumRegistryValues.Add valueInfo, valueInfo(0)
>>      
>>       index = index + 1
>>   Loop
>> 
>>   ' Close the key, if it was actually opened
>>   If handle Then RegCloseKey handle
>>      
>>End Function
>>Function EnumRegistryValuesEx(ByVal hKey As Long, ByVal KeyName As
>>String) As _
>>   Collection
>>   Dim handle As Long
>>   Dim index As Long
>>   Dim valueType As Long
>>   Dim name As String
>>   Dim nameLen As Long
>>   Dim resLong As Long
>>   Dim resString As String
>>   Dim dataLen As Long
>>   Dim valueInfo(0 To 2) As Variant
>>   Dim retVal As Long
>>  
>>   ' initialize the result
>>   Set EnumRegistryValuesEx = New Collection
>>  
>>   ' Open the key, exit if not found.
>>   If Len(KeyName) Then
>>       If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then Exit
>>Function
>>       ' in all cases, subsequent functions use hKey
>>       hKey = handle
>>   End If
>>  
>>   Do
>>       ' this is the max length for a key name
>>       nameLen = 260
>>       name = Space$(nameLen)
>>       ' prepare the receiving buffer for the value
>>       dataLen = 4096
>>       ReDim resBinary(0 To dataLen - 1) As Byte
>>      
>>       ' read the value's name and data
>>       ' exit the loop if not found
>>       retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&,
>>valueType, _
>>           resBinary(0), dataLen)
>>      
>>       ' enlarge the buffer if you need more space
>>       If retVal = ERROR_MORE_DATA Then
>>           ReDim resBinary(0 To dataLen - 1) As Byte
>>           retVal = RegEnumValue(hKey, index, name, nameLen, ByVal 0&,
>>    
>>
>
>  
>
>>_
>>               valueType, resBinary(0), dataLen)
>>       End If
>>       ' exit the loop if any other error (typically, no more values)
>>       If retVal Then Exit Do
>>      
>>       ' retrieve the value's name
>>       valueInfo(0) = Left$(name, nameLen)
>>      
>>       ' return a value corresponding to the value type
>>       Select Case valueType
>>           Case REG_DWORD
>>               CopyMemory resLong, resBinary(0), 4
>>               valueInfo(1) = resLong
>>               valueInfo(2) = vbLong
>>           Case REG_SZ, REG_EXPAND_SZ
>>               ' copy everything but the trailing null char
>>               resString = Space$(dataLen - 1)
>>               CopyMemory ByVal resString, resBinary(0), dataLen - 1
>>               valueInfo(1) = resString
>>               valueInfo(2) = vbString
>>           Case REG_BINARY
>>               ' shrink the buffer if necessary
>>               If dataLen < UBound(resBinary) + 1 Then
>>                   ReDim Preserve resBinary(0 To dataLen - 1) As Byte
>>               End If
>>               valueInfo(1) = resBinary()
>>               valueInfo(2) = vbArray + vbByte
>>           Case REG_MULTI_SZ
>>               ' copy everything but the 2 trailing null chars
>>               resString = Space$(dataLen - 2)
>>               CopyMemory ByVal resString, resBinary(0), dataLen - 2
>>               valueInfo(1) = resString
>>               valueInfo(2) = vbString
>>           Case Else
>>               ' Unsupported value type - do nothing
>>       End Select
>>      
>>       ' add the array to the result collection
>>       ' the element's key is the value's name
>>       EnumRegistryValuesEx.Add valueInfo, valueInfo(0)
>>      
>>       index = index + 1
>>   Loop
>> 
>>   ' Close the key, if it was actually opened
>>   If handle Then RegCloseKey handle
>>      
>>End Function
>>
>>
>>Function GetRegistryValue(ByVal hKey As Long, ByVal KeyName As String,
>>    
>>
>_
>  
>
>>   ByVal ValueName As String, Optional DefaultValue As Variant) As 
>>Variant
>>   Dim handle As Long
>>   Dim resLong As Long
>>   Dim resString As String
>>   Dim resBinary() As Byte
>>   Dim length As Long
>>   Dim retVal As Long
>>   Dim valueType As Long
>>  
>>   ' Prepare the default result
>>   GetRegistryValue = IIf(IsMissing(DefaultValue), Empty, 
>>DefaultValue)
>>  
>>   ' Open the key, exit if not found.
>>   If RegOpenKeyEx(hKey, KeyName, 0, KEY_READ, handle) Then
>>       Exit Function
>>   End If
>>  
>>   ' prepare a 1K receiving resBinary
>>   length = 1024
>>   ReDim resBinary(0 To length - 1) As Byte
>>  
>>   ' read the registry key
>>   retVal = RegQueryValueEx(handle, ValueName, 0, valueType,
>>resBinary(0), _
>>       length)
>>   ' if resBinary was too small, try again
>>   If retVal = ERROR_MORE_DATA Then
>>       ' enlarge the resBinary, and read the value again
>>       ReDim resBinary(0 To length - 1) As Byte
>>       retVal = RegQueryValueEx(handle, ValueName, 0, valueType, 
>>resBinary(0), _
>>           length)
>>   End If
>>  
>>   ' return a value corresponding to the value type
>>   Select Case valueType
>>       Case REG_DWORD
>>           CopyMemory resLong, resBinary(0), 4
>>           GetRegistryValue = resLong
>>       Case REG_SZ, REG_EXPAND_SZ
>>           ' copy everything but the trailing null char
>>           resString = Space$(length - 1)
>>           CopyMemory ByVal resString, resBinary(0), length - 1
>>           GetRegistryValue = resString
>>       Case REG_BINARY
>>           ' resize the result resBinary
>>           If length <> UBound(resBinary) + 1 Then
>>               ReDim Preserve resBinary(0 To length - 1) As Byte
>>           End If
>>           GetRegistryValue = resBinary()
>>       Case REG_MULTI_SZ
>>           ' copy everything but the 2 trailing null chars
>>           resString = Space$(length - 2)
>>           CopyMemory ByVal resString, resBinary(0), length - 2
>>           GetRegistryValue = resString
>>       Case Else
>>           RegCloseKey handle
>>           Err.Raise 1001, , "Unsupported value type"
>>   End Select
>>  
>>   ' close the registry key
>>   RegCloseKey handle
>>End Function
>>
>>
>>
>>
>>Function SetRegistryValue(ByVal hKey As Long, ByVal KeyName As String,
>>    
>>
>_
>  
>
>>   ByVal ValueName As String, value As Variant) As Boolean
>>   Dim handle As Long
>>   Dim lngValue As Long
>>   Dim strValue As String
>>   Dim binValue() As Byte
>>   Dim length As Long
>>   Dim retVal As Long
>>  
>>   ' Open the key, exit if not found
>>   If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then
>>       Exit Function
>>   End If
>>
>>   ' three cases, according to the data type in Value
>>   Select Case VarType(value)
>>       Case vbInteger, vbLong
>>           lngValue = value
>>           retVal = RegSetValueEx(handle, ValueName, 0, REG_DWORD,
>>lngValue, 4)
>>       Case vbString
>>           strValue = value
>>           retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal 
>>strValue, _
>>               Len(strValue))
>>       Case vbArray + vbByte
>>           binValue = value
>>           length = UBound(binValue) - LBound(binValue) + 1
>>           retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, _
>>               binValue(LBound(binValue)), length)
>>       Case Else
>>           RegCloseKey handle
>>           Err.Raise 1001, , "Unsupported value type"
>>   End Select
>>  
>>   ' Close the key and signal success
>>   RegCloseKey handle
>>   ' signal success if the value was written correctly
>>   SetRegistryValue = (retVal = 0)
>>End Function
>>
>>
>>
>>
>>
>> 
>>
>>    
>>
>
>  
>

-- 
Marty Connelly
Victoria, B.C.
Canada





More information about the AccessD mailing list