|
|
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.