|
|
1.1 root 1: '***************************************************************************
2: '**************** registration database api's ***********************
3: '***************************************************************************
4:
5: '$DEFINE REG_DB_ENABLED
6:
7: const REG_SZ = 1
8: const HKEY_CLASSES_ROOT = 1
9: const ERROR_SUCCESS = 0
10:
11:
12: DECLARE FUNCTION EercErrorHandler LIB "mscomstf.dll" (grc%, fVital%, sz1$, sz2$, sz3$) AS INTEGER
13: CONST GRC_API_FAILED = 104
14:
15: DECLARE FUNCTION RegOpenKey LIB "SHELL.DLL" (hKey&, szSubKey$, phkResult AS POINTER TO LONG) AS LONG
16: DECLARE FUNCTION RegCreateKey LIB "shell.dll" (hKey&, szSubKey$, phkResult AS POINTER TO LONG) AS LONG
17: DECLARE FUNCTION RegDeleteKey LIB "shell.dll" (hKey&, szSubKey$) AS LONG
18: DECLARE FUNCTION RegCloseKey LIB "shell.dll" (hKey&) AS LONG
19: DECLARE FUNCTION RegQueryValue LIB "shell.dll" (hKey&, szSubKey$, szValue$, lpcb AS POINTER TO LONG) AS LONG
20: DECLARE FUNCTION RegSetValue LIB "shell.dll" (hKey&, szSubKey$, dwType&, szValue$, cbValue&) AS LONG
21: DECLARE FUNCTION RegEnumKey LIB "shell.dll" (HkEY&, dwIndex&, szBuffer$, dwBufferSize&) AS LONG
22:
23:
24: DECLARE SUB CreateRegKey(szKey$)
25: DECLARE SUB CreateRegKeyValue(szKey$, szValue$)
26: DECLARE SUB SetRegKeyValue(szKey$, szValue$)
27: DECLARE SUB DeleteRegKey(szKey$)
28: DECLARE FUNCTION GetRegKeyValue(szKey$) AS STRING
29: DECLARE FUNCTION DoesRegKeyExist(szKey$) AS INTEGER
30:
31:
32: 'NOTE: All keys are assumed to be subkeys of HKEY_CLASSES_ROOT. Therefore,
33: 'the key HKEY_CLASSES_ROOT\key1\key2 would simply be written as key1\key2
34: 'for these api's.
35:
36:
37: '**************************************************************************
38: SUB CreateRegKey(szKey$) STATIC
39: DIM phKey AS LONG
40:
41: IF RegCreateKey(HKEY_CLASSES_ROOT, szKey$, VARPTR(phKey)) > ERROR_SUCCESS THEN
42: i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKey", NULL, NULL)
43: '$ifdef DEBUG
44: StfApiErr saeFail, "CreateRegKey", szKey$
45: '$endif ''DEBUG
46: ERROR STFERR
47: END IF
48:
49: IF RegCloseKey(phKey) > ERROR_SUCCESS THEN
50: i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKey", NULL, NULL)
51: '$ifdef DEBUG
52: StfApiErr saeFail, "CreateRegKey", szKey$
53: '$endif ''DEBUG
54: ERROR STFERR
55: END IF
56: END SUB
57:
58:
59: '**************************************************************************
60: SUB CreateRegKeyValue(szKey$, szValue$) STATIC
61: DIM phKey AS LONG
62:
63: IF RegSetValue(HKEY_CLASSES_ROOT, szKey$, REG_SZ, szValue$, len(szKey$)) > ERROR_SUCCESS THEN
64: i% = EercErrorHandler(GRC_API_FAILED, 1, "CreateRegKeyValue", NULL, NULL)
65: '$ifdef DEBUG
66: StfApiErr saeFail, "CreateRegKeyValue", szKey$+", "+szValue$
67: '$endif ''DEBUG
68: ERROR STFERR
69: END IF
70: END SUB
71:
72:
73: '**************************************************************************
74: FUNCTION DoesRegKeyExist(szKey$) STATIC AS INTEGER
75: DIM phKey AS LONG
76:
77: IF RegOpenKey(HKEY_CLASSES_ROOT, szKey$, VARPTR(phKey)) = ERROR_SUCCESS THEN
78: i = RegCloseKey(phKey)
79: DoesRegKeyExist = 1
80: ELSE
81: DoesRegKeyExist = 0
82: ENDIF
83: END FUNCTION
84:
85:
86: '**************************************************************************
87: SUB SetRegKeyValue(szKey$, szValue$) STATIC
88: DIM phKey AS LONG
89:
90: IF RegSetValue(HKEY_CLASSES_ROOT, szKey$, REG_SZ, szValue$, len(szKey$)) > ERROR_SUCCESS THEN
91: i% = EercErrorHandler(GRC_API_FAILED, 1, "SetRegKeyValue", NULL, NULL)
92: '$ifdef DEBUG
93: StfApiErr saeFail, "SetRegKeyValue", szKey$+", "+szValue$
94: '$endif ''DEBUG
95: ERROR STFERR
96: END IF
97: END SUB
98:
99:
100: '**************************************************************************
101: FUNCTION GetRegKeyValue(szKey$) STATIC AS STRING
102: szValue$ = string$(512,32)
103: cb& = len(szValue$)
104:
105: IF DoesRegKeyExist(szKey$) = 0 THEN
106: GetRegKeyValue = ""
107: EXIT FUNCTION
108: END IF
109:
110: IF RegQueryValue(HKEY_CLASSES_ROOT, szKey$, szValue$, VARPTR(cb)) = ERROR_SUCCESS THEN
111: GetRegKeyValue = MID$(szValue$, 1, cb)
112: ELSE
113: i% = EercErrorHandler(GRC_API_FAILED, 1, "SetRegKeyValue", NULL, NULL)
114: '$ifdef DEBUG
115: StfApiErr saeFail, "GetRegKeyValue", szKey$
116: '$endif ''DEBUG
117: ERROR STFERR
118: END IF
119: szValue$ = ""
120: END FUNCTION
121:
122:
123: '**************************************************************************
124: SUB DeleteRegKey(szKey$) STATIC
125: i& = RegDeleteKey(HKEY_CLASSES_ROOT, szKey$)
126: END SUB
127:
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.