david
78ab77cd4c
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jvcl@19 7f62d464-2af8-f54e-996c-e91b33f51cbe
432 lines
11 KiB
ObjectPascal
432 lines
11 KiB
ObjectPascal
unit GenerateUtils;
|
|
|
|
{$I jvcl.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Contnrs, Classes,
|
|
JclSimpleXml,
|
|
PackageInformation, GenerateTargets, GenerateAlias, GenerateReplacements, DefinesConditionParser;
|
|
|
|
function IsTrimmedStartsWith(const SubStr, TrimStr: string): Boolean;
|
|
function IsTrimmedString(const TrimStr, S: string): Boolean;
|
|
function StartsWith(const SubStr, S: string): Boolean;
|
|
procedure StrReplaceLines(Lines: TStrings; const Search, Replace: string);
|
|
function MacroReplace(var Text: string; MacroChar: Char;
|
|
const Macros: array of string; CaseSensitive: Boolean = True): Boolean;
|
|
procedure MacroReplaceLines(Lines: TStrings; MacroChar: Char;
|
|
const Macros: array of string; CaseSensitive: Boolean = True);
|
|
function VerifyModelNode(Node : TJclSimpleXmlElem; var ErrMsg : string) : Boolean;
|
|
function GetUnitName(const FileName : string) : string;
|
|
function NowUTC : TDateTime;
|
|
function HasFileChanged(const OutFileName, TemplateFileName: string;
|
|
OutLines: TStrings; TimeStampLine: Integer): Boolean;
|
|
procedure AdjustEndingSemicolon(Lines: TStrings);
|
|
procedure EnumeratePackages(const Path : string; packages : TStrings);
|
|
|
|
|
|
|
|
implementation
|
|
|
|
uses
|
|
Windows, SysUtils,
|
|
JclStrings, JclFileUtils, JclDateTime;
|
|
|
|
function IsTrimmedStartsWith(const SubStr, TrimStr: string): Boolean;
|
|
var
|
|
l, r, Len, SLen, i: Integer;
|
|
begin
|
|
Result := False;
|
|
|
|
l := 1;
|
|
r := Length(TrimStr);
|
|
while (l < r) and (TrimStr[l] <= #32) do
|
|
Inc(l);
|
|
while (r > l) and (TrimStr[r] <= #32) do
|
|
Dec(r);
|
|
if r > l then
|
|
begin
|
|
Len := r - l + 1;
|
|
SLen := Length(SubStr);
|
|
if Len >= SLen then
|
|
begin
|
|
Dec(l);
|
|
for i := 1 to SLen do
|
|
if SubStr[i] <> TrimStr[l + i] then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IsTrimmedString(const TrimStr, S: string): Boolean;
|
|
var
|
|
l, r, Len, SLen, i: Integer;
|
|
begin
|
|
Result := False;
|
|
|
|
l := 1;
|
|
r := Length(TrimStr);
|
|
while (l < r) and (TrimStr[l] <= #32) do
|
|
Inc(l);
|
|
while (r > l) and (TrimStr[r] <= #32) do
|
|
Dec(r);
|
|
if r > l then
|
|
begin
|
|
Len := r - l + 1;
|
|
SLen := Length(S);
|
|
if Len = SLen then
|
|
begin
|
|
Dec(l);
|
|
for i := 1 to SLen do
|
|
if S[i] <> TrimStr[l + i] then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function StartsWith(const SubStr, S: string): Boolean;
|
|
var
|
|
i, Len: Integer;
|
|
begin
|
|
Result := False;
|
|
len := Length(SubStr);
|
|
if Len <= Length(S) then
|
|
begin
|
|
for i := 1 to Len do
|
|
if SubStr[i] <> S[i] then
|
|
Exit;
|
|
Result := True;
|
|
end;
|
|
end;
|
|
|
|
procedure StrReplaceLines(Lines: TStrings; const Search, Replace: string);
|
|
var
|
|
i: Integer;
|
|
S: string;
|
|
begin
|
|
for i := 0 to Lines.Count - 1 do
|
|
begin
|
|
S := Lines[i];
|
|
if Pos(Search, S) > 0 then
|
|
begin
|
|
StrReplace(S, Search, Replace, [rfReplaceAll]);
|
|
Lines[i] := S;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function MacroReplace(var Text: string; MacroChar: Char;
|
|
const Macros: array of string; CaseSensitive: Boolean = True): Boolean;
|
|
const
|
|
Delta = 1024;
|
|
var
|
|
Index, i, Count, Len, SLen, MacroHigh: Integer;
|
|
S: string;
|
|
Found: Boolean;
|
|
Cmp: function(const Str1, Str2: PChar; MaxLen: Cardinal): Integer;
|
|
begin
|
|
Result := False;
|
|
if CaseSensitive then
|
|
Cmp := StrLComp
|
|
else
|
|
Cmp := StrLIComp;
|
|
|
|
MacroHigh := Length(Macros) div 2 - 1;
|
|
Len := Length(Text);
|
|
i := 1;
|
|
SetLength(S, Delta);
|
|
SLen := 0;
|
|
while i <= Len do
|
|
begin
|
|
Count := 0;
|
|
// add normal chars in one step
|
|
while (i <= Len) and (Text[i] <> MacroChar) do
|
|
begin
|
|
Inc(Count);
|
|
Inc(i);
|
|
end;
|
|
if Count > 0 then
|
|
begin
|
|
if SLen + Count > Length(S) then
|
|
SetLength(S, SLen + Count + Delta);
|
|
Move(Text[i - Count], S[SLen + 1], Count * SizeOf(Char));
|
|
Inc(SLen, Count);
|
|
end;
|
|
|
|
if i <= Len then
|
|
begin
|
|
// replace macros
|
|
Found := False;
|
|
for Index := 0 to MacroHigh do
|
|
begin
|
|
Count := Length(Macros[Index * 2]);
|
|
if Cmp(PChar(Pointer(Text)) + i, PChar(Macros[Index * 2]), Count) = 0 then
|
|
begin
|
|
Inc(i, Count);
|
|
Count := Length(Macros[Index * 2 + 1]);
|
|
if Count > 0 then
|
|
begin
|
|
if SLen + Count > Length(S) then
|
|
SetLength(S, SLen + Count + Delta);
|
|
Move(Macros[Index * 2 + 1][1], S[SLen + 1], Count * SizeOf(Char));
|
|
Inc(SLen, Count);
|
|
end;
|
|
Result := True;
|
|
Found := True;
|
|
Break;
|
|
end;
|
|
end;
|
|
if not Found then
|
|
begin
|
|
// copy macro-text
|
|
if Macros[0][Length(Macros[0])] = MacroChar then
|
|
begin
|
|
Count := 1;
|
|
while (i + Count <= Len) and (Text[i + Count] <> MacroChar) do
|
|
Inc(Count);
|
|
Inc(Count);
|
|
if SLen + Count > Length(S) then
|
|
SetLength(S, SLen + Count + Delta);
|
|
Move(Text[i], S[SLen + 1], Count * SizeOf(Char));
|
|
Inc(SLen, Count);
|
|
Inc(i, Count - 1);
|
|
end;
|
|
end;
|
|
end;
|
|
Inc(i);
|
|
end;
|
|
SetLength(S, SLen);
|
|
Text := S;
|
|
end;
|
|
|
|
procedure MacroReplaceLines(Lines: TStrings; MacroChar: Char;
|
|
const Macros: array of string; CaseSensitive: Boolean = True);
|
|
var
|
|
i: Integer;
|
|
S: string;
|
|
begin
|
|
for i := 0 to Lines.Count - 1 do
|
|
begin
|
|
S := Lines[i];
|
|
if MacroReplace(S, MacroChar, Macros, CaseSensitive) then
|
|
Lines[i] := S;
|
|
end;
|
|
end;
|
|
|
|
function VerifyModelNode(Node : TJclSimpleXmlElem; var ErrMsg : string) : Boolean;
|
|
begin
|
|
// a valid model node must exist
|
|
if not Assigned(Node) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'No ''model'' node found in the ''models'' node.';
|
|
Exit;
|
|
end;
|
|
|
|
// it must have a Name property
|
|
if not Assigned(Node.Properties.ItemNamed['name']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'A ''model'' node must have a ''name'' property.';
|
|
Exit;
|
|
end;
|
|
|
|
// it must have a prefix property
|
|
if not Assigned(Node.Properties.ItemNamed['prefix']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'A ''model'' node must have a ''prefix'' property.';
|
|
Exit;
|
|
end;
|
|
|
|
// it must have a format property
|
|
if not Assigned(Node.Properties.ItemNamed['format']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'A ''model'' node must have a ''format'' property.';
|
|
Exit;
|
|
end;
|
|
|
|
// it must have a packages property
|
|
if not Assigned(Node.Properties.ItemNamed['packages']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'A ''model'' node must have a ''packages'' property.';
|
|
Exit;
|
|
end;
|
|
|
|
// it must have a incfile property
|
|
if not Assigned(Node.Properties.ItemNamed['incfile']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'A ''model'' node must have a ''incfile'' property.';
|
|
Exit;
|
|
end;
|
|
|
|
// it must contain Targets
|
|
if not Assigned(Node.Items.ItemNamed['targets']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'A ''model'' node must contain a ''targets'' node.';
|
|
Exit;
|
|
end;
|
|
|
|
// it must contain Aliases
|
|
if not Assigned(Node.Items.ItemNamed['aliases']) then
|
|
begin
|
|
Result := False;
|
|
ErrMsg := 'A ''model'' node must contain a ''aliases'' node.';
|
|
Exit;
|
|
end;
|
|
|
|
// if all went ok, then the node is deemed to be valid
|
|
Result := True;
|
|
end;
|
|
|
|
function GetUnitName(const FileName : string) : string;
|
|
begin
|
|
Result := PathExtractFileNameNoExt(FileName);
|
|
end;
|
|
|
|
function NowUTC : TDateTime;
|
|
var
|
|
sysTime : TSystemTime;
|
|
fileTime : TFileTime;
|
|
begin
|
|
Windows.GetSystemTime(sysTime);
|
|
Windows.SystemTimeToFileTime(sysTime, fileTime);
|
|
Result := FileTimeToDateTime(fileTime);
|
|
end;
|
|
|
|
function FilesEqual(const FileName1, FileName2: string): Boolean;
|
|
const
|
|
MaxBufSize = 65535;
|
|
var
|
|
Stream1, Stream2: TFileStream;
|
|
Buffer1, Buffer2: array[0..MaxBufSize - 1] of Byte;
|
|
BufSize: Integer;
|
|
Size: Integer;
|
|
begin
|
|
Result := True;
|
|
|
|
Stream1 := nil;
|
|
Stream2 := nil;
|
|
try
|
|
Stream1 := TFileStream.Create(FileName1, fmOpenRead or fmShareDenyWrite);
|
|
Stream2 := TFileStream.Create(FileName2, fmOpenRead or fmShareDenyWrite);
|
|
|
|
Size := Stream1.Size;
|
|
if Size <> Stream2.Size then
|
|
begin
|
|
Result := False;
|
|
Exit; // Note: the finally clause WILL be executed
|
|
end;
|
|
|
|
BufSize := MaxBufSize;
|
|
while Size > 0 do
|
|
begin
|
|
if BufSize > Size then
|
|
BufSize := Size;
|
|
Dec(Size, BufSize);
|
|
|
|
Stream1.Read(Buffer1[0], BufSize);
|
|
Stream2.Read(Buffer2[0], BufSize);
|
|
|
|
Result := CompareMem(@Buffer1[0], @Buffer2[0], BufSize);
|
|
if not Result then
|
|
Exit; // Note: the finally clause WILL be executed
|
|
end;
|
|
finally
|
|
Stream1.Free;
|
|
Stream2.Free;
|
|
end;
|
|
end;
|
|
|
|
function HasFileChanged(const OutFileName, TemplateFileName: string;
|
|
OutLines: TStrings; TimeStampLine: Integer): Boolean;
|
|
var
|
|
CurLines: TStrings;
|
|
begin
|
|
Result := True;
|
|
if not FileExists(OutFileName) then
|
|
Exit;
|
|
|
|
if OutLines.Count = 0 then
|
|
begin
|
|
// binary file -> compare files
|
|
Result := not FilesEqual(OutFileName, TemplateFileName);
|
|
end
|
|
else
|
|
begin
|
|
// text file -> compare lines
|
|
CurLines := TStringList.Create;
|
|
try
|
|
CurLines.LoadFromFile(OutFileName);
|
|
|
|
if CurLines.Count <> OutLines.Count then
|
|
begin
|
|
Result := True;
|
|
Exit;
|
|
end;
|
|
|
|
// Replace the time stamp line by the new one to ensure that this
|
|
// won't break the comparison.
|
|
if TimeStampLine > -1 then
|
|
CurLines[TimeStampLine] := OutLines[TimeStampLine];
|
|
|
|
Result := not CurLines.Equals(OutLines);
|
|
finally
|
|
CurLines.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure AdjustEndingSemicolon(Lines: TStrings);
|
|
var
|
|
S: string;
|
|
Len, Index: Integer;
|
|
begin
|
|
if Lines.Count > 0 then
|
|
begin
|
|
Index := Lines.Count - 1;
|
|
S := Lines[Index];
|
|
Len := Length(S);
|
|
|
|
{ If the last line is a comment then we have a problem. Here we allow the
|
|
last comment to have no comma }
|
|
if (Len > 2) and (S[1] = '{') and (S[2] = '$') and (Index > 0) then
|
|
begin
|
|
Dec(Index);
|
|
S := Lines[Index];
|
|
Len := Length(S);
|
|
end;
|
|
if Len > 0 then
|
|
begin
|
|
if S[Len] = ',' then
|
|
begin
|
|
Delete(S, Len, 1);
|
|
Lines[Index] := S;
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure EnumeratePackages(const Path : string; packages : TStrings);
|
|
var
|
|
rec : TSearchRec;
|
|
begin
|
|
packages.Clear;
|
|
if FindFirst(StrEnsureSuffix(DirDelimiter, path) + 'xml' + DirDelimiter + '*.xml', faAnyFile, rec) = 0 then
|
|
begin
|
|
repeat
|
|
packages.Add(PathExtractFileNameNoExt(rec.Name));
|
|
until FindNext(rec) <> 0;
|
|
end;
|
|
FindClose(rec);
|
|
end;
|
|
|
|
end.
|