Qubick/Settings.bas at master · BatchedFiles/Qubick · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
#include once "Settings.bi"

Const RegSection = "Software\Пакетные файлы\FreeBasicIrcBot"

Function EnumerateUserWords( _
		ByVal Channel As WString Ptr, _
		ByVal hHeap As Handle, _
		ByVal ValuesCount As DWORD Ptr _
	)As UserWords Ptr
	Dim RegSectionChannels As WString * 512 = Any
	lstrcpy(RegSectionChannels, RegSection)
	lstrcat(RegSectionChannels, Channel)

	Dim reg As HKEY = Any
	Dim lpdwDisposition As DWORD = Any
	Dim hr As Long = RegCreateKeyEx(HKEY_CURRENT_USER, @RegSectionChannels, 0, 0, 0, KEY_QUERY_VALUE + KEY_ENUMERATE_SUB_KEYS, NULL, @reg, @lpdwDisposition)

	If hr <> ERROR_SUCCESS Then
		Return 0
	End If

	Dim SubKeysCount As DWORD = Any
	Dim MaxSubKeyLength As DWORD = Any
	Dim MaxClassNameLength As DWORD = Any

	Dim MaxValueDataLength As DWORD = Any
	Dim MaxValueNameLength As DWORD = Any

	' Информация о разделе реестра
	hr = RegQueryInfoKey(reg, NULL, 0, 0, @SubKeysCount, @MaxSubKeyLength, @MaxClassNameLength, ValuesCount, @MaxValueNameLength, @MaxValueDataLength, NULL, 0)
	If hr <> ERROR_SUCCESS Then
		RegCloseKey(reg)
		Return 0
	End If

	Dim pdwType As DWORD = REG_DWORD
	Dim Buffer As DWORD = Any
	Dim BufferLength As DWORD = SizeOf(DWORD)

	Dim hMem As UserWords Ptr = HeapAlloc(hHeap, HEAP_NO_SERIALIZE, (*ValuesCount) * SizeOf(UserWords))
	If hMem = 0 Then
		RegCloseKey(reg)
		Return 0
	End If

	For i As DWORD = 0 To *ValuesCount - 1

		Dim UserName As WString * (511 + 1) = Any
		Dim UserNameLength As DWORD = (511 + 1) * SizeOf(WString)

		hr = RegEnumValue(reg, i, @UserName, @UserNameLength, 0, @pdwType, CPtr(Byte Ptr, @Buffer), @BufferLength)
		If hr = ERROR_SUCCESS Then
			lstrcpy(@hMem[i].UserName[0], @UserName)
			hMem[i].WordsCount = Buffer
		Else
			RegCloseKey(reg)
			Return 0
		End If

	Next

	RegCloseKey(reg)
	Return hMem
End Function

Function IncrementUserWords( _
		ByVal Channel As WString Ptr, _
		ByVal User As WString Ptr _
	)As Boolean
	Dim RegSectionChannels As WString * 512 = Any
	lstrcpy(RegSectionChannels, RegSection)
	lstrcat(RegSectionChannels, Channel)

	Dim reg As HKEY = Any
	Dim lpdwDisposition As DWORD = Any
	Dim hr As Long = RegCreateKeyEx(HKEY_CURRENT_USER, @RegSectionChannels, 0, 0, 0, KEY_QUERY_VALUE + KEY_SET_VALUE, NULL, @reg, @lpdwDisposition)

	If hr <> ERROR_SUCCESS Then
		Return False
	End If

	Dim pdwType As DWORD = REG_DWORD
	Dim Buffer As DWORD = Any
	Dim BufferLength As DWORD = SizeOf(DWORD)
	hr = RegQueryValueEx(reg, User, 0, @pdwType, CPtr(Byte Ptr, @Buffer), @BufferLength)
	If hr <> ERROR_SUCCESS Then
		If hr = ERROR_FILE_NOT_FOUND  Then
			Buffer = 0
			BufferLength = SizeOf(DWORD)
		Else
			RegCloseKey(reg)
			Return -1
		End If
	End If

	Buffer += 1

	hr = RegSetValueEx(reg, User, 0, REG_DWORD, CPtr(Byte Ptr, @Buffer), SizeOf(DWORD))
	If hr <> ERROR_SUCCESS Then
		RegCloseKey(reg)
		Return False
	End If

	RegCloseKey(reg)
	Return True
End Function

Function GetSettingsValue( _
		ByVal Buffer As WString Ptr, _
		ByVal BufferLength As Integer, _
		ByVal Key As WString Ptr _
	)As Integer
	Dim reg As HKEY = Any
	Dim lpdwDisposition As DWORD = Any
	Dim hr As Long = RegCreateKeyEx(HKEY_CURRENT_USER, @RegSection, 0, 0, 0, KEY_QUERY_VALUE, NULL, @reg, @lpdwDisposition)

	If hr <> ERROR_SUCCESS Then
		Return -1
	End If

	Dim pdwType As DWORD = RRF_RT_REG_SZ
	Dim BufferLength2 As DWORD = (BufferLength + 1) * SizeOf(WString)
	hr = RegQueryValueEx(reg, Key, 0, @pdwType, CPtr(Byte Ptr, Buffer), @BufferLength2)
	If hr <> ERROR_SUCCESS Then
		RegCloseKey(reg)
		Return -1
	End If

	RegCloseKey(reg)

	Return BufferLength \ SizeOf(WString) - 1
End Function

Function SetSettingsValue( _
		ByVal Key As WString Ptr, _
		ByVal Value As WString Ptr _
	)As Boolean
	Dim reg As HKEY = Any
	Dim lpdwDisposition As DWORD = Any
	Dim hr As Long = RegCreateKeyEx(HKEY_CURRENT_USER, @RegSection, 0, 0, 0, KEY_SET_VALUE, NULL, @reg, @lpdwDisposition)

	If hr <> ERROR_SUCCESS Then
		Return False
	End If

	hr = RegSetValueEx(reg, Key, 0, REG_SZ, CPtr(Byte Ptr, Value), (lstrlen(Value) + 1) * SizeOf(WString))
	If hr <> ERROR_SUCCESS Then
		RegCloseKey(reg)
		Return False
	End If

	RegCloseKey(reg)
	Return True
End Function