Skip to content

Commit d44244f

Browse files
mobius1qwemobius1qwe
committed
+ Conversão de unit de Log.SQLite para gravar em thread.
 + Classe de Log em arquivo para Lazarus
1 parent 9bc29d6 commit d44244f

2 files changed

Lines changed: 190 additions & 24 deletions

File tree

‎log/lazarus/Log.SQLite.Zeos.pas‎

Lines changed: 107 additions & 24 deletions
Original file line numberDiff line numberDiff line change
@@ -8,21 +8,43 @@
88
interface
99

1010
uses
11-
ZConnection, ZDataSet, DB,
12-
SysUtils, fpJSON;
11+
SysUtils, Classes, fpJSON, DB,
12+
ZConnection, ZDataSet, ZSqlProcessor;
1313

1414
type
1515

16+
TLog = class;
17+
18+
{ TThreadedLog }
19+
20+
TThreadedLog = class(TThread)
21+
private
22+
FFileName: string;
23+
FLogObject: TJSONObject;
24+
FLog: TLog;
25+
procedure SetFileName(AValue: string);
26+
procedure SetLogObject(AValue: TJSONObject);
27+
protected
28+
procedure Execute; override;
29+
property FileName: string read FFileName write SetFileName;
30+
property LogObject: TJSONObject read FLogObject write SetLogObject;
31+
public
32+
constructor Create(AFileName: string; ALogObject: TJSONObject = nil); overload;
33+
constructor Create(AFileName: string; ASection, AValue: string); overload;
34+
destructor Destroy; override;
35+
end;
36+
1637
{ TLog }
1738

1839
TLog = class
1940
private
2041
FQuery: TZQuery;
2142
FConn: TZConnection;
43+
FThread: TThreadedLog;
2244
function ValidaBanco: boolean;
2345
function GetDefaultDir(aFileName: string): string;
2446
public
25-
constructor Create(aFileName: string = '');
47+
constructor Create(aFileName: string = 'log.db');
2648
destructor Destroy; override;
2749
procedure Log(aJSON: TJSONObject); overload;
2850
procedure Log(aEvent, aValue: string); overload;
@@ -36,18 +58,71 @@ TDataSetJSONHelper = class helper for TDataSet
3658

3759
implementation
3860

61+
{ TThreadedLog }
62+
63+
procedure TThreadedLog.SetFileName(AValue: string);
64+
begin
65+
if FFileName = AValue then Exit;
66+
FFileName := AValue;
67+
end;
68+
69+
procedure TThreadedLog.SetLogObject(AValue: TJSONObject);
70+
begin
71+
if FLogObject = AValue then Exit;
72+
FLogObject := AValue;
73+
end;
74+
75+
constructor TThreadedLog.Create(AFileName: string; ALogObject: TJSONObject);
76+
begin
77+
inherited Create(False);
78+
FreeOnTerminate := True;
79+
FileName := AFileName;
80+
if not Assigned(FLog) then
81+
FLog := TLog.Create(AFileName);
82+
83+
if ALogObject <> nil then
84+
LogObject := ALogObject;
85+
end;
86+
87+
constructor TThreadedLog.Create(AFileName: string; ASection, AValue: string);
88+
begin
89+
inherited Create(False);
90+
FreeOnTerminate := True;
91+
FileName := AFileName;
92+
if not Assigned(FLog) then
93+
FLog := TLog.Create(AFileName);
94+
95+
if not Assigned(LogObject) then
96+
LogObject := TJSONObject.Create;
97+
LogObject.Add('LOG_Data', DateTimeToStr(now));
98+
LogObject.Add('LOG_Evento', ASection);
99+
LogObject.Add('LOG_Conteudo', AValue);
100+
end;
101+
102+
destructor TThreadedLog.Destroy;
103+
begin
104+
if Assigned(FLog) then FLog.Free;
105+
inherited Destroy;
106+
end;
107+
108+
procedure TThreadedLog.Execute;
109+
begin
110+
FLog.Log(LogObject);
111+
end;
112+
39113
{ TLog }
40114

41115
constructor TLog.Create(aFileName: string);
116+
var
117+
zsqlproc: TZSQLProcessor;
42118
begin
43119
FConn := TZConnection.Create(nil);
44120
FConn.Protocol := 'sqlite-3';
45-
if aFileName.IsEmpty then
46-
FConn.Database := ExtractFilePath(ParamStr(0)) + 'log.db'
47-
else
48-
FConn.Database := ExtractFilePath(ParamStr(0)) + aFileName;
49-
FConn.Properties.Add('LockingMode=normal');
121+
FConn.Database := ExtractFilePath(ParamStr(0)) + aFileName;
50122
FConn.LibraryLocation := GetDefaultDir('sqlite3.dll');
123+
FConn.Connect;
124+
FConn.ExecuteDirect('PRAGMA locking_mode=NORMAL');
125+
FConn.ExecuteDirect('PRAGMA journal_mode=OFF');
51126

