jvqstrings.pas

East make Tray Icon in delphi

  if AText = '' then
    Exit;
  AText := Trim(AText);
  while AText <> '' do
  begin
    if AText[1] = '"' then
    begin
      Delete(AText, 1, 1);
      P := Pos('"', AText);
      if P <> 0 then
      begin
        AList.Add(Copy(AText, 1, P - 1));
        Delete(AText, 1, P);
      end;
    end
    else
    begin
      P := Pos(' ', AText);
      if P = 0 then
      begin
        AList.Add(AText);
        AText := '';
      end
      else
      begin
        AList.Add(Copy(AText, 1, P - 1));
        Delete(AText, 1, P);
      end;
    end;
    AText := Trim(AText);
  end;
end;

function JoinSet(AList: TStringList): string;
var
  I: Integer;
begin
  Result := '';
  for I := 0 to AList.Count - 1 do
    Result := Result + AList[I] + ' ';
  Delete(Result, Length(Result), 1);
end;

function SetPick(const AText: string; AIndex: Integer): string;
var
  Lit: TStringList;
  C: Integer;
begin
  Lit := TStringList.Create;
  SplitSet(AText, Lit);
  C := Lit.Count;
  if (C > 0) and (AIndex < C) then
    Result := Lit[AIndex]
  else
    Result := '';
  Lit.Free;
end;

function SetSort(const AText: string): string;
var
  Lit: TStringList;
begin
  Lit := TStringList.Create;
  SplitSet(AText, Lit);
  if Lit.Count > 0 then
  begin
    Lit.Sort;
    Result := JoinSet(Lit);
  end
  else
    Result := '';
  Lit.Free;
end;

function SetUnion(const Set1, Set2: string): string;
var
  Lit1, Lit2, Lit3: TStringList;
  I, C: Integer;
begin
  Lit1 := TStringList.Create;
  Lit2 := TStringList.Create;
  Lit3 := TStringList.Create;
  SplitSet(Set1, Lit1);
  SplitSet(Set2, Lit2);
  C := Lit2.Count;
  if C <> 0 then
  begin
    Lit2.Addstrings(Lit1);
    for I := 0 to Lit2.Count - 1 do
      if Lit3.IndexOf(Lit2[I]) = -1 then
        Lit3.Add(Lit2[I]);
    Result := JoinSet(Lit3);
  end
  else
  begin
    Result := JoinSet(Lit1);
  end;
  Lit1.Free;
  Lit2.Free;
  Lit3.Free;
end;

function SetIntersect(const Set1, Set2: string): string;
var
  Lit1, Lit2, Lit3: TStringList;
  I: Integer;
begin
  Lit1 := TStringList.Create;
  Lit2 := TStringList.Create;
  Lit3 := TStringList.Create;
  SplitSet(Set1, Lit1);
  SplitSet(Set2, Lit2);
  if Lit2.Count <> 0 then
  begin
    for I := 0 to Lit2.Count - 1 do
      if Lit1.IndexOf(Lit2[I]) <> -1 then
        Lit3.Add(Lit2[I]);
    Result := JoinSet(Lit3);
  end
  else
    Result := '';
  Lit1.Free;
  Lit2.Free;
  Lit3.Free;
end;

function SetExclude(const Set1, Set2: string): string;
var
  Lit1, Lit2: TStringList;
  I, Index: Integer;
begin
  Lit1 := TStringList.Create;
  Lit2 := TStringList.Create;
  SplitSet(Set1, Lit1);
  SplitSet(Set2, Lit2);
  if Lit2.Count <> 0 then
  begin
    for I := 0 to Lit2.Count - 1 do
    begin
      Index := Lit1.IndexOf(Lit2[I]);
      if Index <> -1 then
        Lit1.Delete(Index);
    end;
    Result := JoinSet(Lit1);
  end
  else
    Result := JoinSet(Lit1);
  Lit1.Free;
  Lit2.Free;
end;

// This function converts a string into a RFC 1630 compliant URL

