Newsgroup: it.comp.lang.visual-basic
Titolo: Ri-presentazione e.. file di configurazione

Ciao a tutti,
mi riaffaccio sul ng dopo una lunga sosta forzata.
Per chi non si ricorda di me (credo la stragrande maggioranza), vi dico
che mi chiamo Maurizio, uso VB6 per divertimento, ed ho provato a studiare
anche VB.Net, ma attualmente con scarsi risultati :-)
Avrei voglia di dare un po' d'ordine ai file di configurazione di un mio
software, ho sempre "ammirato" quei bei file dove c'e' ad esempio:
[Nome]
Maurizio
[Indirizzo]
Via Visual Basic, 6
Silicon Valley
USA
[Settaggio porta seriale]
Com: 1
BPS: 4800
.
.
.
.
Come fare per far riconoscere le intestazioni, andare a prendere il o i
dati che ci servono, magari preceduti/seguiti da un commento?
Ad esempio, nel caso della seriale, a noi interesserebbe solo il numero
della Com e la velocita', non tutta la riga.
Spero di essere stato chiaro, ma vado un po' di fretta che tra 45 secondi
devo riprendere al lavoro.
Grazie e ciao... Maurizio
-- 
questo articolo e` stato inviato via web dal servizio gratuito 
http://www.newsland.it/news
 segnala gli abusi ad 
ab...@newsland.it

 Grazie e ciao... Maurizio
Se cerchi in rete o sul tuo help GetPrivateProfile e WritePrivateProfile
trovi quello che ti serve.
Sicuramente trovi già (per il buon cuore di quelli che l'hanno fatta)
qualche classe già pronta all'uso.


 qualche classe già pronta all'uso.
Aaaaaaargh! No! il registro no!
Meglio questo in una bella classe :)
Option Explicit
'
' ___________________________________________________
'  Luca Minudel                    software designer
'  Italy Conegliano(TV)
'  voice & fax                     +39 (0)438 412280
'  e-mail                      
luca.m...@nline.it
'  WWW                       (italian language used)
'  
http://www.geocities.com/SiliconValley/Vista/4041
'
' If you discover any bug or improvements to EasyRegistry please tell me,
' that 's why I'm sharing my work.
' I 'll correct any bug as soon as possible.
' Suggestions are welcome.
'
'
' -- Current Key
Private strCurrentDirectory As String
Private lngKeyHandle As Long
'
' --- Constants
'
'
' --- DirValue return a variant that is NULL or is an array(0 to 2).
'     These are index constants with respective meaning.
'
Public Enum enmDirValueIndex
     erValueName
     erValue
     erValueType
End Enum
'
' --- ValueOf and DirValue receive and return data types of data they are
'     managing. These are valid data type constants.
'
Public Enum enmDataType
     erSTRING
     erByte
     erDWord
End Enum
'
' --- ValueOf return an array with many rappresentations for each value.
'     These are index constants with respective meaning.
'
Public Enum enmValueOfIndex
     erstringformat
     erByteFormat
     erDWordFormat
End Enum
'
' ------------------------------- API DEL REGISTRO -------------------------
'
Private Declare Function RegOpenKeyEx Lib "advapi32" 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" (ByVal hKey As Long) 
As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias 
"RegQueryInfoKeyA" _
         (ByVal hKey As Long, ByVal lpClass As String, _
         lpcbClass As Long, lpReserved As Long, lpcSubKeys As Long, _
         lpcbMaxSubKeyLen As Long, lpcbMaxClassLen As Long, _
         lpcValues As Long, lpcbMaxValueNameLen As Long, _
         lpcbMaxValueLen As Long, lpcbSecurityDescriptor As Long, _
         lpftLastWriteTime As Any) As Long
Private Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias 
"RegEnumKeyExA" _
         (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName As 
String, _
         lpcbName As Long, lpReserved As Long, ByVal lpClass As String, _
         lpcbClass As Long, lpftLastWriteTime As FILETIME) 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, _
         lpReserved As Long, lpType As Long, lpData As Any, _
         lpcbData As Long) As Long
Private Declare Function RegQueryValueEx Lib "advapi32" 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 RegSetValueEx Lib "advapi32" Alias 
"RegSetValueExA" _
         (ByVal hKey As Long, ByVal lpValueName As String, _
         ByVal Reserved As Long, ByVal dwType As Long, _
         ByVal lpData As String, ByVal cbData As Long) As Long
Private Declare Function RegDeleteKey Lib "advapi32" Alias "RegDeleteKeyA" _
         (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias 
"RegDeleteValueA" _
         (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function RegCreateKeyEx Lib "advapi32" Alias 
"RegCreateKeyExA" _
         (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved 
As Long, _
         ByVal lpClass As String, ByVal dwOptions As Long, _
         ByVal samDesired As Long, lpSecurityAttributes As 
SECURITY_ATTRIBUTES, _
         phkResult As Long, lpdwDisposition As Long) As Long
'
' ---------------------------- COSTANTI DEL REGISTRO -----------------------
'
' -- HANDLE DELLE CHIAVI PREDEFINITE
Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003
Const HKEY_PERFORMANCE_DATA = &H80000004
Const HKEY_CURRENT_CONFIG = &H80000005
Const HKEY_DYN_DATA = &H80000006
' -- SICUREZZA
Const READ_CONTROL = &H20000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_ALL = &H1F0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const KEY_QUERY_VALUE = &H1
Const KEY_SET_VALUE = &H2
Const KEY_CREATE_SUB_KEY = &H4
Const KEY_ENUMERATE_SUB_KEYS = &H8
Const KEY_NOTIFY = &H10
Const KEY_CREATE_LINK = &H20
Const KEY_ALL_ACCESS = ((STANDARD_RIGHTS_ALL Or KEY_QUERY_VALUE Or 
KEY_SET_VALUE Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or 
KEY_NOTIFY Or KEY_CREATE_LINK) And (Not SYNCHRONIZE))
Const KEY_READ = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or 
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Const KEY_EXECUTE = ((KEY_READ) And (Not SYNCHRONIZE))
Const KEY_WRITE = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or 
KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
' -- CODICI DI ERRORE RITORNATI DALLE API DI REGISTRO
Const ERROR_SUCCESS = 0&
Const ERROR_FILE_NOT_FOUND = 2&
Const ERROR_BADDB = 1009&
Const ERROR_BADKEY = 1010&
Const ERROR_CANTOPEN = 1011&
Const ERROR_CANTREAD = 1012&
Const ERROR_CANTWRITE = 1013&
Const ERROR_OUTOFMEMORY = 14&
Const ERROR_INVALID_PARAMETER = 87&
Const ERROR_ACCESS_DENIED = 5&
' -- TIPI DI DATO
Const REG_NONE = 0
Const REG_SZ = 1
Const REG_EXPAND_SZ = 2
Const REG_BINARY = 3
Const REG_DWORD = 4
Const REG_DWORD_LITTLE_ENDIAN = 4
Const REG_DWORD_BIG_ENDIAN = 5
Const REG_LINK = 6
Const REG_MULTI_SZ = 7
Const REG_RESOURCE_LIST = 8
Const REG_FULL_RESOURCE_DESCRIPTOR = 9
Const REG_RESOURCE_REQUIREMENTS_LIST = 10
' -- OPZIONI
Const REG_OPTION_NON_VOLATILE = 0&
Const REG_OPTION_VOLATILE = &H1
'
' --------------------------- TIPI DI DATO API REGISTRO --------------------
'
Private Type SECURITY_ATTRIBUTES
     nLength As Long
     lpSecurityDescriptor As Long
     bInheritHandle As Long
End Type
Private Type FILETIME
     dwLowDateTime As Long
     dwHighDateTime As Long
End Type
'
' ----------------------------- API TO DETECT W95 o WNT 
---------------------
'
Private Type OSVERSIONINFO
     dwOSVersionInfoSize As Long
     dwMajorVersion As Long
     dwMinorVersion As Long
     dwBuildNumber As Long
     dwPlatformId As Long
     szCSDVersion As String * 128
End Type
Private Const VER_PLATFORM_WIN32_NT = 2    ' NT
Private Const VER_PLATFORM_WIN32_WINDOWS = 1    ' Win95
Private Const VER_PLATFORM_WIN32s = 0    ' Win32 su Win3.1
Private Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" _
         (lpVersionInformation As OSVERSIONINFO) As Long
'
'  --- INITIALIZE & TERMINATE
'
Private Sub Class_Initialize()
     strCurrentDirectory = ""
     lngKeyHandle = 0
End Sub
Private Sub Class_Terminate()
' cHIUDI TUTTE LE CHIAVI
     If strCurrentDirectory <> "" Then TestAPIError 
RegCloseKey(lngKeyHandle)
End Sub
'
' --------------------------- METODI/PROPRIETA' PUBBLICHE ------------------
'
Property Get CurrentKey() As String
     CurrentKey = strCurrentDirectory
End Property
Public Sub Cd(ByVal strDirectory As String)
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 04/05/97 2.17.16
     On Error GoTo Cd_Err
     CdExt strDirectory, KEY_QUERY_VALUE
     Exit Sub
Cd_Err:
     MsgBox Err.Number & ": " & Err.Description & ". In " & RoutineCorrente
End Sub
Public Function DirKey() As Variant
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 04/05/97 2.17.16
     Dim lngSubKeysCount As Long
     Dim lngKeyLenght As Long
     Dim strKeyName As String
     Dim lngI As Long
     Dim astrKey() As String
     Dim lngMaxSubKeyLen As Long
     Dim lngMaxClassLen As Long
     Dim lngValues As Long
     Dim udtData As FILETIME
     Dim lngMaxValueNameLen As Long
     Dim lngMaxValueLen As Long
     Dim lngSecurityDescriptor As Long
     Dim strClass As String
     Dim lngClass As Long
     On Error GoTo DirKey_Err
     If CurrentKey = "" Then
         ReDim astrKey(0 To 5) As String
         astrKey(0) = "HKEY_CLASSES_ROOT"
         astrKey(1) = "HKEY_CURRENT_USER"
         astrKey(2) = "HKEY_LOCAL_MACHINE"
         astrKey(3) = "HKEY_USERS"
         astrKey(4) = "HKEY_DYN_DATA"
         astrKey(5) = "HKEY_CURRENT_CONFIG"
         DirKey = astrKey
     Else
         CdExt ".", KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS
         'CdExt ".", KEY_ENUMERATE_SUB_KEYS
         udtData.dwHighDateTime = 0
         udtData.dwLowDateTime = 0
         lngKeyLenght = 1024
         strKeyName = String$(1024, 32)
         TestAPIError RegQueryInfoKey(lngKeyHandle, _
                 strKeyName, lngKeyLenght, ByVal 0&, _
                 lngSubKeysCount, _
                 lngMaxSubKeyLen, lngMaxClassLen, _
                 lngValues, lngMaxValueNameLen, _
                 lngMaxValueLen, lngSecurityDescriptor, _
                 udtData)
         If lngSubKeysCount > 0 Then
             For lngI = 0 To (lngSubKeysCount - 1)
                 strClass = String$(1024, 32)
                 lngClass = 1024
                 strKeyName = String$(1024, 32)
                 lngKeyLenght = 1024
                 udtData.dwHighDateTime = 0
                 udtData.dwLowDateTime = 0
                 TestAPIError RegEnumKeyEx(lngKeyHandle, lngI, _
                         strKeyName, lngKeyLenght, _
                         ByVal 0&, strClass, lngClass, udtData)
                 ReDim Preserve astrKey(0 To lngI) As String
                 astrKey(lngI) = Left$(strKeyName, lngKeyLenght)
             Next lngI
             DirKey = astrKey
         Else
             DirKey = Null
         End If
         'CdExt CurrentKey, KEY_ALL_ACCESS
     End If
     Exit Function
DirKey_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Function
Public Function DirValue() As Variant
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 04/05/97 2.17.16
     Dim lngValueCount As Long
     Dim strValueName As String
     Dim lngValueNameLength As Long
     Dim lngValueLength As Long
     Dim lngValueType As Long
     Dim strKeyName As String
     Dim lngKeyLenght As Long
     Dim lngI As Long
     Dim lngJ As Long
     Dim lngK As Long
     Dim abytValue(1024) As Byte
     Dim astrValue() As String
     Dim lngTemp As Long
     Dim dblTemp As Double
     Dim strTemp As String
     Dim lngSubKeysCount As Long
     Dim lngMaxSubKeyLen As Long
     Dim lngMaxClassLen As Long
     Dim lngValues As Long
     Dim udtData As FILETIME
     Dim lngMaxValueNameLen As Long
     Dim lngMaxValueLen As Long
     Dim lngSecurityDescriptor As Long
     On Error GoTo DirKey_Err
     If CurrentKey = "" Then
         DirValue = Null
     Else
         CdExt ".", KEY_QUERY_VALUE
         lngKeyLenght = 1024
         strKeyName = String$(1024, 32)
         lngValueCount = 0
         udtData.dwHighDateTime = 0
         udtData.dwLowDateTime = 0
         TestAPIError RegQueryInfoKey(lngKeyHandle, _
                 strKeyName, lngKeyLenght, ByVal 0&, _
                 lngSubKeysCount, _
                 lngMaxSubKeyLen, lngMaxClassLen, _
                 lngValueCount, lngMaxValueNameLen, _
                 lngMaxValueLen, lngSecurityDescriptor, _
                 udtData)
         If lngValueCount > 0 Then
             For lngI = 0 To (lngValueCount - 1)
                 lngValueNameLength = 1024
                 strValueName = String$(1024, 32)
                 lngValueLength = 1024
                 abytValue(1024) = 0
                 TestAPIError RegEnumValue(lngKeyHandle, lngI, _
                         strValueName, lngValueNameLength, ByVal 0&, _
                         lngValueType, abytValue(0), lngValueLength)
                 ReDim Preserve astrValue(0 To 2, 0 To lngI) As String
                 astrValue(erValueName, lngI) = Left$(strValueName, 
lngValueNameLength)
                 If lngValueLength > 0 Then
                     Select Case lngValueType
                         Case REG_BINARY
                             lngTemp = 0
                             astrValue(erValueType, lngI) = erByte
                             For lngJ = 0 To lngValueLength - 1
                                 astrValue(erValue, lngI) = 
astrValue(erValue, lngI) & Hex$(abytValue(lngJ)) & " "
                             Next
                             astrValue(erValue, lngI) = 
Trim$(astrValue(erValue, lngI))
                         Case REG_DWORD
                             dblTemp = 0
                             astrValue(erValueType, lngI) = erDWord
                             For lngJ = 0 To lngValueLength - 1 Step 2
                                 dblTemp = dblTemp + (256& ^ lngJ) * 
abytValue(lngJ)
                                 dblTemp = dblTemp + (256& ^ (lngJ + 1)) 
* abytValue(lngJ + 1)
                                 strTemp = Hex$(256& * 
abytValue(lngValueLength - 1 - lngJ) + _
                                         abytValue(lngValueLength - 1 - 
lngJ - 1))
                                 astrValue(erValue, lngI) = 
astrValue(erValue, lngI) & _
                                         String$(4 - Len(strTemp), "0") 
& strTemp
                             Next
                             astrValue(erValue, lngI) = 
astrValue(erValue, lngI) & " (" & Format(dblTemp, "0,000,000,000") & ")"
                         Case Else
                             astrValue(erValueType, lngI) = erSTRING
                             For lngJ = 0 To lngValueLength - 2
                                 astrValue(erValue, lngI) = 
astrValue(erValue, lngI) & Chr(abytValue(lngJ))
                             Next
                     End Select
                 End If
             Next lngI
             DirValue = astrValue
         Else
             DirValue = Null
         End If
         'CdExt CurrentKey, KEY_ALL_ACCESS
     End If
     Exit Function
DirKey_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Function
Public Property Let ValueOf(ByVal strValueName As String, lngValueType 
As enmDataType, ByVal vntValue As Variant)
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 18/05/97 16.35.53
     Dim strData As String
     Dim strDataTmp As String
     Dim lngData As Long
     Dim lngI As Long
     Dim bytType As Byte
     On Error GoTo ValueOf_Err
     Select Case lngValueType
         Case erByte
             bytType = REG_BINARY
             If TypeName(vntValue) <> "Byte()" Then _
                     ClassError 3
             If Dimensione(vntValue) <> 1 Then _
                     ClassError 3
             lngData = UBound(vntValue) - LBound(vntValue) + 1
             strData = ""
             For lngI = LBound(vntValue) To UBound(vntValue)
                 strData = strData & Chr(vntValue(lngI))
             Next
         Case erDWord
             bytType = REG_DWORD
             If TypeName(vntValue) <> "Double" Then _
                     ClassError 3
             If CDbl(vntValue) <> Int(CDbl(vntValue)) Then _
                     ClassError 3
             vntValue = Int(CDbl(vntValue))
             If vntValue < 0 Or vntValue > 4294967295# Then _
                     ClassError 3
             vntValue = Int(CDbl(vntValue))
             ' MSB
             strDataTmp = Chr(Int(vntValue / 256 ^ 3))
             vntValue = vntValue - (256 ^ 3) * Int(vntValue / 256 ^ 3)
             '
             strDataTmp = strDataTmp & Chr(Int(vntValue / 256 ^ 2))
             vntValue = vntValue - (256 ^ 2) * Int(vntValue / 256 ^ 2)
             '
             strDataTmp = strDataTmp & Chr(Int(vntValue / 256))
             vntValue = vntValue - 256 * Int(vntValue / 256)
             ' LSB
             strDataTmp = strDataTmp & Chr(Int(vntValue))
             '
             strData = Mid$(strDataTmp, 4, 1) & Mid$(strDataTmp, 3, 1) & 
Mid$(strDataTmp, 2, 1) & Mid$(strDataTmp, 1, 1)
             lngData = 4
         Case erSTRING
             bytType = REG_SZ
             If TypeName(vntValue) <> "String" Then _
                     ClassError 3
             strData = vntValue & Chr(0)
             lngData = Len(strData)
         Case Else
             ClassError 4
     End Select
     CdExt ".", KEY_SET_VALUE
     TestAPIError RegSetValueEx(lngKeyHandle, _
             strValueName, 0&, _
             bytType, strData, lngData)
     Exit Property
ValueOf_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Property
Public Property Get ValueOf(ByVal strValueName As String, ByRef 
lngValueType As enmDataType) As Variant
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 18/05/97 16.33.50
     Dim strData As String
     Dim lngData As Long
     Dim lngType As Long
     Dim avntData(0 To 2) As Variant
     Dim abytData() As Byte
     Dim strFormattedData As String
     Dim dblData As Double
     Dim lngJ As Long
     Dim lngK As Long
     Dim strTemp As String
     On Error GoTo ValueOf_Err
     If CurrentKey <> "" Then _
             CdExt ".", KEY_QUERY_VALUE
     TestAPIError RegQueryValueEx(lngKeyHandle, _
             strValueName, 0&, _
             lngType, _
             strData, lngData)
     strData = String$(lngData, 32)
     TestAPIError RegQueryValueEx(lngKeyHandle, _
             strValueName, 0&, _
             lngType, _
             strData, lngData)
     Select Case lngType
         Case REG_BINARY
             lngValueType = erByte
         Case REG_DWORD
             lngValueType = erDWord
         Case Else
             lngValueType = erSTRING
     End Select
     'ReDim abytData(0 To 0) As Byte
     If lngData > 0 Then
         ReDim abytData(0 To lngData - 1) As Byte
         Select Case lngType
             Case REG_BINARY
                 For lngJ = 1 To lngData
                     strFormattedData = strFormattedData & _
                     Hex$(Asc(Mid$(strData, lngJ, 1))) & " "
                     abytData(lngJ - 1) = Asc(Mid$(strData, lngJ, 1))
                 Next
                 strFormattedData = Trim$(strFormattedData)
                 dblData = 0
             Case REG_DWORD
                 dblData = 0
                 For lngJ = 0 To lngData - 1 Step 2
                     dblData = dblData + (256& ^ lngJ) * 
Asc(Mid$(strData, lngJ + 1, 1))
                     dblData = dblData + (256& ^ (lngJ + 1)) * 
Asc(Mid$(strData, lngJ + 2, 1))
                     strTemp = Hex(256& * Asc(Mid$(strData, lngData - 
lngJ, 1)) + _
                             Asc(Mid$(strData, lngData - lngJ - 1, 1)))
                     strFormattedData = strFormattedData & String(4 - 
Len(strTemp), "0") & strTemp
                     abytData(lngJ) = Asc(Mid$(strData, lngJ + 1, 1))
                     abytData(lngJ + 1) = Asc(Mid$(strData, lngJ + 2, 1))
                 Next
             Case Else
                 If Mid$(strData, lngData, 1) = vbNullChar Then
                     lngData = lngData - 1
                     strData = Left$(strData, lngData)
                 End If
                 strFormattedData = strData
                 If lngData > 0 Then
                     For lngJ = 1 To lngData
                         abytData(lngJ - 1) = Asc(Mid$(strData, lngJ, 1))
                     Next
                     ReDim Preserve abytData(0 To lngData - 1) As Byte
                 End If
                 dblData = 0
         End Select
     End If
     'If CurrentKey <> "" Then _
      '  CdExt CurrentKey, KEY_ALL_ACCESS
     avntData(erstringformat) = strFormattedData
     avntData(erByteFormat) = abytData
     avntData(erDWordFormat) = dblData
     ValueOf = avntData
     Exit Property
ValueOf_Err:
     If Err.Number = -
2147221248
 Then
         avntData(erstringformat) = "Errore!"
         ValueOf = avntData
     Else
         MsgBox Err.Number & ": " & Err.Description & ". In " & 
RoutineCorrente
     End If
End Property
Public Sub MakeKey(ByVal strDirectory As String)
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 18/05/97 22.43.29
     Dim lngNewKeyHandle As Long
     Dim lngMemorySpace As Long
     Dim lpSecurityAttributes As SECURITY_ATTRIBUTES
     On Error GoTo MakeKey_Err
     CdExt ".", KEY_CREATE_SUB_KEY
     lpSecurityAttributes.lpSecurityDescriptor = 0&    ' NULL
     TestAPIError RegCreateKeyEx(lngKeyHandle, _
             strDirectory, _
             0&, "", REG_OPTION_NON_VOLATILE, _
             KEY_ALL_ACCESS, _
             lpSecurityAttributes, _
             lngNewKeyHandle, _
             lngMemorySpace)
     Exit Sub
MakeKey_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Sub
Public Sub DeleteKey(ByVal strName As String)
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 18/05/97 22.44.22
     On Error GoTo DeleteKey_Err
     CdExt ".", KEY_SET_VALUE
     TestAPIError RegDeleteKey(lngKeyHandle, strName)
     Exit Sub
DeleteKey_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Sub
Public Sub DeleteValue(ByVal strName As String)
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 18/05/97 22.44.55
     On Error GoTo DeleteValue_Err
     CdExt ".", KEY_SET_VALUE
     TestAPIError RegDeleteValue(lngKeyHandle, strName)
     Exit Sub
DeleteValue_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Sub
Public Function IsWindowsNT() As Boolean
'(ROUTINE SLAVE) di Luca Minudel il 06/10/97 15.14.57
     Dim Trc As String
     Dim os As OSVERSIONINFO
     On Error GoTo IsWindowsNT_Err
     os.dwOSVersionInfoSize = Len(os)
     Call GetVersionEx(os)
     If os.dwPlatformId = VER_PLATFORM_WIN32_NT Then
         IsWindowsNT = True
     Else
         IsWindowsNT = False
     End If
     Exit Function
IsWindowsNT_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Function
'
' --------------------------------------------------------------------------
'
Private Sub CdExt(ByVal strDirectory As String, ByVal lngSecurity As Long)
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 03/05/97 23.56.39
     Dim lngNewKeyHandle As Long
     Dim lngPos As Long
     On Error GoTo CdExt_Err
'FIXIT: Sostituire la funzione "UCase" con la funzione "UCase$"
     strDirectory = Trim$(UCase$(strDirectory))
     Select Case strDirectory
         Case "\"
             If strCurrentDirectory <> "" Then _
                     TestAPIError RegCloseKey(lngKeyHandle)
             strCurrentDirectory = ""
             lngKeyHandle = 0
         Case ".."
             If strCurrentDirectory = "" Then ClassError 1
             lngPos = 1
             Do While InStr(lngPos, strCurrentDirectory, "\") > 0
                 lngPos = InStr(lngPos, strCurrentDirectory, "\") + 1
             Loop
             CdExt Mid$(strCurrentDirectory, 1, lngPos - 1), lngSecurity
         Case "."
             TestAPIError _
                     RegOpenKeyEx _
                     (lngKeyHandle, vbNullString, 0, lngSecurity, 
lngNewKeyHandle)
             If strCurrentDirectory <> "" Then _
                     TestAPIError RegCloseKey(lngKeyHandle)
             lngKeyHandle = lngNewKeyHandle
         Case Else    ' CdExt <path>
             ' Tolgo l'ultimo carattere "\" (CLS\ => CLS)
             If Right$(strDirectory, 1) = "\" And Len(strDirectory) > 1 
Then _
                     strDirectory = Mid$(strDirectory, 1, 
Len(strDirectory) - 1)
             ' Se manca aggiungo il simbolo di Root "\"
             If strCurrentDirectory = "" And Left$(strDirectory, 1) <> 
"\" Then _
                     strDirectory = "\" & strDirectory
             If Left$(strDirectory, 1) = "\" Then    ' Percorso dalla radice
                 If strCurrentDirectory <> "" Then TestAPIError 
RegCloseKey(lngKeyHandle)
                 Select Case strRoot(strDirectory)
                     Case "HKEY_CLASSES_ROOT"
                         lngKeyHandle = HKEY_CLASSES_ROOT
                     Case "HKEY_CURRENT_USER"
                         lngKeyHandle = HKEY_CURRENT_USER
                     Case "HKEY_LOCAL_MACHINE"
                         lngKeyHandle = HKEY_LOCAL_MACHINE
                     Case "HKEY_USERS"
                         lngKeyHandle = HKEY_USERS
                     Case "HKEY_DYN_DATA"
                         lngKeyHandle = HKEY_DYN_DATA
                     Case "HKEY_CURRENT_CONFIG"
                         lngKeyHandle = HKEY_CURRENT_CONFIG
                     Case Else
                         ClassError 2
                 End Select
                 strCurrentDirectory = strDirectory
                 TestAPIError _
                         RegOpenKeyEx _
                         (lngKeyHandle, strPath(strCurrentDirectory), 0, 
lngSecurity, lngNewKeyHandle)
                 lngKeyHandle = lngNewKeyHandle
             Else    ' Percorso dalla posizione corrente
                 'If strCurrentDirectory = "" Then ClassError 1
                 strCurrentDirectory = strCurrentDirectory & "\" & 
strDirectory
                 TestAPIError _
                         RegOpenKeyEx _
                         (lngKeyHandle, strDirectory, 0, lngSecurity, 
lngNewKeyHandle)
                 lngKeyHandle = lngNewKeyHandle
             End If
     End Select
     'Debug.Print strCurrentDirectory, lngKeyHandle
     Exit Sub
CdExt_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Sub
Private Function strRoot(ByVal strDirectory As String) As String
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 04/05/97 15.52.08
     On Error GoTo strRoot_Err
     ' Precondition : Mid$(strDirectory,1,1)="\"
     If InStr(2, strDirectory, "\") <> 0 Then
         strRoot = Mid$(strDirectory, 2, InStr(2, strDirectory, "\") - 2)
     Else
         strRoot = Mid$(strDirectory, 2)
     End If
     Exit Function
strRoot_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Function
Private Function strPath(ByVal strDirectory As String) As String
'(ERROR ROUTINE BY-PASS) di Luca Minudel il 04/05/97 15.54.20
     On Error GoTo strPath_Err
     If InStr(2, strDirectory, "\") <> 0 Then
         strPath = Mid$(strDirectory, InStr(2, strDirectory, "\") + 1)
     Else
         strPath = ""
     End If
     Exit Function
strPath_Err:
     Err.Raise Err.Number, Err.Source, Err.Description & ". In " & 
RoutineCorrente
End Function
Private Function Dimensione(ByRef vntMatrice As Variant) As Integer
     Dim intContaDimensione As Integer
     Dim intNiente As Integer
     intContaDimensione = 0
     On Error GoTo intDimensione_Fine
     Do
         intNiente = UBound(vntMatrice, intContaDimensione + 1)
         intContaDimensione = intContaDimensione + 1
     Loop
intDimensione_Fine:
     Dimensione = intContaDimensione
End Function
Private Sub ClassError(ByVal lngNumber As Long)
     Err.Source = "EasyRegistry"
     Select Case lngNumber
         Case 1
             Err.Description = "No current Key."
         Case 2
             Err.Description = "Invalid Key root."
         Case 3
             Err.Source = Err.Source & " [Let ValueOf]"
             Err.Description = "Type passed doesn't match Value passed."
         Case 4
             Err.Source = Err.Source & " [Let ValueOf]"
             Err.Description = "Type passed doesn't exist. Use STRING, 
DWORD or BINARY."
         Case Else
             Err.Description = "Undefined error number : " & 
CStr(vbObject + lngNumber)
             lngNumber = 255
     End Select
     Err.Raise vbObjectError + lngNumber
End Sub
Private Sub TestAPIError(ByVal lngNumber As Long)
     Err.Source = "EasyRegistry[API Call]"
     Select Case lngNumber
         Case ERROR_SUCCESS
             ' Ok !
         Case ERROR_BADDB
             Err.Description = "Corrupt Registry Database!"
         Case ERROR_BADKEY
             Err.Description = "Key name is bad."
         Case ERROR_CANTOPEN
             Err.Description = "Cannot Open Key."
         Case ERROR_CANTREAD
             Err.Description = "Cannot Read Key."
         Case ERROR_CANTWRITE
             Err.Description = "Cannot Write Key."
         Case ERROR_ACCESS_DENIED
             Err.Description = "Access to Registry Denied."
         Case ERROR_OUTOFMEMORY
             Err.Description = "Out of memory."
         Case ERROR_INVALID_PARAMETER
             Err.Description = "Invalid Parameter."
         Case ERROR_FILE_NOT_FOUND
             Err.Description = "Key/Value does not exist."
         Case Else
             Err.Description = "Undefined key error code!"
     End Select
     If lngNumber = ERROR_SUCCESS Then
         Err.Clear
     Else
         Err.Raise vbObjectError + 256
     End If
End Sub
bye
-- 
Gestione Ottica - Gestionale per Ottici e Programmi Gratuiti su:
http://www.nicolaottomano.it
Sinapsi Antispam. Antispam Gratuito.
http://www.nicolaottomano.it/sinapsi.htm
email spamtrap: 
spam...@nicolaottomano.it

 Meglio questo in una bella classe :)
Veramente chi propone di scrivere il registro sei proprio tu :)) visto che
WritePrivateProfile e GetPrivateProfile scrivono e leggono un file .ini
O mi sono perso qualcosa? 


 O mi sono perso qualcosa?
Il file .ini immagino sia un tuo file privato che ti metti nella tua
directory (spero).
--
Greg

Ottomano Nicola wrote:
Complimenti per il codice, ma non è un tantino lunghetto per quel bisogna
fare?
--
Greg

 O mi sono perso qualcosa?
Ho controllato, le uso senza sapere/ricordare cosa fanno visto che le ho
inserite in 2 mie funzioni.
Write ReadPrivateProfileString lavorano leggono scrivono su file indicati da
te.
--
Greg

 fare?
Leggere e scrivere in un ini?
Non credo. Tralaltro è una bella classe che ho avuto modo di testare a 
fondo su Sinapsi Antispam e gira che è una bellezza.


 
Ti sei perso che io sono Nicola, non Mizio :)


 Ti sei perso che io sono Nicola, non Mizio :)
Ok, ho capito cosa intendevi.
In realtà postando la classe volevo specificare che puoi fare un sacco 
di cose in più rispetto alle WritePrivateProfile e GetPrivateProfile 
(che tralaltro devi metterti a scrivere il codice per le API, quando è 
già bello e pronto.
 >>> Aaaaaaargh! No! il registro no!
 >>> Meglio questo in una bella classe :)
Chissà perchè ho pensato al registro... mmmmh...


Ok, grazie a tutti.
Credo che provero' con le API della famiglia GetPrivateProfile.
Grazie anche a Nicola che ha po'stato tutto il codicione... giuro che me
lo rigurado e cerchero' di capirci di piu' :-)
Saluti... Maurizio


 trovi quello che ti serve.
...
Sto provando a giocare un po' con WritePrivateProfileString...
Come da guida in linea, ho dichiarato la funzione con:
Declare WrtiePrivateProfileString Lib "Kernel" (...)
semplicemente facendo copia-incolla dalla guida in linea, il tutto nelle
dichiarazioni generali di un modulo .bas
In un evento Form_Load vado a scrivere:
WritePrivateProfileString ("Log", "Nome", "Mizio", app.path & "\log.ini")
che se ho capito bene (si, lo so che ho capito male altrimenti avrebbe
funzionato) , dovrebbe scrivere nel file log.ini, sotto il "capitolo"
dell'eseguibile log, il nome "Mizio" sulla riga corrispondente della
Keyword "Nome"
Come avrete capito, non funziona!!
Se provo a "chiudere" la riga cosi', il compilatore dice che vuole un =
Ma uguale a che?
Grazie a tutti.... Maurizio 
