00001 {*********************************************************}
00002 { }
00003 { Zeos Database Objects }
00004 { SQL Monitor component }
00005 { }
00006 { Originally written by Sergey Seroukhov }
00007 { }
00008 {*********************************************************}
00009
00010 {@********************************************************}
00011 { Copyright (c) 1999-2006 Zeos Development Group }
00012 { }
00013 { License Agreement: }
00014 { }
00015 { This library is distributed in the hope that it will be }
00016 { useful, but WITHOUT ANY WARRANTY; without even the }
00017 { implied warranty of MERCHANTABILITY or FITNESS FOR }
00018 { A PARTICULAR PURPOSE. See the GNU Lesser General }
00019 { Public License for more details. }
00020 { }
00021 { The source code of the ZEOS Libraries and packages are }
00022 { distributed under the Library GNU General Public }
00023 { License (see the file COPYING / COPYING.ZEOS) }
00024 { with the following modification: }
00025 { As a special exception, the copyright holders of this }
00026 { library give you permission to link this library with }
00027 { independent modules to produce an executable, }
00028 { regardless of the license terms of these independent }
00029 { modules, and to copy and distribute the resulting }
00030 { executable under terms of your choice, provided that }
00031 { you also meet, for each linked independent module, }
00032 { the terms and conditions of the license of that module. }
00033 { An independent module is a module which is not derived }
00034 { from or based on this library. If you modify this }
00035 { library, you may extend this exception to your version }
00036 { of the library, but you are not obligated to do so. }
00037 { If you do not wish to do so, delete this exception }
00038 { statement from your version. }
00039 { }
00040 { }
00041 { The project web site is located on: }
00042 { http:
00043 { http:
00044 { svn:
00045 { }
00046 { http:
00047 { http:
00048 { }
00049 { }
00050 { }
00051 { Zeos Development Group. }
00052 {********************************************************@}
00053
00054 unit ZSqlMonitor;
00055
00056 interface
00057
00058 {$I ZComponent.inc}
00059
00060 uses
00061 SysUtils, Classes, Contnrs, ZClasses, ZCompatibility, ZDbcIntfs, ZDbcLogging;
00062
00063 type
00064
00065 {** Repeat declaration of TZLoggingEvent. }
00066 TZLoggingEvent = ZDbcLogging.TZLoggingEvent;
00067
00068 {** Declares event before logging. }
00069 TZTraceEvent = procedure(Sender: TObject; Event: TZLoggingEvent;
00070 var LogTrace: Boolean) of object;
00071
00072 {** Declares event after logging. }
00073 TZTraceLogEvent = procedure(Sender: TObject; Event: TZLoggingEvent) of object;
00074
00075 {**
00076 Implements an object to log events from SQL client.
00077 }
00078 TZSQLMonitor = class(TComponent, IZLoggingListener, IZInterface)
00079 private
00080 FActive: Boolean;
00081 FAutoSave: Boolean;
00082 FFileName: string;
00083 FMaxTraceCount: Integer;
00084 FTraceList: TObjectList;
00085 FOnTrace: TZTraceEvent;
00086 FOnLogTrace: TZTraceLogEvent;
00087
00088 function GetTraceCount: Integer;
00089 function GetTraceItem(Index: Integer): TZLoggingEvent;
00090 procedure SetActive(const Value: Boolean);
00091 procedure SetMaxTraceCount(const Value: Integer);
00092
00093 procedure TruncateTraceList(Count: Integer);
00094 procedure DoTrace(Event: TZLoggingEvent; var LogTrace: Boolean);
00095 procedure DoLogTrace(Event: TZLoggingEvent);
00096 public
00097 constructor Create(AOwner: TComponent); override;
00098 destructor Destroy; override;
00099
00100 procedure LogEvent(Event: TZLoggingEvent);
00101 procedure Save();
00102 procedure SaveToFile(const FileName: string);
00103
00104 property TraceCount: Integer read GetTraceCount;
00105 property TraceList[Index: Integer]: TZLoggingEvent read GetTraceItem;
00106 published
00107 property Active: Boolean read FActive write SetActive default False;
00108 property AutoSave: Boolean read FAutoSave write FAutoSave default False;
00109 property FileName: string read FFileName write FFileName;
00110 property MaxTraceCount: Integer read FMaxTraceCount write SetMaxTraceCount;
00111
00112 property OnTrace: TZTraceEvent read FOnTrace write FOnTrace;
00113 property OnLogTrace: TZTraceLogEvent read FOnLogTrace write FOnLogTrace;
00114 end;
00115
00116 implementation
00117
00118 { TZSQLMonitor }
00119
00120 {**
00121 Constructs this object and assignes main properties.
00122 @param AOwner a component owner.
00123 }
00124 constructor TZSQLMonitor.Create(AOwner: TComponent);
00125 begin
00126 inherited Create(AOwner);
00127 FTraceList := TObjectList.Create;
00128 FMaxTraceCount := 100;
00129 end;
00130
00131 {**
00132 Destroys this object and cleanups the memory.
00133 }
00134 destructor TZSQLMonitor.Destroy;
00135 begin
00136 SetActive(False);
00137 FTraceList.Free;
00138 inherited Destroy;
00139 end;
00140
00141 {**
00142 Gets a number of stored logging events.
00143 @returns a number of stored logging events.
00144 }
00145 function TZSQLMonitor.GetTraceCount: Integer;
00146 begin
00147 Result := FTraceList.Count;
00148 end;
00149
00150 {**
00151 Gets a logging event by it's index.
00152 @param Index an event index.
00153 @retuns a requested event object.
00154 }
00155 function TZSQLMonitor.GetTraceItem(Index: Integer): TZLoggingEvent;
00156 begin
00157 Result := TZLoggingEvent(FTraceList[Index]);
00158 end;
00159
00160 {**
00161 Sets an active state for this monitor.
00162 @param Value <code>True</code> to activate this monitor
00163 and <code>False</code> to deactivate it.
00164 }
00165 procedure TZSQLMonitor.SetActive(const Value: Boolean);
00166 begin
00167 if FActive <> Value then
00168 begin
00169 if Value then
00170 DriverManager.AddLoggingListener(Self)
00171 else
00172 if Assigned(DriverManager) then
00173 DriverManager.RemoveLoggingListener(Self);
00174 FActive := Value;
00175 end;
00176 end;
00177
00178 {**
00179 Sets a new number of logging events in the storage.
00180 @param Value a new number of logging events.
00181 }
00182 procedure TZSQLMonitor.SetMaxTraceCount(const Value: Integer);
00183 begin
00184 if Value <> FMaxTraceCount then
00185 begin
00186 FMaxTraceCount := Value;
00187 TruncateTraceList(Value);
00188 end;
00189 end;
00190
00191 {**
00192 Truncates a storage of logging events to the specified limit.
00193 @param Count a number of events in the storage.
00194 }
00195 procedure TZSQLMonitor.TruncateTraceList(Count: Integer);
00196 begin
00197 while FTraceList.Count > Count do
00198 FTraceList.Delete(0);
00199 end;
00200
00201 {**
00202 Invokes an event listener after logging event.
00203 @param Event a logging event object.
00204 }
00205 procedure TZSQLMonitor.DoLogTrace(Event: TZLoggingEvent);
00206 begin
00207 if Assigned(FOnLogTrace) then
00208 FOnLogTrace(Self, Event);
00209 end;
00210
00211 {**
00212 Invokes an event listener before logging event.
00213 @param Event a logging event object.
00214 @param LogTrace a flag which switches storing the event.
00215 }
00216 procedure TZSQLMonitor.DoTrace(Event: TZLoggingEvent;
00217 var LogTrace: Boolean);
00218 begin
00219 if Assigned(FOnTrace) then
00220 FOnTrace(Self, Event, LogTrace);
00221 end;
00222
00223 {**
00224 Saves the logging events into predefined file
00225 set in FileName property.
00226 }
00227 procedure TZSQLMonitor.Save;
00228 begin
00229 SaveToFile(FFileName);
00230 end;
00231
00232 {**
00233 Saves the logging events to the specified file.
00234 @param FileName a name of the file to write the events.
00235 }
00236 procedure TZSQLMonitor.SaveToFile(const FileName: string);
00237 var
00238 I: Integer;
00239 Stream: TFileStream;
00240 Temp: string;
00241 Buffer: PChar;
00242 begin
00243 if not FileExists(FileName) then
00244 Stream := TFileStream.Create(FileName, fmCreate)
00245 else
00246 Stream := TFileStream.Create(FileName, fmOpenWrite or fmShareDenyWrite);
00247 try
00248 for I := 0 to FTraceList.Count - 1 do
00249 begin
00250 Temp := TZLoggingEvent(FTraceList[I]).AsString + LineEnding;
00251 Buffer := PChar(Temp);
00252 Stream.Write(Buffer^, StrLen(Buffer));
00253 end;
00254 finally
00255 Stream.Free;
00256 end;
00257 end;
00258
00259 {**
00260 Handles a new incoming logging event.
00261 @param Event an incoming logging event.
00262 }
00263 procedure TZSQLMonitor.LogEvent(Event: TZLoggingEvent);
00264 var
00265 LogTrace: Boolean;
00266 Stream: TFileStream;
00267 Temp: string;
00268 Buffer: PChar;
00269 begin
00270 LogTrace := True;
00271 DoTrace(Event, LogTrace);
00272 if not LogTrace then Exit;
00273
00274 { Store the event. }
00275 if FMaxTraceCount <> 0 then
00276 begin
00277 if FMaxTraceCount > 0 then
00278 TruncateTraceList(FMaxTraceCount - 1);
00279 FTraceList.Add(TZLoggingEvent.Create(Event.Category, Event.Protocol,
00280 Event.Message, Event.ErrorCode, Event.Error));
00281 end;
00282
00283 { Save the event. }
00284 if FAutoSave and (FFileName <> '') then
00285 begin
00286 if not FileExists(FFileName) then
00287 Stream := TFileStream.Create(FFileName, fmCreate)
00288 else
00289 Stream := TFileStream.Create(FFileName, fmOpenReadWrite or fmShareDenyWrite);
00290 try
00291 Stream.Seek(0, soFromEnd);
00292 Temp := Event.AsString + LineEnding;
00293 Buffer := PChar(Temp);
00294 Stream.Write(Buffer^, StrLen(Buffer));
00295 finally
00296 Stream.Free;
00297 end;
00298 end;
00299
00300 DoLogTrace(Event);
00301 end;
00302
00303 end.