function URLEncode(const Value: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(Value) do
    if Pos(UpperCase(Value[I]), ValidURLChars) > 0 then
      Result := Result + Value[I]
    else
    begin
      if Value[I] = ' ' then
        Result := Result + '+'
      else
      begin
        Result := Result + '%';
        Result := Result + IntToHex(Byte(Value[I]), 2);
      end;
    end;
end;

function URLDecode(const Value: string): string;
const
  HexChars = '0123456789ABCDEF';
var
  I: Integer;
  Ch, H1, H2: Char;
  Len: Integer;
begin
  Result := '';
  Len := Length(Value);
  I := 1;
  while I <= Len do
  begin
    Ch := Value[I];
    case Ch of
      '%':
        begin
          H1 := Value[I + 1];
          H2 := Value[I + 2];
          Inc(I, 2);
          Result := Result + Chr(((Pos(H1, HexChars) - 1) * 16) + (Pos(H2, HexChars) - 1));
        end;
      '+':
        Result := Result + ' ';
      '&':
        Result := Result + CrLf;
    else
      Result := Result + Ch;
    end;
    Inc(I);
  end;
end;

{template functions}

function ReplaceFirst(const SourceStr, FindStr, ReplaceStr: string): string;
var
  P: Integer;
begin
  Result := SourceStr;
  P := PosText(FindStr, SourceStr, 1);
  if P <> 0 then
    Result := Copy(SourceStr, 1, P - 1) + ReplaceStr + Copy(SourceStr, P + Length(FindStr), Length(SourceStr));
end;

function ReplaceLast(const SourceStr, FindStr, ReplaceStr: string): string;
var
  P: Integer;
begin
  Result := SourceStr;
  P := PosTextLast(FindStr, SourceStr);
  if P <> 0 then
    Result := Copy(SourceStr, 1, P - 1) + ReplaceStr + Copy(SourceStr, P + Length(FindStr), Length(SourceStr));
end;

// insert a block template
// the last occurance of {block:aBlockname}
// the block template is marked with {begin:aBlockname} and {end:aBlockname}

function InsertLastBlock(var SourceStr: string; BlockStr: string): Boolean;
var
  // phead: Integer;
  PBlock, PE, PB: Integer;
  SBB, SBE, SB, SBR: string;
  SBBL, SBEL: Integer;
begin
  Result := False;
  //  phead:= PosStr('</head>',SourceStr,1);
  //  If phead = 0 Then Exit;
  //  phead:= phead + 7;
  SB := '{block:' + BlockStr + '}';
  //  sbL:=Length(SB);
  SBB := '{begin:' + BlockStr + '}';
  SBBL := Length(SBB);
  SBE := '{end:' + BlockStr + '}';
  SBEL := Length(SBE);
  PBlock := PosTextLast(SB, SourceStr);
  if PBlock = 0 then
    Exit;
  PB := PosText(SBB, SourceStr, 1);
  if PB = 0 then
    Exit;
  PE := PosText(SBE, SourceStr, PB);
  if PE = 0 then
    Exit;
  PE := PE + SBEL - 1;
  // now replace
  SBR := Copy(SourceStr, PB + SBBL, PE - PB - SBBL - SBEL + 1);
  SourceStr := Copy(SourceStr, 1, PBlock - 1) + SBR + Copy(SourceStr, PBlock, Length(SourceStr));
  Result := True;
end;

// removes all  {begin:somefield} to {end:somefield} from ASource

function RemoveMasterBlocks(const SourceStr: string): string;
var
  S, Src: string;
  PB: Integer;
  PE: Integer;
  PEE: Integer;
begin
  S := '';
  Src := SourceStr;
  repeat
    PB := PosText('{begin:', Src);
    if PB > 0 then
    begin
      PE := PosText('{end:', Src, PB);
      if PE > 0 then
      begin
        PEE := PosStr('}', Src, PE);
        if PEE > 0 then
        begin
          S := S + Copy(Src, 1, PB - 1);
          Delete(Src, 1, PEE);
        end;
      end;
    end;
  until PB = 0;
  Result := S + Src;
end;

// removes all {field} entries in a template

function RemoveFields(const SourceStr: string): string;
var
  Src, S: string;
  PB: Integer;
  PE: Integer;
begin
  S := '';
  Src := SourceStr;
  repeat
    PB := Pos('{', Src);
    if PB > 0 then
    begin
      PE := Pos('}', Src);
      if PE > 0 then
      begin
        S := S + Copy(Src, 1, PB - 1);
        Delete(Src, 1, PE);
      end;
    end;
  until PB = 0;
  Result := S + Src;
end;

{finds the last occurance}

function PosStrLast(const FindString, SourceString: string): Integer;
var
  I, L: Integer;
begin
  Result := 0;
  L := Length(FindString);
  if L = 0 then
    Exit;
  I := Length(SourceString);
  if I = 0 then
    Exit;
  I := I - L + 1;
  while I > 0 do
  begin
    Result := PosStr(FindString, SourceString, I);
    if Result > 0 then
      Exit;
    I := I - L;
  end;
end;

{finds the last occurance}

function PosTextLast(const FindString, SourceString: string): Integer;
var
  I, L: Integer;
begin
  Result := 0;
  L := Length(FindString);
  if L = 0 then
    Exit;
  I := Length(SourceString);
  if I = 0 then
    Exit;
  I := I - L + 1;
  while I > 0 do
  begin
    Result := PosText(FindString, SourceString, I);
    if Result > 0 then
      Exit;
    I := I - L;
  end;
end;

procedure DirFiles(const ADir, AMask: string; AFileList: TStringList);
var
  SR: TSearchRec;
  FileAttrs: Integer;
begin
  FileAttrs := faArchive + faDirectory;
  if FindFirst(ADir + AMask, FileAttrs, SR) = 0 then
    while FindNext(SR) = 0 do
      if (SR.Attr and faArchive) <> 0 then
        AFileList.Add(ADir + SR.Name);
  FindClose(SR);
end;

// parse number returns the last position, starting from 1

function ParseNumber(const S: string): Integer;
var
  I, E, E2, C: Integer;
begin
  Result := 0;
  I := 0;
  C := Length(S);
  if C = 0 then
    Exit;
  while (I + 1 <= C) and (S[I + 1] in (DigitChars + [',', '.'])) do
    Inc(I);
  if (I + 1 <= C) and (S[I + 1] in ['e', 'E']) then
  begin
    E := I;
    Inc(I);
    if (I + 1 <= C) and (S[I + 1] in ['+', '-']) then
      Inc(I);
    E2 := I;
    while (I + 1 <= C) and (S[I + 1] in DigitChars) do
      Inc(I);
    if I = E2 then
      I := E;
  end;
  Result := I;
end;

// parse a SQL style data string from positions 1,
// starts and ends with #

function ParseDate(const S: string): Integer;
var
  P: Integer;
begin
  Result := 0;
  if Length(S) < 2 then
    Exit;
  P := PosStr('#', S, 2);
  if P <> 0 then
    try
      StrToDate(Copy(S, 2, P - 2));
      Result := P;
    except
      Result := 0;
    end;
end;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvQStrings.pas,v $';
    Revision: '$Revision: 1.18 $';
    Date: '$Date: 2004/09/11 21:07:04 $';
    LogPath: 'JVCL\run'
  );

initialization
  RegisterUnitVersion(HInstance, UnitVersioning);

finalization
  UnregisterUnitVersion(HInstance);
{$ENDIF UNITVERSIONING}

end.