52127
FQuery := TZQuery.Create(nil);
53128
FQuery.Connection := FConn;
@@ -76,21 +151,6 @@ function TLog.GetDefaultDir(aFileName: string): string;
76151
Result := DefaultDir + '\' + aFileName;
77152
end;
78153

79-
function TLog.getLog: string;
80-
begin
81-
with FQuery do
82-
begin
83-
Close;
84-
SQL.Clear;
85-
SQL.Add('SELECT *');
86-
SQL.Add(' FROM Log');
87-
Open;
88-
Result := FQuery.ToJSON;
89-
90-
Close;
91-
end;
92-
end;
93-
94154
procedure TLog.Log(aEvent, aValue: string);
95155
var
96156
aJSON: TJSONObject;
@@ -106,6 +166,26 @@ procedure TLog.Log(aEvent, aValue: string);
106166
end;
107167
end;
108168

169+
function TLog.getLog: string;
170+
begin
171+
with FQuery do
172+
begin
173+
ReadOnly := True;
174+
Close;
175+
SQL.Clear;
176+
SQL.Add('SELECT ');
177+
SQL.Add(' LOG_ID ');
178+
SQL.Add(', CAST(LOG_Data AS VARCHAR) LOG_Data');
179+
SQL.Add(', LOG_Evento');
180+
SQL.Add(', LOG_Conteudo');
181+
SQL.Add(' FROM Log');
182+
Open;
183+
Result := FQuery.ToJSON;
184+
Close;
185+
ReadOnly := False;
186+
end;
187+
end;
188+
109189
procedure TLog.Log(aJSON: TJSONObject);
110190
var
111191
I: integer;
@@ -147,7 +227,7 @@ function TLog.ValidaBanco: boolean;
147227
SQL.Clear;
148228
SQL.Add('CREATE TABLE Log(');
149229
SQL.Add(' LOG_ID integer primary key');
150-
SQL.Add(', LOG_Data timestamp');
230+
SQL.Add(', LOG_Data varchar');
151231
SQL.Add(', LOG_Evento varchar');
152232
SQL.Add(', LOG_Conteudo varchar');
153233
SQL.Add(');');
@@ -174,8 +254,11 @@ function TDataSetJSONHelper.ToJSON: string;
174254
begin
175255
JSONObj := TJSONObject.Create;
176256
for I := 0 to pred(FieldCount) do
257+
begin
177258
if not Fields.Fields[I].AsString.IsEmpty then
178259
JSONObj.Add(Fields.Fields[I].FieldName, Fields.Fields[I].AsString);
260+
261+
end;
179262
JSONArr.Add(JSONObj);
180263
Next;
181264
end;

‎log/lazarus/Log.TextFile.pas‎

Lines changed: 83 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,83 @@
1+
// Maiores Informações
2+
// https://github.com/OpenSourceCommunityBrasil/PascalLibs/wiki
3+
4+
unit Log.TextFile;
5+
6+
{$mode objfpc}{$H+}
7+
8+
interface
9+
10+
uses
11+
SysUtils, Classes;
12+
13+
type
14+
15+
{ TLog }
16+
17+
TLog = class(TThread)
18+
private
19+
FFileName: string;
20+
FSection: string;
21+
FValue: string;
22+
protected
23+
procedure Execute; override;
24+
public
25+
constructor Create(ASection, AValue, AFileName: string);
26+
class procedure Log(ASection, AValue: string; AFileName: string = 'log.txt');
27+
destructor Destroy; override;
28+
end;
29+
30+
implementation
31+
32+
{ TLog }
33+
34+
constructor TLog.Create(ASection, AValue, AFileName: string);
35+
begin
36+
inherited Create(False);
37+
FreeOnTerminate := True;
38+
FFileName := AFileName;
39+
FSection := ASection;
40+
FValue := AValue;
41+
end;
42+
43+
destructor TLog.Destroy;
44+
begin
45+
46+
inherited Destroy;
47+
end;
48+
49+
procedure TLog.Execute;
50+
var
51+
FLogFile: Text;
52+
logdata: string;
53+
Confirma: boolean;
54+
begin
55+
logdata := FormatDateTime('dd/mm/yyyy hh:nn:ss', Now) + ' | ' +
56+
FSection + ' | ' + FValue;
57+
58+
Confirma := False;
59+
while not Confirma do
60+
try
61+
try
62+
AssignFile(FLogFile, FFileName);
63+
if FileExists(FFileName) then
64+
Append(FLogFile)
65+
else
66+
Rewrite(FLogFile);
67+
68+
Writeln(FlogFile, logdata);
69+
Confirma := True;
70+
except
71+
Confirma := False;
72+
end;
73+
finally
74+
CloseFile(FlogFile);
75+
end;
76+
end;
77+
78+
class procedure TLog.Log(ASection, AValue: string; AFileName: string);
79+
begin
80+
Create(ASection, AValue, AFileName);
81+
end;
82+
83+
end.

0 commit comments

Comments
 (0)