jvqstrings.pas

East make Tray Icon in delphi

procedure TagsToCSV(Src, Dst: TStringList);
var
  I, FI, FC: Integer;
  Names: TStringList;
  Rec: TStringList;
  S: string;
begin
  Dst.Clear;
  if Src.Count < 1 then
    Exit;
  Names := TStringList.Create;
  Rec := TStringList.Create;
  try
    GetNames(Src[0], Names);
    FC := Names.Count;
    if FC > 0 then
    begin
      Dst.Add(Names.CommaText);
      for I := 0 to Src.Count - 1 do
      begin
        S := '';
        Rec.Clear;
        for FI := 0 to FC - 1 do
          Rec.Add(GetValue(Src[I], Names[FI]));
        Dst.Add(Rec.CommaText);
      end;
    end;
  finally
    Rec.Free;
    Names.Free;
  end;
end;

function B64Encode;
var
  I: Integer;
  InBuf: array [0..2] of Byte;
  OutBuf: array [0..3] of Char;
begin
  SetLength(Result, ((Length(S) + 2) div 3) * 4);
  for I := 1 to ((Length(S) + 2) div 3) do
  begin
    if Length(S) < (I * 3) then
      Move(S[(I - 1) * 3 + 1], InBuf, Length(S) - (I - 1) * 3)
    else
      Move(S[(I - 1) * 3 + 1], InBuf, 3);
    OutBuf[0] := B64Table[((InBuf[0] and $FC) shr 2) + 1];
    OutBuf[1] := B64Table[(((InBuf[0] and $03) shl 4) or ((InBuf[1] and $F0) shr 4)) + 1];
    OutBuf[2] := B64Table[(((InBuf[1] and $0F) shl 2) or ((InBuf[2] and $C0) shr 6)) + 1];
    OutBuf[3] := B64Table[(InBuf[2] and $3F) + 1];
    Move(OutBuf, Result[(I - 1) * 4 + 1], 4);
  end;
  if (Length(S) mod 3) = 1 then
  begin
    Result[Length(Result) - 1] := '=';
    Result[Length(Result)] := '=';
  end
  else
  if (Length(S) mod 3) = 2 then
    Result[Length(Result)] := '=';
end;

function B64Decode(const S: string): string;
var
  I: Integer;
  InBuf: array [0..3] of Byte;
  OutBuf: array [0..2] of Byte;
  RetValue: string;
