Skip to content

Commit f0612e8

Browse files
mobius1qwemobius1qwe
committed
+ Nova classe config com conector SQLdb nativo do Lazarus.
1 parent 821825a commit f0612e8

1 file changed

Lines changed: 298 additions & 0 deletions

File tree

‎config/lazarus/config.sqlite.sqldb.pas‎

Lines changed: 298 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,298 @@
1+
// Maiores Informações
2+
// https://github.com/OpenSourceCommunityBrasil/PascalLibs/wiki
3+
4+
unit Config.SQLite.SQLdb;
5+
6+
{$mode ObjFPC}{$H+}
7+
8+
interface
9+
10+
uses
11+
fpJSON, SysUtils, Classes, DB, Forms, StdCtrls, ExtCtrls, ValEdit,
12+
SQLDB, SQLite3Conn, SQLDBLib;
13+
14+
type
15+
16+
{ TSQLiteConfig }
17+
18+
TSQLiteConfig = class
19+
private
20+
FConn: TSQLConnector;
21+
FDataSet: TSQLQuery;
22+
FDriver: TSQLDBLibraryLoader;
23+
FTransaction: TSQLTransaction;
24+
function Validate: boolean;
25+
function GetDefaultDir(aFileName: string): string;
26+
public
27+
constructor Create(aFileName: string = 'config.db');
28+
destructor Destroy; override;
29+
function getValue(pKey: string): string;
30+
procedure UpdateConfig(aJSON: TJSONObject); overload;
31+
procedure UpdateConfig(aKey, aValue: string); overload;
32+
function LoadConfig: TJSONObject;
33+
procedure SaveForm(aForm: TForm);
34+
procedure LoadForm(aForm: TForm);
35+
function ValidaBanco: boolean;
36+
end;
37+
38+
implementation
39+
40+
{ TSQLiteConfig }
41+
42+
constructor TSQLiteConfig.Create(aFileName: string);
43+
begin
44+
FConn := TSQLConnector.Create(nil);
45+
FConn.Params.Add('LockingMode=normal');
46+
FConn.ConnectorType := 'SQLite3';
47+
FConn.DatabaseName := ExtractFilePath(ParamStr(0)) + aFileName;
48+
49+
FTransaction := TSQLTransaction.Create(nil);
50+
FTransaction.DataBase := FConn;
51+
52+
FDriver := TSQLDBLibraryLoader.Create(nil);
53+
FDriver.ConnectionType := 'SQLite3';
54+
FDriver.LibraryName := GetDefaultDir('sqlite3.dll');
55+
FDriver.Enabled := true;
56+
57+
FDataSet := TSQLQuery.Create(nil);
58+
FDataSet.DataBase := FConn;
59+
60+
if not Validate then
61+
raise Exception.Create(
62+
'sqlite3.dll precisa estar na raiz do projeto ou na pasta /lib');
63+
end;
64+
65+
destructor TSQLiteConfig.Destroy;
66+
begin
67+
FDataSet.Free;
68+
FTransaction.Free;
69+
FDriver.Free;
70+
FConn.Free;
71+
inherited;
72+
end;
73+
74+
function TSQLiteConfig.GetDefaultDir(aFileName: string): string;
75+
var
76+
DefaultDir, temp: string;
77+
begin
78+
DefaultDir := ExtractFileDir(ParamStr(0));
79+
temp := DefaultDir + '\lib\' + aFileName;
80+
if FileExists(temp) then
81+
Result := DefaultDir + '\lib\' + aFileName
82+
else
83+
Result := DefaultDir + '\' + aFileName;
84+
end;
85+
86+
function TSQLiteConfig.getValue(pKey: string): string;
87+
var
88+
SQL: TStringList;
89+
Idx: integer;
90+
JSON: TJSONObject;
91+
begin
92+
Result := '';
93+
Idx := 0;
94+
if pos('.', pKey) > 0 then
95+
Idx := pos('.', pKey);
96+
97+
SQL := TStringList.Create;
98+
try
99+
try
100+
SQL.Add('SELECT CFG_Value');
101+
SQL.Add(' FROM Config');
102+
SQL.Add(' WHERE CFG_Key = :CFG_Key');
103+
if Idx > 0 then
104+
SQL.Text := SQL.Text.Replace(':CFG_Key',
105+
QuotedStr(Copy(pKey, 0, Idx - 1)))
106+
else
107+
SQL.Text := SQL.Text.Replace(':CFG_Key', QuotedStr(pKey));
108+
109+
FDataSet.Close;
110+
FDataSet.SQL.Text := SQL.Text;
111+
FDataSet.Open;
112+
113+
if (Idx > 0) and (not FDataSet.IsEmpty) then
114+
begin
115+
JSON := TJSONObject.Create;
116+
try
117+
JSON := TJSONObject(GetJSON(FDataSet.Fields.Fields[0].AsString));
118+
Result := JSON.Get(Copy(pKey, Idx + 1, length(pKey)), '');
119+
finally
120+
JSON.Free;
121+
end;
122+
end
123+
else
124+
Result := FDataSet.Fields.Fields[0].AsString.Replace('"', '');
125+
FDataSet.Close;
126+
except
127+
Result := '';
128+
end;
129+
finally
130+
SQL.Free;
131+
end;
132+
end;
133+
134+
function TSQLiteConfig.LoadConfig: TJSONObject;
135+
begin
136+
Result := TJSONObject.Create;
137+
with FDataSet do
138+
begin
139+
Close;
140+
SQL.Clear;
141+
SQL.Add('SELECT CFG_Key, CFG_Value');
142+
SQL.Add(' FROM Config');
143+
Open;
144+
while not EOF do
145+
begin
146+
Result.Add(Fields.Fields[0].AsString, Fields.Fields[1].AsString);
147+
Next;
148+
end;
149+
Close;
150+
end;
151+
end;
152+
153+
procedure TSQLiteConfig.LoadForm(aForm: TForm);
154+
var
155+
I, J: integer;
156+
JSONTela, JSONItem: TJSONObject;
157+
Component: TComponent;
158+
begin
159+
JSONTela := LoadConfig;
160+
try
161+
for I := 0 to pred(aForm.ComponentCount) do
162+
begin
163+
Component := aForm.Components[I];
164+
if JSONTela.Get(Component.Name, '') <> '' then
165+
if Component is TEdit then
166+
TEdit(Component).Text := JSONTela.Get(Component.Name, '')
167+
else if Component is TComboBox then
168+
TComboBox(Component).ItemIndex := JSONTela.Get(Component.Name, 0)
169+
else if Component is TCheckBox then
170+
TCheckBox(Component).Checked := JSONTela.Get(Component.Name, False)
171+
else if Component is TLabeledEdit then
172+
TLabeledEdit(Component).Text := JSONTela.Get(Component.Name, '')
173+
else if Component is TValueListEditor then
174+
begin
175+
JSONItem := TJSONObject(
176+
GetJSON(JSONTela.Get(TValueListEditor(Component).Name, '')));
177+
if JSONItem <> nil then
178+
for J := 1 to pred(TValueListEditor(Component).RowCount) do
179+
TValueListEditor(Component).Cells[1, J] :=
180+
JSONItem.Get(TValueListEditor(Component).Keys[J], '');
181+
JSONItem.Free;
182+
end;
183+
end;
184+
finally
185+
JSONTela.Free;
186+
end;
187+
end;
188+
189+
procedure TSQLiteConfig.SaveForm(aForm: TForm);
190+
var
191+
I, J: integer;
192+
JSONTela, JSONItem: TJSONObject;
193+
component: TComponent;
194+
begin
195+
JSONTela := TJSONObject.Create;
196+
try
197+
for I := 0 to pred(aForm.ComponentCount) do
198+
begin
199+
Component := aForm.Components[I];
200+
if component.InheritsFrom(TEdit) then
201+
JSONTela.Add(component.Name, TEdit(component).Text)
202+
else if component.InheritsFrom(TComboBox) then
203+
JSONTela.Add(component.Name, TComboBox(component).ItemIndex)
204+
else if component.InheritsFrom(TCheckBox) then
205+
JSONTela.Add(component.Name, TCheckBox(component).Checked)
206+
else if component.InheritsFrom(TLabeledEdit) then
207+
JSONTela.Add(component.Name, TLabeledEdit(component).Text)
208+
else if component.InheritsFrom(TValueListEditor) then
209+
begin
210+
JSONItem := TJSONObject.Create;
211+
for J := 1 to pred(TValueListEditor(component).RowCount) do
212+
JSONItem.Add(TValueListEditor(component).Keys[J],
213+
TValueListEditor(component).Cells[1, J]);
214+
JSONTela.Add(TValueListEditor(component).Name, GetJSON(JSONItem.AsJSON));
215+
JSONItem.Free;
216+
end;
217+
end;
218+
UpdateConfig(JSONTela);
219+
finally
220+
JSONTela.Free;
221+
end;
222+
end;
223+
224+
procedure TSQLiteConfig.UpdateConfig(aJSON: TJSONObject);
225+
var
226+
I: integer;
227+
begin
228+
// exemplo entrada
229+
// {"key1":"value1", "key2":"value2", "key3":"value3", "key4":"value4", "key5":"value5"}
230+
// aJSON.Pairs[i].JSONString.Value = "key1",
231+
// aJSON.Pairs[i].JSONValue.Value = "value1";
232+
for I := 0 to pred(aJSON.Count) do
233+
begin
234+
if aJSON.Items[I] is TJSONObject then
235+
UpdateConfig(aJSON.Names[I], aJSON.Items[I].AsJSON)
236+
else
237+
UpdateConfig(aJSON.Names[I], aJSON.Items[I].Value);
238+
end;
239+
end;
240+
241+
procedure TSQLiteConfig.UpdateConfig(aKey, aValue: string);
242+
begin
243+
with FDataSet do
244+
begin
245+
Close;
246+
SQL.Clear;
247+
SQL.Add('INSERT INTO Config (CFG_KEY, CFG_VALUE) ');
248+
SQL.Add('VALUES (' + QuotedStr(aKey) + ', ' + QuotedStr(aValue) + ') ');
249+
SQL.Add('ON CONFLICT (CFG_KEY) DO UPDATE ');
250+
SQL.Add('SET CFG_VALUE = excluded.CFG_VALUE;');
251+
ExecSQL;
252+
Close;
253+
end;
254+
end;
255+
256+
function TSQLiteConfig.ValidaBanco: boolean;
257+
begin
258+
Result := False;
259+
try
260+
try
261+
FDataSet.SQL.Text := 'PRAGMA table_info("Config")';
262+
FDataSet.ExecSQL;
263+
Result := True;
264+
except
265+
Result := False;
266+
end;
267+
finally
268+
FDataSet.Close;
269+
end;
270+
end;
271+
272+
function TSQLiteConfig.Validate: boolean;
273+
begin
274+
Result := False;
275+
try
276+
with FDataSet do
277+
begin
278+
Close;
279+
SQL.Text := 'PRAGMA table_info("Config")';
280+
Open;
281+
if IsEmpty then
282+
begin
283+
Close;
284+
SQL.Clear;
285+
SQL.Add('CREATE TABLE Config(');
286+
SQL.Add(' CFG_Key varchar not null primary key');
287+
SQL.Add(', CFG_Value varchar');
288+
SQL.Add(');');
289+
ExecSQL;
290+
end;
291+
end;
292+
Result := True;
293+
except
294+
Result := False;
295+
end;
296+
end;
297+
298+
end.

0 commit comments

Comments
 (0)