Changeset 577 for trunk/ab5.0/ablib/src/Classes/ActiveBasic

Timestamp:

Aug 5, 2008, 4:59:56 AM (16 years ago)

Author:

NoWest

Message:

 

File:

• trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Registry.ab (modified) (9 diffs)

trunk/ab5.0/ablib/src/Classes/ActiveBasic/Windows/Registry.ab

@@ -35 +35 @@
     rootkeyname As String
     subkeyname As String
+    edited As Boolean
 
     Virtual Sub ~RegistryKey( )
@@ -43 +44 @@
     'キーの名前を取得します。 
     Function Name( ) As String
-        Dim name = rootkeyname + "\" + subkeyname
+        Dim name As String
+        If IsNothing(This.subkeyname) Then 
+            name = This.rootkeyname
+        Else
+            name = This.rootkeyname + "\" + This.subkeyname
+        End If
         Return name
     End Function
@@ -64 +70 @@
     'キーを閉じ、キーの内容が変更されている場合はディスクへフラッシュします。  
     Sub Close( )
-        This.Flush()
+        If This.edited Then This.Flush()
         RegCloseKey( This.handle )
     End Sub
@@ -70 +76 @@
     '新しいサブキーを作成するか、または既存のサブキーを開きます。  
     Function CreateSubKey( subkey As String ) As RegistryKey
+        If IsNothing(subkey) Then Return Nothing
+        Dim buf = subkey
+        '末尾の\を除去
+        If buf.EndsWith( "\" ) Then
+            buf = buf.Remove( buf.Length - 1 )
+        End If
+        '先頭の\を除去
+        If buf.StartsWith( "\" ) Then
+            buf = buf.Remove( 0, 1 )
+        End If
+
         Dim key As Detail._System_RegistryKey
         key.Root( This.rootkey )
-        key.SubKey( subkey )
+        If IsNothing(This.subkeyname) Then 
+            key.SubKey( buf )
+        Else
+            key.SubKey( This.subkeyname + "\" + buf )
+        End If
         key.Create( )
         Return key
@@ -87 +108 @@
     '指定したサブキーを削除します。文字列 subkey では、大文字と小文字は区別されません。  
     Sub DeleteSubKey ( subkey As String )
+        If IsNothing( subkey ) Then Exit Sub
+        This.DeleteSubKey( subkey, True )
     End Sub
     Sub DeleteSubKey ( subkey As String, throwOnMissingSubKey As Boolean )
+        If IsNothing( subkey ) Then Exit Sub
+        Dim key = This.OpenSubKey(subkey)
+        If key.SubKeyCount <> 0 Then
+            key.Close()
+            If throwOnMissingSubKey Then 
+                Throw New InvalidOperationException
+            Else
+                Exit Sub
+            End If
+        End If
+        RegDeleteKey( This.handle, ToTCStr(subkey) )
+        This.edited = True
     End Sub
 
     'サブキーとその子サブキーを再帰的に削除します。文字列 subkey では、大文字と小文字は区別されません。  
     Sub DeleteSubKeyTree ( subkey As String )
+        If IsNothing( subkey ) Then Exit Sub
+        Dim key = This.OpenSubKey( subkey )
+        If key.SubKeyCount <> 0 Then
+            Dim list = key.GetSubKeyNames()
+            Dim s As String
+            Foreach s In list
+                key.DeleteSubKeyTree( s )
+            Next
+        End If
+        This.DeleteSubKey( subkey, False )
     End Sub
 
     '指定した値をこのキーから削除します。  
     Sub DeleteValue ( name As String )
-        RegDeleteValue( This.handle, name )
+        If IsNothing( name ) Then Exit Sub
+        This.DeleteValue( name, True )
     End Sub
     Sub DeleteValue ( name As String, throwOnMissingValue As Boolean )
+        If IsNothing( name ) Then Exit Sub
+        RegDeleteValue( This.handle, ToTCStr(name) )
+        This.edited = True
     End Sub
 
@@ -172 +221 @@
     '指定した名前に関連付けられた値のレジストリ データ型を取得します。  
     Function GetValueKind ( name As String ) As RegistryValueKind
+        If IsNothing( name ) Then Exit Sub
         Dim dwType As DWord
         If ERROR_SUCCESS <> RegQueryValueEx( This.handle, ToTCStr(name), 0, VarPtr(dwType), NULL, NULL ) Then
@@ -212 +262 @@
     '指定したサブキーを取得します。  
     Function OpenSubKey ( name As String ) As RegistryKey
+        If IsNothing(name) Then Return Nothing
+        Dim buf = name
+        '末尾の\を除去
+        If buf.EndsWith( "\" ) Then
+            buf = buf.Remove( buf.Length - 1 )
+        End If
+        '先頭の\を除去
+        If buf.StartsWith( "\" ) Then
+            buf = buf.Remove( 0, 1 )
+        End If
+
         Dim key As Detail._System_RegistryKey
         key.Root( This.rootkey )
-        key.SubKey( name )
+        If IsNothing(This.subkeyname) Then 
+            key.SubKey( buf )
+        Else
+            key.SubKey( This.subkeyname + "\" + buf )
+        End If
         key.Open( )
         Return key
@@ -273 +338 @@
 
     Sub SubKey( subkey As String )
+        If IsNothing(subkey) Then Exit Sub
         This.subkeyname = subkey
-        If This.subkeyname.EndsWith( "\" ) Then
-            This.subkeyname.Remove( This.subkeyname.Length - 1 )
-        End If
     End Sub
 
     Sub Create()
-        RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_READ or KEY_WRITE, NULL, This.handle, NULL )
+        RegCreateKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, NULL, REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, NULL, This.handle, NULL )
     End Sub
 '   Function Create( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey
@@ -290 +353 @@
 
     Sub Open()
-        RegOpenKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, KEY_READ or KEY_WRITE, This.handle )
+        RegOpenKeyEx( This.rootkey, ToTCStr(This.subkeyname), 0, KEY_ALL_ACCESS, This.handle )
     End Sub
 '   Function Open( permissionCheck As RegistryKeyPermissionCheck ) As RegistryKey