begin
  if ((Length(S) mod 4) <> 0) or (S = '') then
    raise EJVCLException.CreateRes(@RsEIncorrectStringFormat);

  SetLength(RetValue, ((Length(S) div 4) - 1) * 3);
  for I := 1 to ((Length(S) div 4) - 1) do
  begin
    Move(S[(I - 1) * 4 + 1], InBuf, 4);
    if (InBuf[0] > 64) and (InBuf[0] < 91) then
      Dec(InBuf[0], 65)
    else
    if (InBuf[0] > 96) and (InBuf[0] < 123) then
      Dec(InBuf[0], 71)
    else
    if (InBuf[0] > 47) and (InBuf[0] < 58) then
      Inc(InBuf[0], 4)
    else
    if InBuf[0] = 43 then
      InBuf[0] := 62
    else
      InBuf[0] := 63;
    if (InBuf[1] > 64) and (InBuf[1] < 91) then
      Dec(InBuf[1], 65)
    else
    if (InBuf[1] > 96) and (InBuf[1] < 123) then
      Dec(InBuf[1], 71)
    else
    if (InBuf[1] > 47) and (InBuf[1] < 58) then
      Inc(InBuf[1], 4)
    else
    if InBuf[1] = 43 then
      InBuf[1] := 62
    else
      InBuf[1] := 63;
    if (InBuf[2] > 64) and (InBuf[2] < 91) then
      Dec(InBuf[2], 65)
    else
    if (InBuf[2] > 96) and (InBuf[2] < 123) then
      Dec(InBuf[2], 71)
    else
    if (InBuf[2] > 47) and (InBuf[2] < 58) then
      Inc(InBuf[2], 4)
    else
    if InBuf[2] = 43 then
      InBuf[2] := 62
    else
      InBuf[2] := 63;
    if (InBuf[3] > 64) and (InBuf[3] < 91) then
      Dec(InBuf[3], 65)
    else
    if (InBuf[3] > 96) and (InBuf[3] < 123) then
      Dec(InBuf[3], 71)
    else
    if (InBuf[3] > 47) and (InBuf[3] < 58) then
      Inc(InBuf[3], 4)
    else
    if InBuf[3] = 43 then
      InBuf[3] := 62
    else
      InBuf[3] := 63;
    OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
    OutBuf[1] := (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $0F);
    OutBuf[2] := (InBuf[2] shl 6) or (InBuf[3] and $3F);
    Move(OutBuf, RetValue[(I - 1) * 3 + 1], 3);
  end;
  if S <> '' then
  begin
    Move(S[Length(S) - 3], InBuf, 4);
    if InBuf[2] = 61 then
    begin
      if (InBuf[0] > 64) and (InBuf[0] < 91) then
        Dec(InBuf[0], 65)
      else
      if (InBuf[0] > 96) and (InBuf[0] < 123) then
        Dec(InBuf[0], 71)
      else
      if (InBuf[0] > 47) and (InBuf[0] < 58) then
        Inc(InBuf[0], 4)
      else
      if InBuf[0] = 43 then
        InBuf[0] := 62
      else
        InBuf[0] := 63;
      if (InBuf[1] > 64) and (InBuf[1] < 91) then
        Dec(InBuf[1], 65)
      else
      if (InBuf[1] > 96) and (InBuf[1] < 123) then
        Dec(InBuf[1], 71)
      else
      if (InBuf[1] > 47) and (InBuf[1] < 58) then
        Inc(InBuf[1], 4)
      else
      if InBuf[1] = 43 then
        InBuf[1] := 62
      else
        InBuf[1] := 63;
      OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
      RetValue := RetValue + Char(OutBuf[0]);
    end
    else
    if InBuf[3] = 61 then
    begin
      if (InBuf[0] > 64) and (InBuf[0] < 91) then
        Dec(InBuf[0], 65)
      else
      if (InBuf[0] > 96) and (InBuf[0] < 123) then
        Dec(InBuf[0], 71)
      else
      if (InBuf[0] > 47) and (InBuf[0] < 58) then
        Inc(InBuf[0], 4)
      else
      if InBuf[0] = 43 then
        InBuf[0] := 62
      else
        InBuf[0] := 63;
      if (InBuf[1] > 64) and (InBuf[1] < 91) then
        Dec(InBuf[1], 65)
      else
      if (InBuf[1] > 96) and (InBuf[1] < 123) then
        Dec(InBuf[1], 71)
      else
      if (InBuf[1] > 47) and (InBuf[1] < 58) then
        Inc(InBuf[1], 4)
      else
      if InBuf[1] = 43 then
        InBuf[1] := 62
      else
        InBuf[1] := 63;
      if (InBuf[2] > 64) and (InBuf[2] < 91) then
        Dec(InBuf[2], 65)
      else
      if (InBuf[2] > 96) and (InBuf[2] < 123) then
        Dec(InBuf[2], 71)
      else
      if (InBuf[2] > 47) and (InBuf[2] < 58) then
        Inc(InBuf[2], 4)
      else
      if InBuf[2] = 43 then
        InBuf[2] := 62
      else
        InBuf[2] := 63;
      OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
      OutBuf[1] := (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $0F);
      RetValue := RetValue + Char(OutBuf[0]) + Char(OutBuf[1]);
    end
    else
    begin
      if (InBuf[0] > 64) and (InBuf[0] < 91) then
        Dec(InBuf[0], 65)
      else
      if (InBuf[0] > 96) and (InBuf[0] < 123) then
        Dec(InBuf[0], 71)
      else
      if (InBuf[0] > 47) and (InBuf[0] < 58) then
        Inc(InBuf[0], 4)
      else
      if InBuf[0] = 43 then
        InBuf[0] := 62
      else
        InBuf[0] := 63;
      if (InBuf[1] > 64) and (InBuf[1] < 91) then
        Dec(InBuf[1], 65)
      else
      if (InBuf[1] > 96) and (InBuf[1] < 123) then
        Dec(InBuf[1], 71)
      else
      if (InBuf[1] > 47) and (InBuf[1] < 58) then
        Inc(InBuf[1], 4)
      else
      if InBuf[1] = 43 then
        InBuf[1] := 62
      else
        InBuf[1] := 63;
      if (InBuf[2] > 64) and (InBuf[2] < 91) then
        Dec(InBuf[2], 65)
      else
      if (InBuf[2] > 96) and (InBuf[2] < 123) then
        Dec(InBuf[2], 71)
      else
      if (InBuf[2] > 47) and (InBuf[2] < 58) then
        Inc(InBuf[2], 4)
      else
      if InBuf[2] = 43 then
        InBuf[2] := 62
      else
        InBuf[2] := 63;
      if (InBuf[3] > 64) and (InBuf[3] < 91) then
        Dec(InBuf[3], 65)
      else
      if (InBuf[3] > 96) and (InBuf[3] < 123) then
        Dec(InBuf[3], 71)
      else
      if (InBuf[3] > 47) and (InBuf[3] < 58) then
        Inc(InBuf[3], 4)
      else
      if InBuf[3] = 43 then
        InBuf[3] := 62
      else
        InBuf[3] := 63;
      OutBuf[0] := (InBuf[0] shl 2) or ((InBuf[1] shr 4) and $03);
      OutBuf[1] := (InBuf[1] shl 4) or ((InBuf[2] shr 2) and $0F);
      OutBuf[2] := (InBuf[2] shl 6) or (InBuf[3] and $3F);
      RetValue := RetValue + Char(OutBuf[0]) + Char(OutBuf[1]) + Char(OutBuf[2]);
    end;
  end;
  Result := RetValue;
