diff options
Diffstat (limited to 'tests/projects/plugins/project/src/vb')
| -rw-r--r-- | tests/projects/plugins/project/src/vb/Info.frm | 67 | ||||
| -rw-r--r-- | tests/projects/plugins/project/src/vb/Registry.bas | 166 | ||||
| -rw-r--r-- | tests/projects/plugins/project/src/vb/Registry.cls | 428 |
3 files changed, 661 insertions, 0 deletions
diff --git a/tests/projects/plugins/project/src/vb/Info.frm b/tests/projects/plugins/project/src/vb/Info.frm new file mode 100644 index 00000000000..8487bb3af18 --- /dev/null +++ b/tests/projects/plugins/project/src/vb/Info.frm @@ -0,0 +1,67 @@ +VERSION 5.00 +Begin VB.Form frmInfo + BorderStyle = 3 'Fixed Dialog + Caption = "Info" + ClientHeight = 3750 + ClientLeft = 45 + ClientTop = 330 + ClientWidth = 6270 + Icon = "Info.frx":0000 + LinkTopic = "Form1" + MaxButton = 0 'False + MinButton = 0 'False + ScaleHeight = 3750 + ScaleWidth = 6270 + ShowInTaskbar = 0 'False + StartUpPosition = 1 'CenterOwner + Begin VB.CommandButton cmdOK + Caption = "&OK" + Default = -1 'True + Height = 375 + Left = 5100 + TabIndex = 1 + Top = 3300 + Width = 1095 + End + Begin VB.TextBox txtGPL + BackColor = &H8000000F& + BorderStyle = 0 'None + Height = 3075 + Left = 120 + Locked = -1 'True + MultiLine = -1 'True + TabIndex = 0 + Text = "Info.frx":000C + Top = 120 + Width = 6015 + End +End +Attribute VB_Name = "frmInfo" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = False +Attribute VB_PredeclaredId = True +Attribute VB_Exposed = False +' --- GPL --- +' +' Copyright (C) 1999 SAP AG +' +' This program is free software; you can redistribute it and/or +' modify it under the terms of the GNU General Public License +' as published by the Free Software Foundation; either version 2 +' of the License, or (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program; if not, write to the Free Software +' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +' +' --- GPL --- +Option Explicit + +Private Sub cmdOK_Click() + Unload Me +End Sub diff --git a/tests/projects/plugins/project/src/vb/Registry.bas b/tests/projects/plugins/project/src/vb/Registry.bas new file mode 100644 index 00000000000..a7f18dee417 --- /dev/null +++ b/tests/projects/plugins/project/src/vb/Registry.bas @@ -0,0 +1,166 @@ +Attribute VB_Name = "modRegistry" +' --- GPL --- +' +' Copyright (C) 1999 SAP AG +' +' This program is free software; you can redistribute it and/or +' modify it under the terms of the GNU General Public License +' as published by the Free Software Foundation; either version 2 +' of the License, or (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program; if not, write to the Free Software +' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +' +' --- GPL --- +Option Explicit + +'Structures Needed For Registry Prototypes +Public Type SECURITY_ATTRIBUTES + nLength As Long + lpSecurityDescriptor As Long + bInheritHandle As Boolean +End Type + +Public Type FILETIME + dwLowDateTime As Long + dwHighDateTime As Long +End Type + +'Registry Function Prototypes +Public 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 + +Public 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 + +Public Declare Function RegQueryValueExNull Lib "advapi32.dll" Alias "RegQueryValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + ByVal lpData As Long, _ + lpcbData As Long) As Long + +Public 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 + +Public Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias "RegQueryValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal lpReserved As Long, _ + lpType As Long, _ + lpData As Long, _ + lpcbData As Long) As Long + +Public Declare Function RegSetValueExString Lib "advapi32.dll" Alias "RegSetValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal Reserved As Long, _ + ByVal dwType As Long, _ + ByVal lpValue As String, _ + ByVal cbData As Long) As Long + +Public Declare Function RegSetValueExLong Lib "advapi32.dll" Alias "RegSetValueExA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String, _ + ByVal Reserved As Long, _ + ByVal dwType As Long, _ + lpValue As Long, _ + ByVal cbData As Long) As Long + +Public Declare Function RegEnumKeyEx Lib "advapi32.dll" Alias "RegEnumKeyExA" ( _ + ByVal hKey As Long, _ + ByVal dwIndex As Long, _ + ByVal lpName As String, _ + lpcbName As Long, _ + ByVal lpReserved As Long, _ + ByVal lpClass As String, _ + lpcbClass As Long, _ + lpftLastWriteTime As FILETIME) As Long + +Public 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 + +Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" ( _ + ByVal hKey As Long, _ + ByVal lpSubKey As String) As Long + +Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" ( _ + ByVal hKey As Long, _ + ByVal lpValueName As String) As Long + +Public Declare Function RegCloseKey Lib "advapi32" ( _ + ByVal hKey As Long) As Long + +' +''masks for the predefined standard access types +'Private Const STANDARD_RIGHTS_ALL = &H1F0000 +'Private Const SPECIFIC_RIGHTS_ALL = &HFFFF +' +''Define severity codes +' +''Public Const ERROR_ACCESS_DENIED = 5 +'' +''Global Const ERROR_NONE = 0 +''Global Const ERROR_BADDB = 1 +''Global Const ERROR_CANTOPEN = 3 +''Global Const ERROR_CANTREAD = 4 +''Global Const ERROR_CANTWRITE = 5 +''Global Const ERROR_OUTOFMEMORY = 6 +''Global Const ERROR_INVALID_PARAMETER = 7 +''Global Const ERROR_ACCESS_DENIED = 8 +''Global Const ERROR_INVALID_PARAMETERS = 87 +''Global Const ERROR_NO_MORE_ITEMS = 259 + +Public Type ByteValue + b(1024) As Byte +End Type + +Public Type LongValue + l As Long +End Type + +Public Function BytesToString(bValue As ByteValue) As String + Dim s As String + Dim i As Integer + s = StrConv(bValue.b(), vbUnicode) + i = InStr(s, Chr(0)) - 1 + BytesToString = Left(s, i) +End Function + +Public Function BytesToLong(bValue As ByteValue) As Long + Dim lValue As LongValue + LSet lValue = bValue + BytesToLong = lValue.l +End Function + diff --git a/tests/projects/plugins/project/src/vb/Registry.cls b/tests/projects/plugins/project/src/vb/Registry.cls new file mode 100644 index 00000000000..ee53025fb97 --- /dev/null +++ b/tests/projects/plugins/project/src/vb/Registry.cls @@ -0,0 +1,428 @@ +VERSION 1.0 CLASS +BEGIN + MultiUse = -1 'True + Persistable = 0 'NotPersistable + DataBindingBehavior = 0 'vbNone + DataSourceBehavior = 0 'vbNone + MTSTransactionMode = 0 'NotAnMTSObject +END +Attribute VB_Name = "Registry" +Attribute VB_GlobalNameSpace = False +Attribute VB_Creatable = True +Attribute VB_PredeclaredId = False +Attribute VB_Exposed = False +' --- GPL --- +' +' Copyright (C) 1999 SAP AG +' +' This program is free software; you can redistribute it and/or +' modify it under the terms of the GNU General Public License +' as published by the Free Software Foundation; either version 2 +' of the License, or (at your option) any later version. +' +' This program is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU General Public License for more details. +' +' You should have received a copy of the GNU General Public License +' along with this program; if not, write to the Free Software +' Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +' +' --- GPL --- +Option Explicit + +Public Enum RegistryHKeyConstants + HKEY_CLASSES_ROOT = &H80000000 + HKEY_CURRENT_USER = &H80000001 + HKEY_LOCAL_MACHINE = &H80000002 + HKEY_USERS = &H80000003 + HKEY_PERFORMANCE_DATA = &H80000004 + HKEY_CURRENT_CONFIG = &H80000005 + HKEY_DYN_DATA = &H80000006 +End Enum + +Public Enum RegistryTypeConstants + REG_NONE = (0) 'No value type + REG_SZ = (1) 'Unicode nul terminated string +' REG_EXPAND_SZ = (2) 'Unicode nul terminated string w/enviornment var +' REG_BINARY = (3) 'Free form binary + REG_DWORD = (4) '32-bit number +' REG_DWORD_LITTLE_ENDIAN = (4) '32-bit number (same as REG_DWORD) +' REG_DWORD_BIG_ENDIAN = (5) '32-bit number +' REG_LINK = (6) 'Symbolic Link (unicode) +' REG_MULTI_SZ = (7) 'Multiple Unicode strings +' REG_RESOURCE_LIST = (8) 'Resource list in the resource map +' REG_FULL_RESOURCE_DESCRIPTOR = (9) 'Resource list in the hardware description +' REG_RESOURCE_REQUIREMENTS_LIST = (10) +End Enum + +Public Enum RegistryAccessConstants + KEY_QUERY_VALUE = &H1 + KEY_SET_VALUE = &H2 + KEY_CREATE_SUB_KEY = &H4 + KEY_ENUMERATE_SUB_KEYS = &H8 + KEY_NOTIFY = &H10 + KEY_CREATE_LINK = &H20 + KEY_ALL_ACCESS = &H3F +End Enum + +Public Enum RegistryErrorConstants + ERROR_SUCCESS = 0 + ERROR_BADKEY = 2 + ERROR_OUTOFMEMORY = 6 + ERROR_MORE_DATA = 234 + ERROR_NO_MORE_ITEMS = 259 +End Enum + +Public Enum RegistryVolatileConstants + REG_OPTION_NON_VOLATILE = 0& + REG_OPTION_VOLATILE = &H1 +End Enum + +Public Enum RegistryDispositionConstants + REG_CREATED_NEW_KEY = &H1 + REG_OPENED_EXISTING_KEY = &H2 +End Enum + +Private oKeys As Keys + +Private bShowErrors As Boolean +Private bRaiseErrors As Boolean +' +' Public Properties +' +Public Property Get Keys() As Keys + If oKeys Is Nothing Then + Set oKeys = New Keys + With oKeys + Set .Registry = Me + Set .Parent = Me + .Root = True + End With + End If + Set Keys = oKeys +End Property + +Public Property Get ShowErrors() As Boolean + ShowErrors = bShowErrors +End Property +Public Property Let ShowErrors(ByVal NewVal As Boolean) + bShowErrors = NewVal +End Property + +Public Property Get RaiseErrors() As Boolean + RaiseErrors = bRaiseErrors +End Property +Public Property Let RaiseErrors(ByVal NewVal As Boolean) + bRaiseErrors = NewVal +End Property +' +' Public Sub/Function +' +' Base Functions +' +Public Function OpenKey(ByVal hKey As RegistryHKeyConstants, _ + ByVal Path As String, _ + ByVal Access As RegistryAccessConstants, _ + Key As Long) As Boolean + + Dim lRC As Long + + OpenKey = False + + lRC = RegOpenKeyEx(hKey, Path, 0&, Access, Key) + If lRC = ERROR_SUCCESS Then + OpenKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function CreateKey(ByVal hKey As RegistryHKeyConstants, _ + ByVal Path As String, _ + ByVal Volatile As RegistryVolatileConstants, _ + ByVal Access As RegistryAccessConstants, _ + Key As Long, _ + Disposition As Long) As Boolean + + Dim lRC As Long + Dim saKey As SECURITY_ATTRIBUTES + + CreateKey = False + + lRC = RegCreateKeyEx(hKey, Path, 0, "", Volatile, Access, saKey, Key, Disposition) + If lRC = ERROR_SUCCESS Then + CreateKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function DeleteKey(ByVal hKey As RegistryHKeyConstants, _ + ByVal Path As String) As Boolean + + Dim lRC As Long + + DeleteKey = False + + lRC = RegDeleteKey(hKey, Path) + If lRC = ERROR_SUCCESS Then + DeleteKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function CloseKey(ByVal Path, _ + Key As Long) As Boolean + + Dim lRC As Long + + CloseKey = False + + lRC = RegCloseKey(Key) + If lRC = ERROR_SUCCESS Then + Key = 0 + CloseKey = True + Else + HandleError lRC, Path + End If +End Function + +Public Function QueryValueNull(ByVal hKey As Long, _ + ByVal Name As String, _ + ValueType As RegistryTypeConstants, _ + ValueLen As Long) As Boolean + + Dim lRC As Long + + QueryValueNull = False + + lRC = RegQueryValueExNull(hKey, Name, 0&, ValueType, 0&, ValueLen) + If lRC = ERROR_SUCCESS Then + QueryValueNull = True + Else + HandleError lRC, Name + End If +End Function + +Public Function QueryValueString(ByVal hKey As Long, _ + ByVal Name As String, _ + Value As String, _ + ValueLen As Long) As Boolean + + Dim lRC As Long + + QueryValueString = False + + Value = String(ValueLen, 0) + + lRC = RegQueryValueExString(hKey, Name, 0&, REG_SZ, Value, ValueLen) + If lRC = ERROR_SUCCESS Then + Value = Left(Value, ValueLen - 1) + QueryValueString = True + Else + HandleError lRC, Name + End If +End Function + +Public Function QueryValueLong(ByVal hKey As Long, _ + ByVal Name As String, _ + Value As Long) As Boolean + + Dim lRC As Long + Dim lValueLen As Long + + QueryValueLong = False + + Value = 0 + + lRC = RegQueryValueExLong(hKey, Name, 0&, REG_DWORD, Value, 4) + If lRC = ERROR_SUCCESS Then + QueryValueLong = True + Else + HandleError lRC, Name + End If +End Function + +Public Function SetValueString(ByVal hKey As Long, _ + ByVal Name As String, _ + ByVal Value As String) As Boolean + + Dim lRC As Long + + SetValueString = False + + Value = Value & Chr(0) + + lRC = RegSetValueExString(hKey, Name, 0&, REG_SZ, Value, Len(Value)) + If lRC = ERROR_SUCCESS Then + SetValueString = True + Else + HandleError lRC, Name + End If +End Function + +Public Function SetValueLong(ByVal hKey As Long, _ + ByVal Name As String, _ + ByVal Value As Long) As Boolean + + Dim lRC As Long + + SetValueLong = False + + lRC = RegSetValueExLong(hKey, Name, 0&, REG_DWORD, Value, 4) + If lRC = ERROR_SUCCESS Then + SetValueLong = True + Else + HandleError lRC, Name + End If +End Function + +Public Function DeleteValue(ByVal hKey As Long, _ + ByVal Name As String) As Boolean + + Dim lRC As Long + + DeleteValue = False + + lRC = RegDeleteValue(hKey, Name) + If lRC = ERROR_SUCCESS Then + DeleteValue = True + Else + HandleError lRC, Name + End If +End Function +' +' +' +Public Function Check(ByVal WithSubKeys As Boolean, _ + ByVal WithValues As Boolean) As Boolean + + Dim oKey As Key + + Check = False + + For Each oKey In Keys + If Not oKey.Check(WithSubKeys, WithValues) Then + Exit Function + End If + Next + + Check = True +End Function + +Public Function Create(ByVal WithSubKeys As Boolean, _ + ByVal WithValues As Boolean) As Boolean + + Dim oKey As Key + + Create = False + + For Each oKey In Keys + If Not oKey.Create(WithSubKeys, WithValues) Then + Exit Function + End If + Next + + Create = True +End Function + +Public Function QueryValues(ByVal WithSubKeys As Boolean) As Boolean + + Dim oKey As Key + + QueryValues = False + + For Each oKey In Keys + If Not oKey.QueryValues(WithSubKeys) Then + Exit Function + End If + Next + + QueryValues = True +End Function + +Public Function SetValues(ByVal WithSubKeys As Boolean) As Boolean + + Dim oKey As Key + + SetValues = False + + For Each oKey In Keys + If Not oKey.SetValues(WithSubKeys) Then + Exit Function + End If + Next + + SetValues = True +End Function + +Public Function EnumKeys(ByVal WithSubKeys As Boolean, _ + ByVal WithValues As Boolean) As Boolean + + Dim oKey As Key + + EnumKeys = False + + For Each oKey In Keys + If Not oKey.EnumKeys(WithSubKeys, WithValues) Then + Exit Function + End If + Next + + EnumKeys = True +End Function + +Public Function FindKeyByPath(ByVal WithSubKeys As Boolean, _ + ByVal FindPath As String) As Key + Dim oKey As Key + + Set FindKeyByPath = Nothing + + For Each oKey In Keys + If FindPath = oKey.Path Then + Set FindKeyByPath = oKey + Exit Function + End If + If WithSubKeys Then + Set FindKeyByPath = oKey.FindKeyByPath(WithSubKeys, FindPath) + End If + Next +End Function + +Friend Sub HandleError(ByVal RC As Long, ByVal Text As String) + Dim sMsg As String + + If bShowErrors Then + sMsg = "Error: " & ErrorText(RC) & ". " & Text + MsgBox sMsg, vbExclamation + End If +End Sub +' +' Private Sub/Function +' +Private Sub Class_Initialize() + 'Debug.Print "INIT Registry" + Set oKeys = Nothing + bShowErrors = True + bRaiseErrors = False +End Sub + +Private Sub Class_Terminate() + 'Debug.Print "TERM Registry" +End Sub + +Private Function ErrorText(ByVal lRC As Long) As String + Dim s As String + Select Case lRC + Case ERROR_BADKEY: s = "Bad key" + Case ERROR_MORE_DATA: s = "More data" + Case ERROR_OUTOFMEMORY: s = "Out of memory" + Case ERROR_NO_MORE_ITEMS: s = "No more items" + Case Else: s = "RC=" & CStr(lRC) + End Select + ErrorText = s +End Function + |