david
13eee3f7f4
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@20 c37d764d-f447-7644-a108-883140d013fb
761 lines
27 KiB
ObjectPascal
761 lines
27 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ Project JEDI Code Library (JCL) }
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License"); }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/ }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either express or implied. See the License for the specific language governing rights }
|
|
{ and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is JclDebugSerialization.pas. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Uwe Schuster. }
|
|
{ Portions created by Uwe Schuster are Copyright (C) 2009 Uwe Schuster. All rights reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ Uwe Schuster (uschuster) }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Last modified: $Date:: 2009-08-10 23:20:25 +0200 (lun., 10 août 2009) $ }
|
|
{ Revision: $Rev:: 2943 $ }
|
|
{ Author: $Author:: outchy $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
unit JclDebugSerialization;
|
|
|
|
{$I jcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
SysUtils, Classes, Contnrs,
|
|
{$IFDEF UNITVERSIONING}
|
|
JclUnitVersioning,
|
|
{$ENDIF UNITVERSIONING}
|
|
JclDebug;
|
|
|
|
type
|
|
TJclCustomSimpleSerializer = class(TObject)
|
|
protected
|
|
FItems: TObjectList;
|
|
FName: string;
|
|
FValues: TStringList;
|
|
function GetCount: Integer;
|
|
function GetItems(AIndex: Integer): TJclCustomSimpleSerializer;
|
|
public
|
|
constructor Create(const AName: string);
|
|
destructor Destroy; override;
|
|
function AddChild(ASender: TObject; const AName: string): TJclCustomSimpleSerializer;
|
|
procedure Clear;
|
|
function ReadString(ASender: TObject; const AName: string): string;
|
|
procedure WriteString(ASender: TObject; const AName: string; const AValue: string);
|
|
property Count: Integer read GetCount;
|
|
property Items[AIndex: Integer]: TJclCustomSimpleSerializer read GetItems; default;
|
|
property Name: string read FName;
|
|
property Values: TStringList read FValues;
|
|
end;
|
|
|
|
TJclSerializableLocationInfo = class(TJclLocationInfoEx)
|
|
public
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
end;
|
|
|
|
TJclSerializableLocationInfoList = class(TJclCustomLocationInfoList)
|
|
private
|
|
function GetItems(AIndex: Integer): TJclSerializableLocationInfo;
|
|
public
|
|
constructor Create; override;
|
|
function Add(Addr: Pointer): TJclSerializableLocationInfo;
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
property Items[AIndex: Integer]: TJclSerializableLocationInfo read GetItems; default;
|
|
end;
|
|
|
|
TJclSerializableThreadInfo = class(TJclCustomThreadInfo)
|
|
private
|
|
function GetStack(const AIndex: Integer): TJclSerializableLocationInfoList;
|
|
protected
|
|
function GetStackClass: TJclCustomLocationInfoListClass; override;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
property CreationStack: TJclSerializableLocationInfoList index 1 read GetStack;
|
|
property Stack: TJclSerializableLocationInfoList index 2 read GetStack;
|
|
end;
|
|
|
|
TJclSerializableThreadInfoList = class(TPersistent)
|
|
private
|
|
FItems: TObjectList;
|
|
function GetItems(AIndex: Integer): TJclSerializableThreadInfo;
|
|
function GetCount: Integer;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Add: TJclSerializableThreadInfo;
|
|
procedure Assign(Source: TPersistent); override;
|
|
procedure Clear;
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
property Count: Integer read GetCount;
|
|
property Items[AIndex: Integer]: TJclSerializableThreadInfo read GetItems; default;
|
|
end;
|
|
|
|
TJclSerializableException = class(TPersistent)
|
|
private
|
|
FExceptionClassName: string;
|
|
FExceptionMessage: string;
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
public
|
|
procedure Clear;
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
property ExceptionClassName: string read FExceptionClassName write FExceptionClassName;
|
|
property ExceptionMessage: string read FExceptionMessage write FExceptionMessage;
|
|
end;
|
|
|
|
TJclSerializableModuleInfo = class(TPersistent)
|
|
private
|
|
FStartStr: string;
|
|
FEndStr: string;
|
|
FSystemModuleStr: string;
|
|
FModuleName: string;
|
|
FBinFileVersion: string;
|
|
FFileVersion: string;
|
|
FFileDescription: string;
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
public
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
property StartStr: string read FStartStr write FStartStr;
|
|
property EndStr: string read FEndStr write FEndStr;
|
|
property SystemModuleStr: string read FSystemModuleStr write FSystemModuleStr;
|
|
property ModuleName: string read FModuleName write FModuleName;
|
|
property BinFileVersion: string read FBinFileVersion write FBinFileVersion;
|
|
property FileVersion: string read FFileVersion write FFileVersion;
|
|
property FileDescription: string read FFileDescription write FFileDescription;
|
|
end;
|
|
|
|
TJclSerializableModuleInfoList = class(TPersistent)
|
|
private
|
|
FItems: TObjectList;
|
|
function GetCount: Integer;
|
|
function GetItems(AIndex: Integer): TJclSerializableModuleInfo;
|
|
protected
|
|
procedure AssignTo(Dest: TPersistent); override;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
function Add: TJclSerializableModuleInfo;
|
|
procedure Clear;
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
property Count: Integer read GetCount;
|
|
property Items[AIndex: Integer]: TJclSerializableModuleInfo read GetItems; default;
|
|
end;
|
|
|
|
TJclSerializableExceptionInfo = class(TObject)
|
|
private
|
|
FException: TJclSerializableException;
|
|
FThreadInfoList: TJclSerializableThreadInfoList;
|
|
FModules: TJclSerializableModuleInfoList;
|
|
public
|
|
constructor Create;
|
|
destructor Destroy; override;
|
|
procedure Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
procedure Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
property ThreadInfoList: TJclSerializableThreadInfoList read FThreadInfoList;
|
|
property Exception: TJclSerializableException read FException;
|
|
property Modules: TJclSerializableModuleInfoList read FModules;
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
const
|
|
UnitVersioning: TUnitVersionInfo = (
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/source/windows/JclDebugSerialization.pas $';
|
|
Revision: '$Revision: 2943 $';
|
|
Date: '$Date: 2009-08-10 23:20:25 +0200 (lun., 10 août 2009) $';
|
|
LogPath: 'JCL\source\windows';
|
|
Extra: '';
|
|
Data: nil
|
|
);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
implementation
|
|
|
|
uses
|
|
JclDateTime;
|
|
|
|
const
|
|
MinutesPerDay = 60 * 24;
|
|
|
|
{ TODO -oUSc : move to JclDateTime }
|
|
function ISOFormatStrToDateTime(const AISOFormatTimeStampStr: string; ADefault: TDateTime): TDateTime;
|
|
var
|
|
Year, Month, Day, Hour, Minute, Second: Word;
|
|
begin
|
|
Result := ADefault;
|
|
{ TODO -oUSc : make it more generics to accept for exam. milliseconds }
|
|
if (Length(AISOFormatTimeStampStr) = 25) or ((Length(AISOFormatTimeStampStr) = 20) and
|
|
(AISOFormatTimeStampStr[20] = 'Z')) then
|
|
begin
|
|
if (AISOFormatTimeStampStr[5] = '-') and (AISOFormatTimeStampStr[8] = '-') and
|
|
(AISOFormatTimeStampStr[11] = 'T') and (AISOFormatTimeStampStr[14] = ':') and
|
|
(AISOFormatTimeStampStr[17] = ':') then
|
|
begin
|
|
Year := StrToInt(Copy(AISOFormatTimeStampStr, 1, 4));
|
|
Month := StrToInt(Copy(AISOFormatTimeStampStr, 6, 2));
|
|
Day := StrToInt(Copy(AISOFormatTimeStampStr, 9, 2));
|
|
Hour := StrToInt(Copy(AISOFormatTimeStampStr, 12, 2));
|
|
Minute := StrToInt(Copy(AISOFormatTimeStampStr, 15, 2));
|
|
Second := StrToInt(Copy(AISOFormatTimeStampStr, 18, 2));
|
|
Result := EncodeDate(Year, Month, Day) + EncodeTime(Hour, Minute, Second, 0);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function ISOFormatStrToLocalDateTime(const AISOFormatTimeStampStr: string; ADefault: TDateTime): TDateTime;
|
|
begin
|
|
Result := ISOFormatStrToDateTime(AISOFormatTimeStampStr, ADefault);
|
|
Result := DateTimeToLocalDateTime(Result);
|
|
end;
|
|
|
|
function DateTimeToISOFormatStr(ATimeStamp: TDateTime; ABias: Longint): string;
|
|
var
|
|
TimeZoneAsDateTime: TDateTime;
|
|
S: string;
|
|
begin
|
|
Result := FormatDateTime('yyyy-mm-dd"T"hh:nn:ss', ATimeStamp);
|
|
TimeZoneAsDateTime := ABias / MinutesPerDay;
|
|
S := FormatDateTime('hh:nn', Abs(TimeZoneAsDateTime));
|
|
if ABias > 0 then
|
|
Result := Result + '+' + S
|
|
else
|
|
if ABias = 0 then
|
|
Result := Result + 'Z'
|
|
else
|
|
Result := Result + '-' + S;
|
|
end;
|
|
|
|
function LocalDateTimeToISOFormatStr(ATimeStamp: TDateTime): string;
|
|
var
|
|
UTCTimeStamp, TimeZoneAsDateTime: TDateTime;
|
|
begin
|
|
UTCTimeStamp := LocalDateTimeToDateTime(ATimeStamp);
|
|
TimeZoneAsDateTime := ATimeStamp - UTCTimeStamp;
|
|
Result := DateTimeToISOFormatStr(UTCTimeStamp, Round(TimeZoneAsDateTime * MinutesPerDay));
|
|
end;
|
|
|
|
//=== { TJclCustomSimpleSerializer } =========================================
|
|
|
|
constructor TJclCustomSimpleSerializer.Create(const AName: string);
|
|
begin
|
|
inherited Create;
|
|
FItems := TObjectList.Create;
|
|
FName := AName;
|
|
FValues := TStringList.Create;
|
|
end;
|
|
|
|
destructor TJclCustomSimpleSerializer.Destroy;
|
|
begin
|
|
FValues.Free;
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclCustomSimpleSerializer.AddChild(ASender: TObject; const AName: string): TJclCustomSimpleSerializer;
|
|
begin
|
|
FItems.Add(TJclCustomSimpleSerializer.Create(AName));
|
|
Result := TJclCustomSimpleSerializer(FItems.Last);
|
|
end;
|
|
|
|
procedure TJclCustomSimpleSerializer.Clear;
|
|
begin
|
|
FItems.Clear;
|
|
FValues.Clear;
|
|
FName := '';
|
|
end;
|
|
|
|
function TJclCustomSimpleSerializer.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TJclCustomSimpleSerializer.GetItems(AIndex: Integer): TJclCustomSimpleSerializer;
|
|
begin
|
|
Result := TJclCustomSimpleSerializer(FItems[AIndex]);
|
|
end;
|
|
|
|
function TJclCustomSimpleSerializer.ReadString(ASender: TObject; const AName: string): string;
|
|
begin
|
|
Result := FValues.Values[AName];
|
|
end;
|
|
|
|
procedure TJclCustomSimpleSerializer.WriteString(ASender: TObject; const AName: string; const AValue: string);
|
|
begin
|
|
FValues.Add(Format('%s=%s', [AName, AValue]));
|
|
end;
|
|
|
|
//=== { TJclSerializableThreadInfoList } =====================================
|
|
|
|
constructor TJclSerializableThreadInfoList.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TObjectList.Create;
|
|
end;
|
|
|
|
destructor TJclSerializableThreadInfoList.Destroy;
|
|
begin
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclSerializableThreadInfoList.Add: TJclSerializableThreadInfo;
|
|
begin
|
|
FItems.Add(TJclSerializableThreadInfo.Create);
|
|
Result := TJclSerializableThreadInfo(FItems.Last);
|
|
end;
|
|
|
|
procedure TJclSerializableThreadInfoList.Assign(Source: TPersistent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Source is TJclThreadInfoList then
|
|
begin
|
|
Clear;
|
|
for I := 0 to TJclThreadInfoList(Source).Count - 1 do
|
|
Add.Assign(TJclThreadInfoList(Source)[I]);
|
|
end
|
|
else
|
|
inherited Assign(Source);
|
|
end;
|
|
|
|
procedure TJclSerializableThreadInfoList.Clear;
|
|
begin
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function TJclSerializableThreadInfoList.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TJclSerializableThreadInfoList.GetItems(AIndex: Integer): TJclSerializableThreadInfo;
|
|
begin
|
|
Result := TJclSerializableThreadInfo(FItems[AIndex]);
|
|
end;
|
|
|
|
procedure TJclSerializableThreadInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Clear;
|
|
for I := 0 to ASerializer.Count - 1 do
|
|
if ASerializer[I].Name = 'ThreadInfo' then
|
|
Add.Deserialize(ASerializer[I]);
|
|
end;
|
|
|
|
procedure TJclSerializableThreadInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Items[I].Serialize(ASerializer.AddChild(Self, 'ThreadInfo'));
|
|
end;
|
|
|
|
//=== { TJclSerializableLocationInfo } =======================================
|
|
|
|
procedure TJclSerializableLocationInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
S, SOffsetFromProcName, SLineNumberOffsetFromProcedureStart: string;
|
|
begin
|
|
Values := [];
|
|
SOffsetFromProcName := ASerializer.ReadString(Self, 'OffsetFromProcName');
|
|
if SOffsetFromProcName <> '' then
|
|
Values := Values + [lievLocationInfo];
|
|
SLineNumberOffsetFromProcedureStart := ASerializer.ReadString(Self, 'LineNumberOffsetFromProcedureStart');
|
|
if SLineNumberOffsetFromProcedureStart <> '' then
|
|
Values := Values + [lievProcedureStartLocationInfo];
|
|
S := ASerializer.ReadString(Self, 'VAddress');
|
|
VAddress := Pointer(StrToIntDef('$' + S, 0));
|
|
ModuleName := ASerializer.ReadString(Self, 'ModuleName');
|
|
S := ASerializer.ReadString(Self, 'Address');
|
|
Address := Pointer(StrToIntDef('$' + S, 0));
|
|
OffsetFromProcName := StrToIntDef('$' + SOffsetFromProcName, 0);
|
|
SourceUnitName := ASerializer.ReadString(Self, 'UnitName');
|
|
ProcedureName := ASerializer.ReadString(Self, 'ProcedureName');
|
|
SourceName := ASerializer.ReadString(Self, 'SourceName');
|
|
S := ASerializer.ReadString(Self, 'LineNumber');
|
|
LineNumber := StrToIntDef(S, -1);
|
|
S := ASerializer.ReadString(Self, 'OffsetFromLineNumber');
|
|
OffsetFromLineNumber := StrToIntDef(S, -1);
|
|
LineNumberOffsetFromProcedureStart := StrToIntDef(SLineNumberOffsetFromProcedureStart, -1);
|
|
UnitVersionDateTime := ISOFormatStrToDateTime(ASerializer.ReadString(Self, 'UnitVersionDateTime'), 0);
|
|
UnitVersionExtra := ASerializer.ReadString(Self, 'UnitVersionExtra');
|
|
UnitVersionLogPath := ASerializer.ReadString(Self, 'UnitVersionLogPath');
|
|
UnitVersionRCSfile := ASerializer.ReadString(Self, 'UnitVersionRCSfile');
|
|
UnitVersionRevision := ASerializer.ReadString(Self, 'UnitVersionRevision');
|
|
end;
|
|
|
|
procedure TJclSerializableLocationInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
S: string;
|
|
begin
|
|
S := '';
|
|
ASerializer.WriteString(Self, 'VAddress', Format('%p', [VAddress]));
|
|
ASerializer.WriteString(Self, 'ModuleName', ModuleName);
|
|
ASerializer.WriteString(Self, 'Address', Format('%p', [Address]));
|
|
if lievLocationInfo in Values then
|
|
begin
|
|
ASerializer.WriteString(Self, 'OffsetFromProcName', Format('+ $%x', [OffsetFromProcName]));
|
|
ASerializer.WriteString(Self, 'UnitName', SourceUnitName);
|
|
ASerializer.WriteString(Self, 'ProcedureName', ProcedureName);
|
|
ASerializer.WriteString(Self, 'SourceName', SourceName);
|
|
if LineNumber > 0 then
|
|
begin
|
|
ASerializer.WriteString(Self, 'LineNumber', IntToStr(LineNumber));
|
|
if OffsetFromLineNumber >= 0 then
|
|
S := S + Format('+ $%x', [OffsetFromLineNumber])
|
|
else
|
|
S := S + Format('- $%x', [-OffsetFromLineNumber]);
|
|
ASerializer.WriteString(Self, 'OffsetFromLineNumber', S);
|
|
end;
|
|
if lievProcedureStartLocationInfo in Values then
|
|
ASerializer.WriteString(Self, 'LineNumberOffsetFromProcedureStart', IntToStr(LineNumberOffsetFromProcedureStart));
|
|
end;
|
|
if lievUnitVersionInfo in Values then
|
|
begin
|
|
ASerializer.WriteString(Self, 'UnitVersionDateTime', DateTimeToISOFormatStr(UnitVersionDateTime, 0));
|
|
ASerializer.WriteString(Self, 'UnitVersionExtra', UnitVersionExtra);
|
|
ASerializer.WriteString(Self, 'UnitVersionLogPath', UnitVersionLogPath);
|
|
ASerializer.WriteString(Self, 'UnitVersionRCSfile', UnitVersionRCSfile);
|
|
ASerializer.WriteString(Self, 'UnitVersionRevision', UnitVersionRevision);
|
|
end;
|
|
end;
|
|
|
|
//=== { TJclSerializableLocationInfoList } ===================================
|
|
|
|
function TJclSerializableLocationInfoList.Add(Addr: Pointer): TJclSerializableLocationInfo;
|
|
begin
|
|
Result := TJclSerializableLocationInfo(InternalAdd(Addr));
|
|
end;
|
|
|
|
constructor TJclSerializableLocationInfoList.Create;
|
|
begin
|
|
inherited Create;
|
|
FItemClass := TJclSerializableLocationInfo;
|
|
FOptions := [];
|
|
end;
|
|
|
|
function TJclSerializableLocationInfoList.GetItems(AIndex: Integer): TJclSerializableLocationInfo;
|
|
begin
|
|
Result := TJclSerializableLocationInfo(FItems[AIndex]);
|
|
end;
|
|
|
|
procedure TJclSerializableLocationInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Clear;
|
|
for I := 0 to ASerializer.Count - 1 do
|
|
if ASerializer[I].Name = 'LocationInfo' then
|
|
Add(nil).Deserialize(ASerializer[I]);
|
|
end;
|
|
|
|
procedure TJclSerializableLocationInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Items[I].Serialize(ASerializer.AddChild(Self, 'LocationInfo'));
|
|
end;
|
|
|
|
//=== { TJclSerializableThreadInfo } =========================================
|
|
|
|
constructor TJclSerializableThreadInfo.Create;
|
|
begin
|
|
inherited Create;
|
|
end;
|
|
|
|
destructor TJclSerializableThreadInfo.Destroy;
|
|
begin
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclSerializableThreadInfo.GetStack(const AIndex: Integer): TJclSerializableLocationInfoList;
|
|
begin
|
|
case AIndex of
|
|
1: Result := TJclSerializableLocationInfoList(FCreationStack);
|
|
2: Result := TJclSerializableLocationInfoList(FStack);
|
|
else
|
|
Result := nil;
|
|
end;
|
|
end;
|
|
|
|
function TJclSerializableThreadInfo.GetStackClass: TJclCustomLocationInfoListClass;
|
|
begin
|
|
Result := TJclSerializableLocationInfoList;
|
|
end;
|
|
|
|
procedure TJclSerializableThreadInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
S: string;
|
|
I: Integer;
|
|
begin
|
|
Values := [];
|
|
S := ASerializer.ReadString(Self, 'ThreadID');
|
|
ThreadID := StrToIntDef(S, 0);
|
|
if ASerializer.ReadString(Self, 'MainThread') = '1' then
|
|
Values := Values + [tioIsMainThread];
|
|
S := ASerializer.ReadString(Self, 'Name');
|
|
if S <> '' then
|
|
begin
|
|
Name := S;
|
|
Values := Values + [tioName];
|
|
end;
|
|
S := ASerializer.ReadString(Self, 'CreationTime');
|
|
if S <> '' then
|
|
begin
|
|
CreationTime := ISOFormatStrToLocalDateTime(S, 0);
|
|
if CreationTime > 0 then
|
|
Values := Values + [tioCreationTime];
|
|
end;
|
|
S := ASerializer.ReadString(Self, 'ParentThreadID');
|
|
if S <> '' then
|
|
begin
|
|
ParentThreadID := StrToIntDef(S, 0);
|
|
if ParentThreadID <> 0 then
|
|
Values := Values + [tioParentThreadID];
|
|
end;
|
|
for I := 0 to ASerializer.Count - 1 do
|
|
if ASerializer[I].Name = 'Stack' then
|
|
begin
|
|
Stack.Deserialize(ASerializer[I]);
|
|
Values := Values + [tioStack];
|
|
end
|
|
else
|
|
if ASerializer[I].Name = 'CreationStack' then
|
|
begin
|
|
CreationStack.Deserialize(ASerializer[I]);
|
|
Values := Values + [tioCreationStack];
|
|
end;
|
|
end;
|
|
|
|
procedure TJclSerializableThreadInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
begin
|
|
ASerializer.WriteString(Self, 'ThreadID', IntToStr(ThreadID));
|
|
if tioIsMainThread in Values then
|
|
ASerializer.WriteString(Self, 'MainThread', '1');
|
|
if tioName in Values then
|
|
ASerializer.WriteString(Self, 'Name', Name);
|
|
if tioCreationTime in Values then
|
|
ASerializer.WriteString(Self, 'CreationTime', LocalDateTimeToISOFormatStr(CreationTime));
|
|
if tioParentThreadID in Values then
|
|
ASerializer.WriteString(Self, 'ParentThreadID', IntToStr(ParentThreadID));
|
|
if tioStack in Values then
|
|
Stack.Serialize(ASerializer.AddChild(Self, 'Stack'));
|
|
if tioCreationStack in Values then
|
|
CreationStack.Serialize(ASerializer.AddChild(Self, 'CreationStack'));
|
|
end;
|
|
|
|
//=== { TExceptionInfo } =====================================================
|
|
|
|
constructor TJclSerializableExceptionInfo.Create;
|
|
begin
|
|
inherited Create;
|
|
FException := TJclSerializableException.Create;
|
|
FThreadInfoList := TJclSerializableThreadInfoList.Create;
|
|
FModules := TJclSerializableModuleInfoList.Create;
|
|
end;
|
|
|
|
destructor TJclSerializableExceptionInfo.Destroy;
|
|
begin
|
|
FModules.Free;
|
|
FException.Free;
|
|
FThreadInfoList.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TJclSerializableExceptionInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
FThreadInfoList.Clear;
|
|
FException.Clear;
|
|
FModules.Clear;
|
|
for I := 0 to ASerializer.Count - 1 do
|
|
if ASerializer[I].Name = 'ThreadInfo' then
|
|
FThreadInfoList.Deserialize(ASerializer[I])
|
|
else
|
|
if ASerializer[I].Name = 'Exception' then
|
|
FException.Deserialize(ASerializer[I])
|
|
else
|
|
if ASerializer[I].Name = 'Modules' then
|
|
FModules.Deserialize(ASerializer[I]);
|
|
end;
|
|
|
|
procedure TJclSerializableExceptionInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
begin
|
|
FThreadInfoList.Serialize(ASerializer.AddChild(Self, 'ThreadInfo'));
|
|
FException.Serialize(ASerializer.AddChild(Self, 'Exception'));
|
|
FModules.Serialize(ASerializer.AddChild(Self, 'Modules'));
|
|
end;
|
|
|
|
//=== { TException } =========================================================
|
|
|
|
procedure TJclSerializableException.AssignTo(Dest: TPersistent);
|
|
begin
|
|
if Dest is TJclSerializableException then
|
|
begin
|
|
TJclSerializableException(Dest).FExceptionClassName := FExceptionClassName;
|
|
TJclSerializableException(Dest).FExceptionMessage := FExceptionMessage;
|
|
end
|
|
else
|
|
inherited AssignTo(Dest);
|
|
end;
|
|
|
|
procedure TJclSerializableException.Clear;
|
|
begin
|
|
FExceptionClassName := '';
|
|
FExceptionMessage := '';
|
|
end;
|
|
|
|
procedure TJclSerializableException.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
begin
|
|
Clear;
|
|
FExceptionClassName := ASerializer.ReadString(Self, 'ClassName');
|
|
FExceptionMessage := ASerializer.ReadString(Self, 'Message');
|
|
end;
|
|
|
|
procedure TJclSerializableException.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
begin
|
|
ASerializer.WriteString(Self, 'ClassName', FExceptionClassName);
|
|
ASerializer.WriteString(Self, 'Message', FExceptionMessage);
|
|
end;
|
|
|
|
//=== { TModule } ============================================================
|
|
|
|
procedure TJclSerializableModuleInfo.AssignTo(Dest: TPersistent);
|
|
begin
|
|
if Dest is TJclSerializableModuleInfo then
|
|
begin
|
|
TJclSerializableModuleInfo(Dest).FStartStr := FStartStr;
|
|
TJclSerializableModuleInfo(Dest).FEndStr := FEndStr;
|
|
TJclSerializableModuleInfo(Dest).FSystemModuleStr := FSystemModuleStr;
|
|
TJclSerializableModuleInfo(Dest).FModuleName := FModuleName;
|
|
TJclSerializableModuleInfo(Dest).FBinFileVersion := FBinFileVersion;
|
|
TJclSerializableModuleInfo(Dest).FFileVersion := FFileVersion;
|
|
TJclSerializableModuleInfo(Dest).FFileDescription := FFileDescription;
|
|
end
|
|
else
|
|
inherited AssignTo(Dest);
|
|
end;
|
|
|
|
procedure TJclSerializableModuleInfo.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
begin
|
|
FStartStr := ASerializer.ReadString(Self, 'StartAddr');
|
|
FEndStr := ASerializer.ReadString(Self, 'EndAddr');
|
|
FSystemModuleStr := ASerializer.ReadString(Self, 'SystemModule');
|
|
FModuleName := ASerializer.ReadString(Self, 'FileName');
|
|
FBinFileVersion := ASerializer.ReadString(Self, 'BinFileVersion');
|
|
FFileVersion := ASerializer.ReadString(Self, 'FileVersion');
|
|
FFileDescription := ASerializer.ReadString(Self, 'FileDescription');
|
|
end;
|
|
|
|
procedure TJclSerializableModuleInfo.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
begin
|
|
ASerializer.WriteString(Self, 'StartAddr', FStartStr);
|
|
ASerializer.WriteString(Self, 'EndAddr', FEndStr);
|
|
ASerializer.WriteString(Self, 'SystemModule', FSystemModuleStr);
|
|
ASerializer.WriteString(Self, 'FileName', FModuleName);
|
|
ASerializer.WriteString(Self, 'BinFileVersion', FBinFileVersion);
|
|
ASerializer.WriteString(Self, 'FileVersion', FFileVersion);
|
|
ASerializer.WriteString(Self, 'FileDescription', FFileDescription);
|
|
end;
|
|
|
|
//=== { TModuleList } ========================================================
|
|
|
|
constructor TJclSerializableModuleInfoList.Create;
|
|
begin
|
|
inherited Create;
|
|
FItems := TObjectList.Create;
|
|
end;
|
|
|
|
destructor TJclSerializableModuleInfoList.Destroy;
|
|
begin
|
|
FItems.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
function TJclSerializableModuleInfoList.Add: TJclSerializableModuleInfo;
|
|
begin
|
|
FItems.Add(TJclSerializableModuleInfo.Create);
|
|
Result := TJclSerializableModuleInfo(FItems.Last);
|
|
end;
|
|
|
|
procedure TJclSerializableModuleInfoList.AssignTo(Dest: TPersistent);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
if Dest is TJclSerializableModuleInfoList then
|
|
begin
|
|
TJclSerializableModuleInfoList(Dest).Clear;
|
|
for I := 0 to Count - 1 do
|
|
TJclSerializableModuleInfoList(Dest).Add.Assign(TJclSerializableModuleInfo(FItems[I]));
|
|
end
|
|
else
|
|
inherited AssignTo(Dest);
|
|
end;
|
|
|
|
procedure TJclSerializableModuleInfoList.Clear;
|
|
begin
|
|
FItems.Clear;
|
|
end;
|
|
|
|
function TJclSerializableModuleInfoList.GetCount: Integer;
|
|
begin
|
|
Result := FItems.Count;
|
|
end;
|
|
|
|
function TJclSerializableModuleInfoList.GetItems(AIndex: Integer): TJclSerializableModuleInfo;
|
|
begin
|
|
Result := TJclSerializableModuleInfo(FItems[AIndex]);
|
|
end;
|
|
|
|
procedure TJclSerializableModuleInfoList.Deserialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
Clear;
|
|
for I := 0 to ASerializer.Count - 1 do
|
|
if ASerializer[I].Name = 'Module' then
|
|
Add.Deserialize(ASerializer[I]);
|
|
end;
|
|
|
|
procedure TJclSerializableModuleInfoList.Serialize(ASerializer: TJclCustomSimpleSerializer);
|
|
var
|
|
I: Integer;
|
|
begin
|
|
for I := 0 to Count - 1 do
|
|
Items[I].Serialize(ASerializer.AddChild(Self, 'Module'));
|
|
end;
|
|
|
|
{$IFDEF UNITVERSIONING}
|
|
initialization
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
|
|
|
finalization
|
|
UnregisterUnitVersion(HInstance);
|
|
{$ENDIF UNITVERSIONING}
|
|
|
|
end.
|