clutils.pas

Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码 Clever_Internet_Suite_6.2的代码

    FreeMem(p);
  end;
end;

function GetTextStr(AList: TStrings; AStartFrom, ACount: Integer): string;
const
  LB = #13#10;
var
  I, L, Size, Count: Integer;
  P: PChar;
  S: string;
begin
  Count := ACount;
  if (Count > AList.Count - AStartFrom) then
  begin
    Count := AList.Count - AStartFrom;
  end;
  
  Size := 0;
  for I := 0 to Count - 1 do Inc(Size, Length(AList[I + AStartFrom]) + Length(LB));
  SetString(Result, nil, Size);
  P := Pointer(Result);
  for I := 0 to Count - 1 do
  begin
    S := AList[I + AStartFrom];
    L := Length(S);
    if L <> 0 then
    begin
      System.Move(Pointer(S)^, P^, L);
      Inc(P, L);
    end;            
    L := Length(LB);
    if L <> 0 then
    begin
      System.Move(LB, P^, L);
      Inc(P, L);
    end;
  end;
end;

const
  SpecialSymbols = ['\', '"', '(', ')'];

function GetNormName(const AName: string): string;
  function GetSymbolsTotalCount(const AValue: String; ASymbolsSet: TCharSet): Integer;
  var
    i: Integer;
  begin
    Result := 0;
    for i := 1 to Length(AValue) do
    begin
      if (AValue[i] in ASymbolsSet) then Inc(Result);
    end;
  end;

var
  i, j, SpecialCount: Integer;
begin
  SpecialCount := GetSymbolsTotalCount(AName, SpecialSymbols);
  if (SpecialCount > 0) then
  begin
    SetLength(Result, SpecialCount + Length(AName));
    j := 0;
    for i := 1 to Length(AName) do
    begin
      Inc(j);
      if (AName[i] in SpecialSymbols) then
      begin
        Result[j] := '\';
        Inc(j);
      end;
      Result[j] := AName[i];
    end;
    Result := '"' + Result + '"';
  end else
  begin
    Result := AName;
  end;
  if (system.Pos(' ', Result) > 0)
    and (Result[1] <> '"') and (Result[Length(Result)] <> '"') then
  begin
    Result := '"' + Result + '"';
  end;
end;

function GetDenormName(const AName: string): string;
var
  i, j: Integer;
  Len: Integer;
  SpecSymExpect: Boolean;
  Sym: Char;
begin
  SpecSymExpect := False;
  Len := Length(AName);
  SetLength(Result, Len);
  i := 1;
  j := 1;
  while (i <= Length(AName)) do
  begin
    Sym := AName[i];
    case Sym of
      '\':
          begin
            if not SpecSymExpect then
            begin
              SpecSymExpect := True;
              Inc(i);
              Continue;
            end;
          end;
      '"':
          begin
            if not SpecSymExpect then
            begin
             Sym := ' ';
            end;
          end;
    end;
    SpecSymExpect := False;
    Result[j] := Sym;
    Inc(j);
    Inc(i);
  end;
  SetLength(Result, j - 1);
end;

function TextPos(const SubStr, Str: string; StartPos: Integer): Integer;
var
  PosRes, StrLen: Integer;
  s: string;
begin
  Result := 0;
  StrLen := Length(Str);
  if (StartPos < 1) or (StartPos > StrLen) then Exit;
  s := system.Copy(Str, StartPos, StrLen);
  PosRes := system.Pos(SubStr, s);
  if (PosRes <> 0) then Result := StartPos + PosRes - 1;
end;

function RTextPos(const SubStr, Str: String; StartPos: Integer = -1): Integer;
var
  i, len: Integer;
begin
  Result := 0;
  len := Length(SubStr);
  if StartPos = -1 then
  begin
    StartPos := Length(Str);
  end;
  if StartPos >= (Length(Str) - len + 1) then
  begin
    StartPos := (Length(Str) - len + 1);
  end;
  for i := StartPos downto 1 do
  begin
    if SameText(Copy(Str, i, len), SubStr) then
    begin
      Result := i;
      Break;
    end;
  end;
end;

function WordCount(const S: string; const WordDelims: TCharSet): Integer;
var
  SLen, I: Cardinal;
begin
  Result := 0;
  I := 1;
  SLen := Length(S);
  while I <= SLen do
  begin
    while (I <= SLen) and (S[I] in WordDelims) do Inc(I);
    if I <= SLen then Inc(Result);
    while (I <= SLen) and not(S[I] in WordDelims) do Inc(I);
  end;
end;

function WordPosition(const N: Integer; const S: string;
  const WordDelims: TCharSet): Integer;
var
  Count, I: Integer;
begin
  Count := 0;
  I := 1;
  Result := 0;
  while (I <= Length(S)) and (Count <> N) do
  begin
    while (I <= Length(S)) and (S[I] in WordDelims) do Inc(I);
    if I <= Length(S) then Inc(Count);
    if Count <> N then
      while (I <= Length(S)) and not (S[I] in WordDelims) do Inc(I)
    else Result := I;
  end;
end;

function ExtractWord(N: Integer; const S: string;
  const WordDelims: TCharSet): string;
var
  I: Word;
  Len: Integer;
begin
  Len := 0;
  I := WordPosition(N, S, WordDelims);
  if I <> 0 then
  begin
    while (I <= Length(S)) and not(S[I] in WordDelims) do
    begin
      Inc(Len);
      SetLength(Result, Len);
      Result[Len] := S[I];
      Inc(I);
    end;
  end;
  SetLength(Result, Len);
end;

function ExtractQuotedString(const S: string; const AQuoteBegin: Char; const AQuoteEnd: Char): string;
var
  q: Char;
begin
  Result := S;
  if Length(Result) < 2 then Exit;
  q := AQuoteEnd;
  if (AQuoteEnd = #0) then
  begin
    q := AQuoteBegin;
  end;
  if ((Result[1] = AQuoteBegin) and (Result[Length(Result)] = q)) then
  begin
    Result := System.Copy(Result, 2, Length(Result) - 2);
  end;
end;

function ExtractNumeric(const ASource: string; AStartPos: Integer): string;
var
  ind: Integer;
begin
  ind := AStartPos;
  while ((ind <= Length(ASource)) and (ASource[ind] in ['0'..'9'])) do
  begin
    Inc(ind);
  end;
  Result := system.Copy(ASource, AStartPos, ind - AStartPos);
end;

function GetStreamAsString(AStream: TStream; ASize: Integer; DefaultChar: Char): string;
var
  p: PChar;
  StreamPos: Integer;
begin
  StreamPos := AStream.Position;
  if (ASize = 0) or (ASize > AStream.Size) then
  begin
    ASize := AStream.Size;
  end;
  GetMem(p, ASize + 1);
  try
    AStream.Position := 0;
    ZeroMemory(p, ASize + 1);
    AStream.Read(p^, ASize);
    Result := GetDataAsText(p, ASize, DefaultChar);
  finally
    FreeMem(p);
    AStream.Position := StreamPos;
  end;
end;

procedure SetLocalFileTime(const AFileName: string; ADate: TDateTime);
var
  hFile: THandle;
  filedate: TFileTime;
  sysdate: TSystemTime;
begin
  hFile := CreateFile(PChar(AFileName), GENERIC_WRITE, FILE_SHARE_READ, nil, OPEN_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0);
  if (hFile <> INVALID_HANDLE_VALUE) then
  begin
    DateTimeToSystemTime(ADate, sysdate);
    SystemTimeToFileTime(sysdate, filedate);
    LocalFileTimeToFileTime(filedate, filedate);
    SetFileTime(hFile, @filedate, @filedate, @filedate);
    CloseHandle(hFile);
  end;
end;

function GetFullFileName(const AFileName, AFolder: string): string;
begin
  Result := AddTrailingBackSlash(AFolder) + ExtractFileName(AFileName);
end;

function GetDataAsText(Data: PChar; Size: Integer; DefaultChar: Char): string;
var
  i: Integer;
begin
  Result := '';
  for i := 0 to Size - 1 do
  begin
    if (Ord(Data[i]) < 32) and not (Ord(Data[i]) in [9, 10, 13]) then
    begin
      Result := Result + DefaultChar;
    end else
    begin
      Result := Result + Data[i];
    end;
  end;
end;

{$IFNDEF DELPHI5}
function ExcludeTrailingBackslash(const S: string): string;
begin
  Result := S;
  if IsPathDelimiter(Result, Length(Result)) then
    SetLength(Result, Length(Result)-1);
end;
{$ENDIF}

function ForceFileDirectories(const AFilePath: string): Boolean;
  function ForceDirs(Dir: String): Boolean;
  begin
    Result := True;
    if Length(Dir) = 0 then Exit;
    Dir := ExcludeTrailingBackslash(Dir);
    if (Length(Dir) < 3) or DirectoryExists(Dir)
      or (ExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
    Result := ForceDirs(ExtractFilePath(Dir)) and CreateDir(Dir);
  end;

begin
  Result := ForceDirs(ExtractFilePath(AFilePath));
end;

function DeleteRecursiveDir(const ARoot: string): Boolean;
var
  root: string;
  sr: TSearchRec;
begin
  root := ExcludeTrailingBackslash(ARoot);
  if FindFirst(root + '\*.*', faAnyFile, sr) = 0 then
  begin
    repeat
      if (sr.Name <> '.') and (sr.Name <> '..') then
      begin
        if (sr.Attr and faDirectory) > 0 then
        begin
          DeleteRecursiveDir(root + '\' + sr.Name);
        end else
        begin
          DeleteFile(root + '\' + sr.Name);
        end;
      end;
    until FindNext(sr) <> 0;
    FindClose(sr);
  end;
  Result := RemoveDir(ARoot);
end;

function GetHeaderFieldList(AStartFrom: Integer; ASource, AFieldList: TStrings): Integer;
var
  ind: Integer;
begin
  Result := AStartFrom;
  while (Result < ASource.Count) and (ASource[Result] <> '') do
  begin
    if not (ASource[Result][1] in [#9, #32]) then
    begin
      ind := system.Pos(':', ASource[Result]);
      if (ind > 0) then
      begin
        AFieldList.AddObject(LowerCase(system.Copy(ASource[Result], 1, ind - 1)), TObject(Result));
      end;
    end;
    Inc(Result);
  end;
end;

function GetHeaderFieldValue(ASource, AFieldList: TStrings; const AName: string): string;
begin
  Result := GetHeaderFieldValue(ASource, AFieldList, AFieldList.IndexOf(LowerCase(AName)));
end;

function GetHeaderFieldValue(ASource, AFieldList: TStrings; AIndex: Integer): string;
var
  Ind, i: Integer;
begin
  if (AIndex > -1) and (AIndex < AFieldList.Count) then
  begin
    Ind := Integer(AFieldList.Objects[AIndex]);
    Result := system.Copy(ASource[Ind], Length(AFieldList[AIndex] + ':') + 1, 1000);
    Result := TrimLeft(Result);
    for i := Ind + 1 to ASource.Count - 1 do
    begin
      if not ((ASource[i] <> '') and (ASource[i][1] in [#9, #32])) then
      begin
        Break;
      end;
      Result := Result + Trim(ASource[i]);
    end;
  end else
  begin
    Result := '';
  end;
end;

procedure AddHeaderMultiField(ASource, AValues: TStrings; const AName, ADelimiter: string);
var
  i: Integer;
  Comma: array[Boolean] of string;
begin
  if (AValues.Count > 0) then
  begin
    Comma[False] := '';
    Comma[True] := ADelimiter;
    AddHeaderField(ASource, AName, AValues[0] + Comma[AValues.Count > 1]);
    for i := 1 to AValues.Count - 1 do
    begin
      ASource.Add(#9 + AValues[i] + Comma[i < (AValues.Count - 1)]);
    end;
  end;
end;

procedure AddHeaderArrayField(ASource: TStrings; const AValues: array of string;
  const AName, ADelimiter: string);
var
  i: Integer;
  List: TStrings;
begin
  List := TStringList.Create();
  try
    for i := Low(AValues) to High(AValues) do
    begin
      List.Add(AValues[i]);
    end;
    AddHeaderMultiField(ASource, List, AName, ADelimiter);
  finally
    List.Free();
  end;
end;

procedure AddHeaderField(ASource: TStrings; const AName, AValue: string);
var
  NormValue: string;
begin
  if (AValue <> '') then
  begin
    NormValue := StringReplace(AValue, #13#10, #13#10#9, [rfReplaceAll]);
    if (NormValue <> '') and (NormValue[Length(NormValue)] = #9) then
    begin
      system.Delete(NormValue, Length(NormValue), 1);
    end;
    AddTextStr(ASource, Format('%s: %s', [AName, NormValue]));
  end;
end;

procedure RemoveHeaderField(ASource, AFieldList: TStrings; const AName: string);
begin
  RemoveHeaderField(ASource, AFieldList, AFieldList.IndexOf(LowerCase(AName)));
end;

procedure RemoveHeaderField(ASource, AFieldList: TStrings; AIndex: Integer); overload;
var
  i: Integer;
begin
  if (AIndex > -1) then
  begin
    i := Integer(AFieldList.Objects[AIndex]);
    ASource.Delete(i);

    while (i < ASource.Count) do
    begin
      if (Length(ASource[i]) > 0) and (ASource[i][1] in [#9, #32]) then
      begin
        ASource.Delete(i);
      end else
      begin
        Break;
      end;
    end;
  end;
end;

procedure InsertHeaderFieldIfNeed(ASource: TStrings; const AName, AValue: string);
var
  ind: Integer;
  fieldList: TStrings;
begin
  if (AValue = '') then Exit;

  fieldList := TStringList.Create();
  try
    ind := GetHeaderFieldList(0, ASource, fieldList);
    if (fieldList.IndexOf(LowerCase(AName)) < 0) then
    begin
      if (ind < 0) or (ind > ASource.Count) then
      begin
        ind := ASource.Count;
      end;

      Assert(system.Pos(#13#10, AValue) < 1);
      ASource.Insert(ind, Format('%s: %s', [AName, AValue]));
    end;
  finally
    fieldList.Free();
  end;
end;

function IndexOfStrArray(const S: string; AStrArray: array of string): Integer;
begin
  for Result := Low(AStrArray) to High(AStrArray) do
  begin
    if (CompareText(AStrArray[Result], S) = 0) then Exit;
  end;
  Result := -1;
end;

function ReversedString(const AStr: string): string;
var
  I: Integer;
  P: PChar;
begin
  SetLength(Result, Length(AStr));
  P := PChar(Result);
  for I := Length(AStr) downto 1 do
  begin
    P^ := AStr[I];
    Inc(P);
  end;
end;

function MakeRelativePath(const ABasePath, ARelativePath: string): string;
  procedure GetPathList(const APath: string; AList: TStrings);
  var
    i: Integer;
    s: string;
  begin
    s := '';
    AList.Clear();
    for i := Length(APath) downto 1 do