591 lines
22 KiB
ObjectPascal
591 lines
22 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 JclStackTraceViewerStackUtils.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-09-14 18:00:50 +0200 (lun., 14 sept. 2009) $ }
|
||
|
|
{ Revision: $Rev:: 3012 $ }
|
||
|
|
{ Author: $Author:: outchy $ }
|
||
|
|
{ }
|
||
|
|
{**************************************************************************************************}
|
||
|
|
|
||
|
|
unit JclStackTraceViewerStackUtils;
|
||
|
|
|
||
|
|
{$I jcl.inc}
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
uses
|
||
|
|
Windows, SysUtils, Classes, Contnrs, ActiveX,
|
||
|
|
ToolsAPI,
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
JclUnitVersioning,
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
JclStrings, JclFileUtils,
|
||
|
|
JclDebugSerialization, JclStackTraceViewerClasses, JclStackTraceViewerStackCodeUtils,
|
||
|
|
JclStackTraceViewerOptions, JclStackTraceViewerAPIImpl, JclStackTraceViewerAPI;
|
||
|
|
|
||
|
|
type
|
||
|
|
TLocationInfoProcessorProgressStatus = (lippsUnknown, lippsStart, lippsFinished);
|
||
|
|
|
||
|
|
TJclLocationInfoProgressEvent = procedure(AStatus: TLocationInfoProcessorProgressStatus;
|
||
|
|
APos, AMax: Integer; const AText: string) of object;
|
||
|
|
|
||
|
|
TJclLocationInfoProcessor = class(TObject, IJclStackTraceViewerStackProcessorServices)
|
||
|
|
private
|
||
|
|
FModuleList: IJclModuleInfoList;
|
||
|
|
FOnProgress: TJclLocationInfoProgressEvent;
|
||
|
|
FOptions: TExceptionViewerOption;
|
||
|
|
FRootDir: string;
|
||
|
|
procedure DoProgress(AStatus: TLocationInfoProcessorProgressStatus; APos, AMax: Integer; const AText: string);
|
||
|
|
public
|
||
|
|
property OnProgress: TJclLocationInfoProgressEvent read FOnProgress write FOnProgress;
|
||
|
|
property Options: TExceptionViewerOption read FOptions write FOptions;
|
||
|
|
property RootDir: string read FRootDir write FRootDir;
|
||
|
|
|
||
|
|
{ IInterface }
|
||
|
|
function QueryInterface(const IID: TGUID; out Obj): HRESULT; stdcall;
|
||
|
|
function _AddRef: Integer; stdcall;
|
||
|
|
function _Release: Integer; stdcall;
|
||
|
|
{ IJclStackTraceViewerStackProcessorServices }
|
||
|
|
function GetModuleInfoList: IJclModuleInfoList;
|
||
|
|
procedure PrepareLocationInfoList(AStack: IJclPreparedLocationInfoList; AForce: Boolean = False);
|
||
|
|
procedure SetModuleInfoList(AValue: IJclModuleInfoList);
|
||
|
|
property ModuleList: IJclModuleInfoList read GetModuleInfoList write SetModuleInfoList;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
const
|
||
|
|
UnitVersioning: TUnitVersionInfo = (
|
||
|
|
RCSfile: '$URL: https://jcl.svn.sourceforge.net/svnroot/jcl/tags/JCL-2.1-Build3536/jcl/experts/stacktraceviewer/JclStackTraceViewerStackUtils.pas $';
|
||
|
|
Revision: '$Revision: 3012 $';
|
||
|
|
Date: '$Date: 2009-09-14 18:00:50 +0200 (lun., 14 sept. 2009) $';
|
||
|
|
LogPath: 'JCL\experts\stacktraceviewer';
|
||
|
|
Extra: '';
|
||
|
|
Data: nil
|
||
|
|
);
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
uses
|
||
|
|
JclOtaResources;
|
||
|
|
|
||
|
|
type
|
||
|
|
TFileSearchItem = class(TObject)
|
||
|
|
private
|
||
|
|
FName: string;
|
||
|
|
FResults: TStringList;
|
||
|
|
public
|
||
|
|
constructor Create(const AName: string);
|
||
|
|
destructor Destroy; override;
|
||
|
|
property Name: string read FName;
|
||
|
|
property Results: TStringList read FResults;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TFileSearcher = class(TObject)
|
||
|
|
private
|
||
|
|
FFiles: TObjectList;
|
||
|
|
FSearchPaths: TStringList;
|
||
|
|
function GetCount: Integer;
|
||
|
|
function GetItems(AIndex: Integer): TFileSearchItem;
|
||
|
|
public
|
||
|
|
constructor Create;
|
||
|
|
destructor Destroy; override;
|
||
|
|
function Add(const AName: string): TFileSearchItem;
|
||
|
|
procedure Clear;
|
||
|
|
procedure Delete(AIndex: Integer);
|
||
|
|
function IndexOf(const AName: string): Integer;
|
||
|
|
procedure Search;
|
||
|
|
property Count: Integer read GetCount;
|
||
|
|
property Items[AIndex: Integer]: TFileSearchItem read GetItems; default;
|
||
|
|
property SearchPaths: TStringList read FSearchPaths;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TFileSearcher }
|
||
|
|
|
||
|
|
constructor TFileSearcher.Create;
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
FFiles := TObjectList.Create;
|
||
|
|
FSearchPaths := TStringList.Create;
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TFileSearcher.Destroy;
|
||
|
|
begin
|
||
|
|
FSearchPaths.Free;
|
||
|
|
FFiles.Free;
|
||
|
|
inherited Destroy;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFileSearcher.Add(const AName: string): TFileSearchItem;
|
||
|
|
begin
|
||
|
|
FFiles.Add(TFileSearchItem.Create(AName));
|
||
|
|
Result := TFileSearchItem(FFiles.Last);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFileSearcher.Clear;
|
||
|
|
begin
|
||
|
|
FFiles.Clear;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFileSearcher.Delete(AIndex: Integer);
|
||
|
|
begin
|
||
|
|
FFiles.Delete(AIndex);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFileSearcher.GetCount: Integer;
|
||
|
|
begin
|
||
|
|
Result := FFiles.Count;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFileSearcher.GetItems(AIndex: Integer): TFileSearchItem;
|
||
|
|
begin
|
||
|
|
Result := TFileSearchItem(FFiles[AIndex]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFileSearcher.IndexOf(const AName: string): Integer;
|
||
|
|
var
|
||
|
|
I: Integer;
|
||
|
|
begin
|
||
|
|
Result := -1;
|
||
|
|
for I := 0 to Count - 1 do
|
||
|
|
if Items[I].Name = AName then
|
||
|
|
begin
|
||
|
|
Result := I;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFileSearcher.Search;
|
||
|
|
var
|
||
|
|
I, Idx: Integer;
|
||
|
|
FastIndexList: TStringList;
|
||
|
|
FS: TFileSearchItem;
|
||
|
|
Path: string;
|
||
|
|
sr: TSearchRec;
|
||
|
|
re: Integer;
|
||
|
|
begin
|
||
|
|
if (Count > 0) then
|
||
|
|
begin
|
||
|
|
for I := 0 to Count - 1 do
|
||
|
|
Items[I].Results.Clear;
|
||
|
|
if FSearchPaths.Count > 0 then
|
||
|
|
begin
|
||
|
|
FastIndexList := TStringList.Create;
|
||
|
|
try
|
||
|
|
FastIndexList.Sorted := True;
|
||
|
|
for I := 0 to Count - 1 do
|
||
|
|
FastIndexList.AddObject(Items[I].Name, Items[I]);
|
||
|
|
for I := 0 to FSearchPaths.Count - 1 do
|
||
|
|
begin
|
||
|
|
Path := PathAddSeparator(FSearchPaths[I]);
|
||
|
|
re := FindFirst(Path + '*.*', faAnyFile - faDirectory, sr);
|
||
|
|
while re = 0 do
|
||
|
|
begin
|
||
|
|
Idx := FastIndexList.IndexOf(sr.Name);
|
||
|
|
if Idx <> -1 then
|
||
|
|
begin
|
||
|
|
FS := TFileSearchItem(FastIndexList.Objects[Idx]);
|
||
|
|
FS.Results.Add(Path + sr.Name);
|
||
|
|
end;
|
||
|
|
re := FindNext(sr);
|
||
|
|
end;
|
||
|
|
FindClose(sr);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
FastIndexList.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TFileSearchItem }
|
||
|
|
|
||
|
|
constructor TFileSearchItem.Create(const AName: string);
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
FResults := TStringList.Create;
|
||
|
|
FName := AName;
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TFileSearchItem.Destroy;
|
||
|
|
begin
|
||
|
|
FResults.Free;
|
||
|
|
inherited Destroy;
|
||
|
|
end;
|
||
|
|
|
||
|
|
type
|
||
|
|
TFindMapping = class(TObject)
|
||
|
|
private
|
||
|
|
FItems: TInterfaceList;
|
||
|
|
function GetCount: Integer;
|
||
|
|
function GetItems(AIndex: Integer): IJclPreparedLocationInfo;
|
||
|
|
public
|
||
|
|
FoundFile: Boolean;
|
||
|
|
FileName: string;
|
||
|
|
ProjectName: string;
|
||
|
|
constructor Create;
|
||
|
|
destructor Destroy; override;
|
||
|
|
procedure Add(AStackViewItem: IJclPreparedLocationInfo);
|
||
|
|
property Count: Integer read GetCount;
|
||
|
|
property Items[AIndex: Integer]: IJclPreparedLocationInfo read GetItems; default;
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TFindMapping.Create;
|
||
|
|
begin
|
||
|
|
inherited Create;
|
||
|
|
FItems := TInterfaceList.Create;
|
||
|
|
end;
|
||
|
|
|
||
|
|
destructor TFindMapping.Destroy;
|
||
|
|
begin
|
||
|
|
FItems.Free;
|
||
|
|
inherited Destroy;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFindMapping.Add(AStackViewItem: IJclPreparedLocationInfo);
|
||
|
|
begin
|
||
|
|
FItems.Add(AStackViewItem);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFindMapping.GetCount: Integer;
|
||
|
|
begin
|
||
|
|
Result := FItems.Count;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFindMapping.GetItems(AIndex: Integer): IJclPreparedLocationInfo;
|
||
|
|
begin
|
||
|
|
Result := IJclPreparedLocationInfo(FItems[AIndex]);
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TJclLocationInfoProcessor.DoProgress(AStatus: TLocationInfoProcessorProgressStatus;
|
||
|
|
APos, AMax: Integer; const AText: string);
|
||
|
|
begin
|
||
|
|
if Assigned(FOnProgress) then
|
||
|
|
FOnProgress(AStatus, APos, AMax, AText);
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TJclLocationInfoProcessor.GetModuleInfoList: IJclModuleInfoList;
|
||
|
|
begin
|
||
|
|
Result := FModuleList;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TJclLocationInfoProcessor.PrepareLocationInfoList(AStack: IJclPreparedLocationInfoList; AForce: Boolean);
|
||
|
|
var
|
||
|
|
I, J, K, Idx: Integer;
|
||
|
|
StackViewItem: IJclPreparedLocationInfo;
|
||
|
|
FindFileList: TStringList;
|
||
|
|
FindMapping: TFindMapping;
|
||
|
|
FileName, ProjectName: string;
|
||
|
|
RevisionMS: TMemoryStream;
|
||
|
|
RevisionStream, Stream: IStream;
|
||
|
|
MS: TMemoryStream;
|
||
|
|
SA: TStreamAdapter;
|
||
|
|
|
||
|
|
S, ModuleListModulePath, FindMappingModulePath: string;
|
||
|
|
EV: IOTAEnvironmentOptions;
|
||
|
|
FileSearcher: TFileSearcher;
|
||
|
|
BrowsingPaths: TStringList;
|
||
|
|
|
||
|
|
Found: Boolean;
|
||
|
|
RevisionLineNumbers, CurrentLineNumbers: TList;
|
||
|
|
begin
|
||
|
|
if AForce or not AStack.Prepared then
|
||
|
|
begin
|
||
|
|
DoProgress(lippsStart, 0, 100, '');
|
||
|
|
if AStack.Count > 0 then
|
||
|
|
begin
|
||
|
|
FindFileList := TStringList.Create;
|
||
|
|
try
|
||
|
|
FindFileList.Sorted := True;
|
||
|
|
//check if the files can be found in a project in the current project group
|
||
|
|
DoProgress(lippsUnknown, 0, AStack.Count, LoadResString(@RsSTVFindFilesInProjectGroup));
|
||
|
|
for I := 0 to AStack.Count - 1 do
|
||
|
|
if AStack.Items[I].QueryInterface(IJclPreparedLocationInfo, StackViewItem) = S_OK then
|
||
|
|
begin
|
||
|
|
StackViewItem.Revision := StackViewItem.UnitVersionRevision;
|
||
|
|
Idx := FindFileList.IndexOf(StackViewItem.SourceName);
|
||
|
|
if Idx <> -1 then
|
||
|
|
begin
|
||
|
|
FindMapping := TFindMapping(FindFileList.Objects[Idx]);
|
||
|
|
FindMapping.Add(StackViewItem);
|
||
|
|
StackViewItem.FoundFile := FindMapping.FoundFile;
|
||
|
|
StackViewItem.FileName := FindMapping.FileName;
|
||
|
|
StackViewItem.ProjectName := FindMapping.ProjectName;
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
if AStack.Items[I].SourceName <> '' then
|
||
|
|
begin
|
||
|
|
DoProgress(lippsUnknown, I + 1, AStack.Count, Format(LoadResString(@RsSTVFindFileInProjectGroup), [AStack.Items[I].SourceName]));
|
||
|
|
FileName := FindModuleAndProject(AStack.Items[I].SourceName, ProjectName);
|
||
|
|
end
|
||
|
|
else
|
||
|
|
begin
|
||
|
|
FileName := '';
|
||
|
|
ProjectName := '';
|
||
|
|
end;
|
||
|
|
FindMapping := TFindMapping.Create;
|
||
|
|
FindMapping.Add(StackViewItem);
|
||
|
|
FindFileList.AddObject(AStack.Items[I].SourceName, FindMapping);
|
||
|
|
FindMapping.FoundFile := FileName <> '';
|
||
|
|
FindMapping.FileName := FileName;
|
||
|
|
FindMapping.ProjectName := ProjectName;
|
||
|
|
|
||
|
|
StackViewItem.FoundFile := FileName <> '';
|
||
|
|
StackViewItem.FileName := FileName;
|
||
|
|
StackViewItem.ProjectName := ProjectName;
|
||
|
|
end;
|
||
|
|
DoProgress(lippsUnknown, I + 1, AStack.Count, LoadResString(@RsSTVFindFilesInProjectGroup));
|
||
|
|
end;
|
||
|
|
|
||
|
|
//use the build number from the version number as revision number if the revision number is empty
|
||
|
|
if Assigned(FOptions) and FOptions.ModuleVersionAsRevision and Assigned(FModuleList) then
|
||
|
|
begin
|
||
|
|
for I := 0 to FindFileList.Count - 1 do
|
||
|
|
begin
|
||
|
|
FindMapping := TFindMapping(FindFileList.Objects[I]);
|
||
|
|
if (FindMapping.Count > 0) and (FindMapping[0].Revision = '') and (FindMapping[0].ModuleName <> '') then
|
||
|
|
begin
|
||
|
|
Idx := -1;
|
||
|
|
{Why full filenames?
|
||
|
|
|
||
|
|
It is possible to load
|
||
|
|
<Path 1>\TestDLL.DLL
|
||
|
|
<Path 2>\TestDLL.DLL}
|
||
|
|
for J := 0 to FModuleList.Count - 1 do
|
||
|
|
begin
|
||
|
|
ModuleListModulePath := ExtractFilePath(FModuleList[J].ModuleName);
|
||
|
|
FindMappingModulePath := ExtractFilePath(FindMapping[0].ModuleName);
|
||
|
|
if (CompareText(ExtractFileName(FModuleList[J].ModuleName), ExtractFileName(FindMapping[0].ModuleName)) = 0) and
|
||
|
|
((ModuleListModulePath = '') or (FindMappingModulePath = '') or
|
||
|
|
(CompareText(ModuleListModulePath, FindMappingModulePath) = 0)) then
|
||
|
|
begin
|
||
|
|
Idx := J;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if Idx <> -1 then
|
||
|
|
begin
|
||
|
|
S := FModuleList[Idx].BinFileVersion;
|
||
|
|
K := Pos('.', S);
|
||
|
|
if K > 0 then
|
||
|
|
Delete(S, 1, K);
|
||
|
|
K := Pos('.', S);
|
||
|
|
if K > 0 then
|
||
|
|
Delete(S, 1, K);
|
||
|
|
K := Pos('.', S);
|
||
|
|
if K > 0 then
|
||
|
|
begin
|
||
|
|
Delete(S, 1, K);
|
||
|
|
for J := 0 to FindMapping.Count - 1 do
|
||
|
|
FindMapping[J].Revision := S;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
//check if the other files can be found in BrowsingPath
|
||
|
|
if FRootDir <> '' then
|
||
|
|
begin
|
||
|
|
Found := False;
|
||
|
|
for I := 0 to FindFileList.Count - 1 do
|
||
|
|
begin
|
||
|
|
FindMapping := TFindMapping(FindFileList.Objects[I]);
|
||
|
|
if (FindFileList[I] <> '') and (not FindMapping.FoundFile) then
|
||
|
|
begin
|
||
|
|
Found := True;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if Found then
|
||
|
|
begin
|
||
|
|
FileSearcher := TFileSearcher.Create;
|
||
|
|
try
|
||
|
|
BrowsingPaths := TStringList.Create;
|
||
|
|
try
|
||
|
|
EV := (BorlandIDEServices as IOTAServices).GetEnvironmentOptions;
|
||
|
|
StrTokenToStrings(EV.Values['BrowsingPath'], ';', BrowsingPaths);
|
||
|
|
for I := 0 to BrowsingPaths.Count - 1 do
|
||
|
|
begin
|
||
|
|
S := BrowsingPaths[I];
|
||
|
|
if Pos('$(BDS)', S) > 0 then
|
||
|
|
S := StringReplace(S, '$(BDS)', FRootDir, []);
|
||
|
|
FileSearcher.SearchPaths.Add(S);
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
BrowsingPaths.Free;
|
||
|
|
end;
|
||
|
|
if FileSearcher.SearchPaths.Count > 0 then
|
||
|
|
begin
|
||
|
|
for I := 0 to FindFileList.Count - 1 do
|
||
|
|
begin
|
||
|
|
FindMapping := TFindMapping(FindFileList.Objects[I]);
|
||
|
|
if (FindFileList[I] <> '') and (not FindMapping.FoundFile) and (FileSearcher.IndexOf(FindFileList[I]) = -1) then
|
||
|
|
FileSearcher.Add(FindFileList[I]);
|
||
|
|
end;
|
||
|
|
if FileSearcher.Count > 0 then
|
||
|
|
begin
|
||
|
|
DoProgress(lippsUnknown, 0, 100, LoadResString(@RsSTVFindFilesInBrowsingPath));
|
||
|
|
FileSearcher.Search;
|
||
|
|
DoProgress(lippsUnknown, 75, 100, LoadResString(@RsSTVFindFilesInBrowsingPath));
|
||
|
|
for I := 0 to FindFileList.Count - 1 do
|
||
|
|
begin
|
||
|
|
FindMapping := TFindMapping(FindFileList.Objects[I]);
|
||
|
|
if not FindMapping.FoundFile then
|
||
|
|
begin
|
||
|
|
Idx := FileSearcher.IndexOf(FindFileList[I]);
|
||
|
|
if (Idx <> -1) and (FileSearcher[Idx].Results.Count > 0) then
|
||
|
|
begin
|
||
|
|
FindMapping.FoundFile := True;
|
||
|
|
FindMapping.FileName := FileSearcher[Idx].Results[0];
|
||
|
|
FindMapping.ProjectName := '';
|
||
|
|
for J := 0 to FindMapping.Count - 1 do
|
||
|
|
begin
|
||
|
|
FindMapping[J].FoundFile := FindMapping.FoundFile;
|
||
|
|
FindMapping[J].FileName := FindMapping.FileName;
|
||
|
|
FindMapping[J].ProjectName := FindMapping.ProjectName;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
DoProgress(lippsUnknown, FindFileList.Count * 3 + I + 1, FindFileList.Count * 4, LoadResString(@RsSTVFindFilesInBrowsingPath));
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
FileSearcher.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
DoProgress(lippsUnknown, 0, FindFileList.Count, '');
|
||
|
|
for I := 0 to FindFileList.Count - 1 do
|
||
|
|
begin
|
||
|
|
FindMapping := TFindMapping(FindFileList.Objects[I]);
|
||
|
|
if (FindMapping.FoundFile) and (FindMapping.Count > 0) and (FindMapping[0].Revision <> '') then
|
||
|
|
begin
|
||
|
|
Found := False;
|
||
|
|
for J := 0 to FindMapping.Count - 1 do
|
||
|
|
if FindMapping[J].LineNumber > 0 then
|
||
|
|
begin
|
||
|
|
Found := True;
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
if Found then
|
||
|
|
begin
|
||
|
|
Stream := GetFileEditorContent(FindMapping.FileName);
|
||
|
|
if not Assigned(Stream) then
|
||
|
|
begin
|
||
|
|
if FileExists(FindMapping.FileName) then
|
||
|
|
begin
|
||
|
|
SA := TStreamAdapter.Create(TMemoryStream.Create, soOwned);
|
||
|
|
Stream := SA;
|
||
|
|
MS := TMemoryStream(SA.Stream);
|
||
|
|
MS.LoadFromFile(FindMapping.FileName);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
if Assigned(Stream) then
|
||
|
|
begin
|
||
|
|
RevisionLineNumbers := TList.Create;
|
||
|
|
CurrentLineNumbers := TList.Create;
|
||
|
|
try
|
||
|
|
for J := 0 to FindMapping.Count - 1 do
|
||
|
|
if FindMapping[J].LineNumber > 0 then
|
||
|
|
RevisionLineNumbers.Add(Pointer(FindMapping[J].LineNumber));
|
||
|
|
RevisionMS := TMemoryStream.Create;
|
||
|
|
try
|
||
|
|
RevisionStream := TStreamAdapter.Create(RevisionMS);
|
||
|
|
if GetRevisionContent(FindMapping.FileName, FindMapping[0].Revision, RevisionStream) then
|
||
|
|
begin
|
||
|
|
if TranslateLineNumbers(RevisionStream, Stream, RevisionLineNumbers, CurrentLineNumbers) > 0 then
|
||
|
|
begin
|
||
|
|
if RevisionLineNumbers.Count = CurrentLineNumbers.Count then
|
||
|
|
begin
|
||
|
|
for J := 0 to FindMapping.Count - 1 do
|
||
|
|
if FindMapping[J].LineNumber > 0 then
|
||
|
|
begin
|
||
|
|
FindMapping[J].TranslatedLineNumber := -1;
|
||
|
|
for K := 0 to RevisionLineNumbers.Count - 1 do
|
||
|
|
if Integer(RevisionLineNumbers[K]) = FindMapping[J].LineNumber then
|
||
|
|
begin
|
||
|
|
FindMapping[J].TranslatedLineNumber := Integer(CurrentLineNumbers[K]);
|
||
|
|
Break;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
RevisionMS.Free;
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
RevisionLineNumbers.Free;
|
||
|
|
CurrentLineNumbers.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
DoProgress(lippsUnknown, I + 1, FindFileList.Count, '');
|
||
|
|
end;
|
||
|
|
finally
|
||
|
|
for I := 0 to FindFileList.Count - 1 do
|
||
|
|
FindFileList.Objects[I].Free;
|
||
|
|
FindFileList.Free;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
DoProgress(lippsFinished, 0, 0, '');
|
||
|
|
AStack.Prepared := True;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TJclLocationInfoProcessor.QueryInterface(const IID: TGUID; out Obj): HRESULT;
|
||
|
|
begin
|
||
|
|
if GetInterface(IID, Obj) then
|
||
|
|
Result := S_OK
|
||
|
|
else
|
||
|
|
Result := E_NOINTERFACE;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TJclLocationInfoProcessor.SetModuleInfoList(AValue: IJclModuleInfoList);
|
||
|
|
begin
|
||
|
|
FModuleList := AValue;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TJclLocationInfoProcessor._AddRef: Integer;
|
||
|
|
begin
|
||
|
|
Result := -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TJclLocationInfoProcessor._Release: Integer;
|
||
|
|
begin
|
||
|
|
Result := -1;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF UNITVERSIONING}
|
||
|
|
initialization
|
||
|
|
RegisterUnitVersion(HInstance, UnitVersioning);
|
||
|
|
|
||
|
|
finalization
|
||
|
|
UnregisterUnitVersion(HInstance);
|
||
|
|
{$ENDIF UNITVERSIONING}
|
||
|
|
|
||
|
|
end.
|