Changeset 21 for trunk/Packages/Common/UCommon.pas

Timestamp:

May 8, 2019, 12:11:40 PM (6 years ago)

Author:

chronos

Message:

• Fixed: Build under Lazarus 2.0.
• Modified: Used .lrj files instead of .lrt files.
• Removed: TemplateGenerics package.

File:

• trunk/Packages/Common/UCommon.pas (modified) (6 diffs)

trunk/Packages/Common/UCommon.pas

@@ -28 +28 @@
     unfDNSDomainName = 11);
 
-  TFilterMethodMethod = function (FileName: string): Boolean of object;
+  TFilterMethod = function (FileName: string): Boolean of object;
+  TFileNameMethod = procedure (FileName: string) of object;
+
 var
   ExceptionHandler: TExceptionEvent;
@@ -72 +74 @@
 function MergeArray(A, B: array of string): TArrayOfString;
 function LoadFileToStr(const FileName: TFileName): AnsiString;
+procedure SaveStringToFile(S, FileName: string);
 procedure SearchFiles(AList: TStrings; Dir: string;
-  FilterMethod: TFilterMethodMethod);
+  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
+function GetStringPart(var Text: string; Separator: string): string;
+function StripTags(const S: string): string;
+function PosFromIndex(SubStr: string; Text: string;
+  StartIndex: Integer): Integer;
+function PosFromIndexReverse(SubStr: string; Text: string;
+  StartIndex: Integer): Integer;
+procedure CopyStringArray(Dest: TStringArray; Source: array of string);
 
 
@@ -101 +111 @@
   I: Integer;
 begin
+  Result := '';
   for I := 1 to Length(Source) do begin
     Result := Result + LowerCase(IntToHex(Ord(Source[I]), 2));
@@ -522 +533 @@
 end;
 
+procedure SaveStringToFile(S, FileName: string);
+var
+  F: TextFile;
+begin
+  AssignFile(F, FileName);
+  try
+    ReWrite(F);
+    Write(F, S);
+  finally
+    CloseFile(F);
+  end;
+end;
+
 procedure SearchFiles(AList: TStrings; Dir: string;
-  FilterMethod: TFilterMethodMethod);
+  FilterMethod: TFilterMethod = nil; FileNameMethod: TFileNameMethod = nil);
 var
   SR: TSearchRec;
@@ -531 +555 @@
     try
       repeat
-        if (SR.Name = '.') or (SR.Name = '..') or not FilterMethod(SR.Name) then Continue;
+        if (SR.Name = '.') or (SR.Name = '..') or (Assigned(FilterMethod) and (not FilterMethod(SR.Name) or
+          not FilterMethod(Copy(Dir, 3, Length(Dir)) + SR.Name))) then Continue;
+        if Assigned(FileNameMethod) then
+          FileNameMethod(Dir + SR.Name);
         AList.Add(Dir + SR.Name);
         if (SR.Attr and faDirectory) <> 0 then
@@ -541 +568 @@
 end;
 
+function GetStringPart(var Text: string; Separator: string): string;
+var
+  P: Integer;
+begin
+  P := Pos(Separator, Text);
+  if P > 0 then begin
+    Result := Copy(Text, 1, P - 1);
+    Delete(Text, 1, P - 1 + Length(Separator));
+  end else begin
+    Result := Text;
+    Text := '';
+  end;
+  Result := Trim(Result);
+  Text := Trim(Text);
+end;
+
+function StripTags(const S: string): string;
+var
+  Len: Integer;
+
+  function ReadUntil(const ReadFrom: Integer; const C: Char): Integer;
+  var
+    J: Integer;
+  begin
+    for J := ReadFrom to Len do
+      if (S[j] = C) then
+      begin
+        Result := J;
+        Exit;
+      end;
+    Result := Len + 1;
+  end;
+
+var
+  I, APos: Integer;
+begin
+  Len := Length(S);
+  I := 0;
+  Result := '';
+  while (I <= Len) do begin
+    Inc(I);
+    APos := ReadUntil(I, '<');
+    Result := Result + Copy(S, I, APos - i);
+    I := ReadUntil(APos + 1, '>');
+  end;
+end;
+
+function PosFromIndex(SubStr: string; Text: string;
+  StartIndex: Integer): Integer;
+var
+  I, MaxLen: SizeInt;
+  Ptr: PAnsiChar;
+begin
+  Result := 0;
+  if (StartIndex < 1) or (StartIndex > Length(Text) - Length(SubStr)) then Exit;
+  if Length(SubStr) > 0 then begin
+    MaxLen := Length(Text) - Length(SubStr) + 1;
+    I := StartIndex;
+    Ptr := @Text[StartIndex];
+    while (I <= MaxLen) do begin
+      if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin
+        Result := I;
+        Exit;
+      end;
+      Inc(I);
+      Inc(Ptr);
+    end;
+  end;
+end;
+
+function PosFromIndexReverse(SubStr: string; Text: string;
+  StartIndex: Integer): Integer;
+var
+  I: SizeInt;
+  Ptr: PAnsiChar;
+begin
+  Result := 0;
+  if (StartIndex < 1) or (StartIndex > Length(Text)) then Exit;
+  if Length(SubStr) > 0 then begin
+    I := StartIndex;
+    Ptr := @Text[StartIndex];
+    while (I > 0) do begin
+      if (SubStr[1] = Ptr^) and (CompareByte(Substr[1], Ptr^, Length(SubStr)) = 0) then begin
+        Result := I;
+        Exit;
+      end;
+      Dec(I);
+      Dec(Ptr);
+    end;
+  end;
+end;
+
+procedure CopyStringArray(Dest: TStringArray; Source: array of string);
+var
+  I: Integer;
+begin
+  SetLength(Dest, Length(Source));
+  for I := 0 to Length(Dest) - 1 do
+    Dest[I] := Source[I];
+end;
+
 
 initialization