301 lines
11 KiB
QBasic
301 lines
11 KiB
QBasic
|
Attribute VB_Name = "Config"
|
||
|
|
DefInt A-Z
|
||
|
|
Option Explicit
|
||
|
|
|
||
|
|
'========Public Config Vars and Structs========
|
||
|
|
'Main Form
|
||
|
|
Public MainFormHeight As Long
|
||
|
|
Public MainFormWidth As Long
|
||
|
|
Public MainFormVDivider As Long
|
||
|
|
Public MainFormHDivider As Long
|
||
|
|
Public StatusBar As Boolean
|
||
|
|
|
||
|
|
Public DataListIdColWidth As Long
|
||
|
|
Public DataListNameColWidth As Long
|
||
|
|
Public DataListAttrColWidth As Long
|
||
|
|
Public DataListUTColWidth As Long
|
||
|
|
Public DataListDTColWidth As Long
|
||
|
|
Public DataListDataColWidth As Long
|
||
|
|
|
||
|
|
Public ErrorListKeyColWidth As Long
|
||
|
|
Public ErrorListPropColWidth As Long
|
||
|
|
Public ErrorListIdColWidth As Long
|
||
|
|
Public ErrorListSeverityColWidth As Long
|
||
|
|
Public ErrorListDescColWidth As Long
|
||
|
|
|
||
|
|
Public MaxKeySize As Long
|
||
|
|
Public MaxPropSize As Long
|
||
|
|
Public MaxNumErrors As Long
|
||
|
|
|
||
|
|
Const MainFormHeightDefault = 8000
|
||
|
|
Const MainFormWidthDefault = 12000
|
||
|
|
Const MainFormHDividerDefault = 2500
|
||
|
|
Const MainFormVDividerDefault = 2500
|
||
|
|
Const StatusBarDefault = True
|
||
|
|
|
||
|
|
Const DataListIdColWidthDefault = 800
|
||
|
|
Const DataListNameColWidthDefault = 1500
|
||
|
|
Const DataListAttrColWidthDefault = 1000
|
||
|
|
Const DataListUTColWidthDefault = 700
|
||
|
|
Const DataListDTColWidthDefault = 500
|
||
|
|
Const DataListDataColWidthDefault = 1500
|
||
|
|
|
||
|
|
Const ErrorListKeyColWidthDefault = 3000
|
||
|
|
Const ErrorListPropColWidthDefault = 800
|
||
|
|
Const ErrorListIdColWidthDefault = 800
|
||
|
|
Const ErrorListSeverityColWidthDefault = 800
|
||
|
|
Const ErrorListDescColWidthDefault = 3000
|
||
|
|
|
||
|
|
Const MaxKeySizeDefault = 102400
|
||
|
|
Const MaxPropSizeDefault = 1024
|
||
|
|
Const MaxNumErrorsDefault = 100
|
||
|
|
|
||
|
|
'========API Declarations========
|
||
|
|
'Load APIs for registry editing
|
||
|
|
Private Type FILETIME
|
||
|
|
dwLowDateTime As Long
|
||
|
|
dwHighDateTime As Long
|
||
|
|
End Type
|
||
|
|
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 String, ByVal dwOptions As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes As Long, phkResult As Long, lpdwDisposition As Long) As Long
|
||
|
|
Private Declare Function RegDeleteKey Lib "advapi32.dll" Alias "RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
|
||
|
|
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, ByVal lpData As String, ByVal cbData As Long) As Long ' Note that if you declare the lpData parameter as String, you must pass it By Value.
|
||
|
|
Private Declare Function RegQueryValueEx 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 ' Note that if you declare the lpData parameter as String, you must pass it By Value.
|
||
|
|
'Origial Declaration, the reserved parameter was set up wrong and I set up the class parameter to always be double NULL
|
||
|
|
'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 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 Long, ByVal lpcbClass As Long, lpftLastWriteTime As FILETIME) As Long
|
||
|
|
|
||
|
|
|
||
|
|
Const ERROR_SUCCESS = 0&
|
||
|
|
Const HKEY_CURRENT_USER = &H80000001
|
||
|
|
Const HKEY_LOCAL_MACHINE = &H80000002
|
||
|
|
Const STANDARD_RIGHTS_ALL = &H1F0000
|
||
|
|
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 SYNCHRONIZE = &H100000
|
||
|
|
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 REG_OPTION_NON_VOLATILE = 0 ' Key is preserved when system is rebooted
|
||
|
|
Const REG_CREATED_NEW_KEY = &H1 ' New Registry Key created
|
||
|
|
Const REG_OPENED_EXISTING_KEY = &H2 ' Existing Key opened
|
||
|
|
Const REG_SZ = 1
|
||
|
|
Sub LoadConfig()
|
||
|
|
|
||
|
|
LoadMainFormConfig
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Sub LoadMainFormConfig()
|
||
|
|
Dim Ret As Long
|
||
|
|
Dim Disposition As Long
|
||
|
|
Dim KeyHandle As Long
|
||
|
|
|
||
|
|
'Open/Create Key
|
||
|
|
Ret = RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\MetEdit", _
|
||
|
|
0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, KeyHandle, Disposition)
|
||
|
|
If Ret <> ERROR_SUCCESS Then Debug.Print "Error creating or opening MetEdit key in LoadMainFormConfig"
|
||
|
|
|
||
|
|
'Get Settings
|
||
|
|
MainFormHeight = RegGetLong(KeyHandle, "Main Form Height", MainFormHeightDefault)
|
||
|
|
MainFormWidth = RegGetLong(KeyHandle, "Main Form Width", MainFormWidthDefault)
|
||
|
|
MainFormVDivider = RegGetLong(KeyHandle, "Main Form V Divider", MainFormVDividerDefault)
|
||
|
|
MainFormHDivider = RegGetLong(KeyHandle, "Main Form H Divider", MainFormHDividerDefault)
|
||
|
|
StatusBar = RegGetBoolean(KeyHandle, "Status Bar", StatusBarDefault)
|
||
|
|
|
||
|
|
DataListIdColWidth = RegGetLong(KeyHandle, "Data List Id Col Width", DataListIdColWidthDefault)
|
||
|
|
DataListNameColWidth = RegGetLong(KeyHandle, "Data List Name Col Width", DataListNameColWidthDefault)
|
||
|
|
DataListAttrColWidth = RegGetLong(KeyHandle, "Data List Attr Col Width", DataListAttrColWidthDefault)
|
||
|
|
DataListUTColWidth = RegGetLong(KeyHandle, "Data List UT Col Width", DataListUTColWidthDefault)
|
||
|
|
DataListDTColWidth = RegGetLong(KeyHandle, "Data List DT Col Width", DataListDTColWidthDefault)
|
||
|
|
DataListDataColWidth = RegGetLong(KeyHandle, "Data List Data Col Width", DataListDataColWidthDefault)
|
||
|
|
|
||
|
|
ErrorListKeyColWidth = RegGetLong(KeyHandle, "Error List Key Col Width", ErrorListKeyColWidthDefault)
|
||
|
|
ErrorListPropColWidth = RegGetLong(KeyHandle, "Error List Prop Col Width", ErrorListPropColWidthDefault)
|
||
|
|
ErrorListIdColWidth = RegGetLong(KeyHandle, "Error List Id Col Width", ErrorListIdColWidthDefault)
|
||
|
|
ErrorListSeverityColWidth = RegGetLong(KeyHandle, "Error List Severity Col Width", ErrorListSeverityColWidthDefault)
|
||
|
|
ErrorListDescColWidth = RegGetLong(KeyHandle, "Error List Desc Col Width", ErrorListDescColWidthDefault)
|
||
|
|
|
||
|
|
MaxKeySize = RegGetLong(KeyHandle, "Max Key Size", MaxKeySizeDefault)
|
||
|
|
MaxPropSize = RegGetLong(KeyHandle, "Max Property Size", MaxPropSizeDefault)
|
||
|
|
MaxNumErrors = RegGetLong(KeyHandle, "Max Number of Errors", MaxNumErrorsDefault)
|
||
|
|
|
||
|
|
'Close Key
|
||
|
|
Ret = RegCloseKey(KeyHandle)
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Sub SaveConfig()
|
||
|
|
SaveMainFormConfig
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Sub SaveMainFormConfig()
|
||
|
|
Dim KeyHandle As Long
|
||
|
|
Dim Ret As Long
|
||
|
|
Dim Disposition As Long
|
||
|
|
|
||
|
|
'Open Key
|
||
|
|
Ret = RegCreateKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\MetEdit", _
|
||
|
|
0, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0, KeyHandle, Disposition)
|
||
|
|
If Ret <> ERROR_SUCCESS Then Debug.Print "Error creating or opening MetEdit key in SaveMainFormConfig"
|
||
|
|
|
||
|
|
'Save Values
|
||
|
|
RegSetLong KeyHandle, "Main Form Height", MainFormHeight
|
||
|
|
RegSetLong KeyHandle, "Main Form Width", MainFormWidth
|
||
|
|
RegSetLong KeyHandle, "Main Form V Divider", MainFormVDivider
|
||
|
|
RegSetLong KeyHandle, "Main Form H Divider", MainFormHDivider
|
||
|
|
RegSetBoolean KeyHandle, "Status Bar", StatusBar
|
||
|
|
|
||
|
|
RegSetLong KeyHandle, "Data List Id Col Width", DataListIdColWidth
|
||
|
|
RegSetLong KeyHandle, "Data List Name Col Width", DataListNameColWidth
|
||
|
|
RegSetLong KeyHandle, "Data List Attr Col Width", DataListAttrColWidth
|
||
|
|
RegSetLong KeyHandle, "Data List UT Col Width", DataListUTColWidth
|
||
|
|
RegSetLong KeyHandle, "Data List DT Col Width", DataListDTColWidth
|
||
|
|
RegSetLong KeyHandle, "Data List Data Col Width", DataListDataColWidth
|
||
|
|
|
||
|
|
RegSetLong KeyHandle, "Error List Key Col Width", ErrorListKeyColWidth
|
||
|
|
RegSetLong KeyHandle, "Error List Prop Col Width", ErrorListPropColWidth
|
||
|
|
RegSetLong KeyHandle, "Error List Id Col Width", ErrorListIdColWidth
|
||
|
|
RegSetLong KeyHandle, "Error List Severity Col Width", ErrorListSeverityColWidth
|
||
|
|
RegSetLong KeyHandle, "Error List Desc Col Width", ErrorListDescColWidth
|
||
|
|
|
||
|
|
RegSetLong KeyHandle, "Max Key Size", MaxKeySize
|
||
|
|
RegSetLong KeyHandle, "Max Property Size", MaxPropSize
|
||
|
|
RegSetLong KeyHandle, "Max Number of Errors", MaxNumErrors
|
||
|
|
|
||
|
|
'Close Key
|
||
|
|
Ret = RegCloseKey(KeyHandle)
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Function ConvertCString(CString As String) As String
|
||
|
|
'Cleans up a C style string into a VB string
|
||
|
|
|
||
|
|
Dim i As Integer
|
||
|
|
Dim CharStr As String
|
||
|
|
Dim NullStr As String
|
||
|
|
Dim RetStr As String
|
||
|
|
|
||
|
|
'Find the first NULL
|
||
|
|
NullStr = String(1, 0)
|
||
|
|
i = 1
|
||
|
|
Do
|
||
|
|
CharStr = Mid(CString, i, 1)
|
||
|
|
i = i + 1
|
||
|
|
Loop While ((i <= Len(CString)) And (CharStr <> NullStr))
|
||
|
|
|
||
|
|
'If we found the null, keep the part before the null
|
||
|
|
If (CharStr = NullStr) Then
|
||
|
|
ConvertCString = Left(CString, i - 2)
|
||
|
|
Else
|
||
|
|
ConvertCString = CString
|
||
|
|
End If
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Sub RegNukeKey(KeyHnd As Long, SubKeyStr As String)
|
||
|
|
'Nukes a key and all subkeys, should work with both ninety-blah and NT
|
||
|
|
|
||
|
|
Dim Ret As Long
|
||
|
|
Dim SubKeyHnd As Long
|
||
|
|
|
||
|
|
'Open the subkey so we can look for sub keys
|
||
|
|
Ret = RegOpenKeyEx(KeyHnd, SubKeyStr, 0, KEY_ALL_ACCESS, SubKeyHnd)
|
||
|
|
If Ret <> ERROR_SUCCESS Then Exit Sub
|
||
|
|
|
||
|
|
'Recursivly nuke all of the subsubkeys
|
||
|
|
Dim i As Long
|
||
|
|
Dim SubSubKeyStr As String
|
||
|
|
Dim LastWrite As FILETIME
|
||
|
|
|
||
|
|
i = 0
|
||
|
|
SubSubKeyStr = String(301, "X") 'Trick it into allocating memory
|
||
|
|
Ret = RegEnumKeyEx(SubKeyHnd, i, SubSubKeyStr, 300, 0, 0, 0, LastWrite)
|
||
|
|
|
||
|
|
Do While (Ret = ERROR_SUCCESS)
|
||
|
|
SubSubKeyStr = RTrim(ConvertCString(SubSubKeyStr))
|
||
|
|
RegNukeKey SubKeyHnd, SubSubKeyStr
|
||
|
|
|
||
|
|
'i = i + 1 Not needed since the next one becomes index 0
|
||
|
|
SubSubKeyStr = String(301, "X") 'Trick it into reallocating memory
|
||
|
|
Ret = RegEnumKeyEx(SubKeyHnd, i, SubSubKeyStr, 300, 0, 0, 0, LastWrite)
|
||
|
|
Loop
|
||
|
|
|
||
|
|
'Close the target key
|
||
|
|
Ret = RegCloseKey(SubKeyHnd)
|
||
|
|
|
||
|
|
'Delete the target key
|
||
|
|
Ret = RegDeleteKey(KeyHnd, SubKeyStr)
|
||
|
|
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Function RegGetString(KeyHandle As Long, Var As String, MaxLen As Long, DefaultStr As String) As String
|
||
|
|
|
||
|
|
Dim OutStr As String
|
||
|
|
Dim Ret As Long
|
||
|
|
|
||
|
|
OutStr = String(MaxLen + 1, "X") 'Trick it into allocating memory
|
||
|
|
Ret = RegQueryValueEx(KeyHandle, Var, 0, REG_SZ, OutStr, MaxLen + 1)
|
||
|
|
|
||
|
|
If Ret <> ERROR_SUCCESS Then
|
||
|
|
'If we didn't get it, set it to default
|
||
|
|
OutStr = DefaultStr
|
||
|
|
Ret = RegSetValueEx(KeyHandle, Var, 0, REG_SZ, OutStr, Len(OutStr) + 1)
|
||
|
|
If Ret <> ERROR_SUCCESS Then Error.Print "Error setting " & Var & " value"
|
||
|
|
Else
|
||
|
|
'If we got it, convert it to a VB String
|
||
|
|
OutStr = Left(Trim(ConvertCString(OutStr)), MaxLen)
|
||
|
|
End If
|
||
|
|
|
||
|
|
RegGetString = OutStr
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Sub RegSetString(KeyHandle As Long, Var As String, Val As String)
|
||
|
|
Dim Ret As Long
|
||
|
|
|
||
|
|
Ret = RegSetValueEx(KeyHandle, Var, 0, REG_SZ, Val + String(1, 0), Len(Val) + 1)
|
||
|
|
If Ret <> ERROR_SUCCESS Then Error.Print "Error setting registry Var=" & Var & " Val=" & Val
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Function RegGetBoolean(KeyHandle As Long, Var As String, Default As Boolean) As Boolean
|
||
|
|
Dim BoolStr As String
|
||
|
|
|
||
|
|
If Default = True Then
|
||
|
|
BoolStr = RegGetString(KeyHandle, Var, 2, "1")
|
||
|
|
Else
|
||
|
|
BoolStr = RegGetString(KeyHandle, Var, 2, "0")
|
||
|
|
End If
|
||
|
|
|
||
|
|
If BoolStr = "1" Then
|
||
|
|
RegGetBoolean = True
|
||
|
|
Else
|
||
|
|
RegGetBoolean = False
|
||
|
|
End If
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Sub RegSetBoolean(KeyHandle As Long, Var As String, Val As Boolean)
|
||
|
|
|
||
|
|
If Val Then
|
||
|
|
RegSetString KeyHandle, Var, "1"
|
||
|
|
Else
|
||
|
|
RegSetString KeyHandle, Var, "0"
|
||
|
|
End If
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
Function RegGetLong(KeyHandle As Long, Var As String, Default As Long) As Long
|
||
|
|
Dim NumStr As String
|
||
|
|
|
||
|
|
NumStr = RegGetString(KeyHandle, Var, 20, Str(Default))
|
||
|
|
|
||
|
|
RegGetLong = CLng(NumStr)
|
||
|
|
End Function
|
||
|
|
|
||
|
|
Sub RegSetLong(KeyHandle As Long, Var As String, Val As Long)
|
||
|
|
|
||
|
|
RegSetString KeyHandle, Var, Str(Val)
|
||
|
|
End Sub
|
||
|
|
|
||
|
|
|