TranslationManager/KM_LibxFinder.pas at master · KP-Wiki/TranslationManager · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
unit KM_LibxFinder;
{$I KM_CompilerDirectives.inc}
interface
uses
  System.Classes;

type
  // Scans folder and subfolders in search of .libx files
  // Provides list of found files as "fullpath\filename.%s.libx"
  TKMLibxFinder = class
  private
    fPaths: TStringList;
    function GetPath(aIndex: Integer): string;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;

    property Count: Integer read GetCount;
    property Paths[aIndex: Integer]: string read GetPath; default;
    property GetPaths: TStringList read fPaths;
    procedure Clear;
    procedure AddPath(const aRoot, aFolder: string);
  end;


implementation
uses
  System.StrUtils, System.SysUtils;


{ TKMLibxFinder }
constructor TKMLibxFinder.Create;
begin
  inherited;

  fPaths := TStringList.Create;
end;


destructor TKMLibxFinder.Destroy;
begin
  FreeAndNil(fPaths);

  inherited;
end;


function TKMLibxFinder.GetCount: Integer;
begin
  Result := fPaths.Count;
end;


function TKMLibxFinder.GetPath(aIndex: Integer): string;
begin
  Result := fPaths[aIndex];
end;


procedure TKMLibxFinder.Clear;
begin
  fPaths.Clear;
end;


// aRoot - which path is considered to be root
procedure TKMLibxFinder.AddPath(const aRoot, aFolder: string);
var
  I: Integer;
  fileMask: string;
  searchRec: TSearchRec;
  subFolders: TStringList;
  pathAdded: Boolean;
begin
  Assert(EndsText('\', aRoot + aFolder));

  subFolders := TStringList.Create;
  subFolders.Add(aRoot + aFolder);

  I := 0;
  repeat
    if FindFirst(subFolders[I] + '*', faAnyFile, searchRec) = 0 then
    begin
      pathAdded := False;
      repeat
        if (searchRec.Name <> '.') and (searchRec.Name <> '..') then
          if (searchRec.Attr and faDirectory = faDirectory) then
            // Always add sub-folders
            subFolders.Add(subFolders[I] + searchRec.Name + '\')
          else
            if not pathAdded and SameText(ExtractFileExt(searchRec.Name), '.libx') then
            begin
              // When we see a libx, add its path exactly once
              fileMask := LeftStr(searchRec.Name, Length(searchRec.Name) - 8) + '%s.libx';
              fPaths.Add(ExtractRelativePath(aRoot, subFolders[I]) + fileMask);
              pathAdded := True;
            end;
      until (FindNext(searchRec) <> 0);
      FindClose(searchRec);
    end;
    Inc(I);
  until (I >= subFolders.Count);

  subFolders.Free;
end;


end.