end;

{*******************************************************
 * Standard Encryption algorithm - Copied from Borland *
 *******************************************************}

function Encrypt(const InString: string; StartKey, MultKey, AddKey: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(InString) do
  begin
    Result := Result + Char(Byte(InString[I]) xor (StartKey shr 8));
    StartKey := (Byte(Result[I]) + StartKey) * MultKey + AddKey;
  end;
end;
{*******************************************************
 * Standard Decryption algorithm - Copied from Borland *
 *******************************************************}

function Decrypt(const InString: string; StartKey, MultKey, AddKey: Integer): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(InString) do
  begin
    Result := Result + Char(Byte(InString[I]) xor (StartKey shr 8));
    StartKey := (Byte(InString[I]) + StartKey) * MultKey + AddKey;
  end;
end;

function EncryptB64(const InString: string; StartKey, MultKey, AddKey: Integer): string;
begin
  Result := B64Encode(Encrypt(InString, StartKey, MultKey, AddKey));
end;

function DecryptB64(const InString: string; StartKey, MultKey, AddKey: Integer): string;
begin
  Result := Decrypt(B64Decode(InString), StartKey, MultKey, AddKey);
end;

function Hash(const AText: string): Integer;
var
  I: Integer;
begin
  Result := 0;
  if AText = '' then
    Exit;
  Result := Ord(AText[1]);
  for I := 2 to Length(AText) do
    Result := (Result * Ord(AText[I])) xor Result;
end;

{replace any <,> etc by &lt; &gt;}

function XMLSafe(const AText: string): string;
var
  I: Integer;
begin
  Result := '';
  for I := 1 to Length(AText) do
    if AText[I] = '<' then
      Result := Result + '&lt;'
    else
    if AText[I] = '>' then
      Result := Result + '&gt;'
    else
    if AText[I] = '&' then
      Result := Result + '&amp;'
    else
    if (Ord(AText[I]) >= 32) and (Ord(AText[I]) < 128) then
      Result := Result + AText[I]
    else
    if Ord(AText[I]) > 127 then
      Result := Result + '&#' + IntToStr(Ord(AText[I])) + ';'
    else
      Result := Result + ' ';
end;

function FirstOfSet(const AText: string): string;
var
  P: Integer;
begin
  Result := Trim(AText);
  if Result = '' then
    Exit;
  if Result[1] = '"' then
  begin
    P := PosStr('"', Result, 2);
    Result := Copy(Result, 2, P - 2);
  end
  else
  begin
    P := Pos(' ', Result);
    Result := Copy(Result, 1, P - 1);
  end;
end;

function LastOfSet(const AText: string): string;
var
  C: Integer;
begin
  Result := Trim(AText);
  if Result = '' then
    Exit;
  C := Length(Result);
  if Result[C] = '"' then
  begin
    while (C > 1) and (Result[C - 1] <> '"') do
      Dec(C);
    Result := Copy(Result, C, Length(Result) - C);
  end
  else
  begin
    while (C > 1) and (Result[C - 1] <> ' ') do
      Dec(C);
    Result := Copy(Result, C, Length(Result));
  end;
end;

function CountOfSet(const AText: string): Integer;
var
  Lit: TStringList;
begin
  Lit := TStringList.Create;
  SplitSet(AText, Lit);
  Result := Lit.Count;
  Lit.Free;
end;

function SetRotateRight(const AText: string): string;
var
  Lit: TStringList;
  C: Integer;
begin
  Lit := TStringList.Create;
  SplitSet(AText, Lit);
  C := Lit.Count;
  if C > 0 then
  begin
    Lit.Move(C - 1, 0);
    Result := JoinSet(Lit);
  end
  else
    Result := '';
  Lit.Free;
end;

function SetRotateLeft(const AText: string): string;
var
  Lit: TStringList;
  C: Integer;
begin
  Lit := TStringList.Create;
  SplitSet(AText, Lit);
  C := Lit.Count;
  if C > 0 then
  begin
    Lit.Move(0, C - 1);
    Result := JoinSet(Lit);
  end
  else
    Result := '';
  Lit.Free;
end;

procedure SplitSet(AText: string; AList: TStringList);
var
  P: Integer;
begin
  AList.Clear;