jvqcsvparse.pas

East make Tray Icon in delphi

  S2[W] := Chr(0); { Terminate new string }
  Inc(TokenCount);
end;

function StrEatWhiteSpace(const S: string): string;
var
  Buf: array [0..1024] of Char;
begin
  if Length(S) > 1024 then
  begin
    Result := S;
    Exit;
  end;
  StrCopy(Buf, PChar(S));
  PCharEatWhiteChars(Buf);
  Result := string(Buf);
end;

{ strip whitespace from pchar - space or tab }

procedure PCharEatWhiteChars(S1: PChar);
var
  T, U, L: Integer;
begin
  L := StrLen(S1);
  // U := L;
  if L <= 0 then
    Exit;
  { skip spaces starting at the beginning }
  for T := 0 to L do
    if (S1[T] <> ' ') and (S1[T] <> Tab) then
      Break;
  { skip spaces starting at the end }
  for U := L - 1 downto T do
    if (S1[U] <> ' ') and (S1[U] <> Tab) then
      Break;
  if (T > 0) or (U < L - 1) then
    if T > U then  // was T>=U (test me!)
      S1[0] := Chr(0)
    else
      StrLCopy(S1, S1 + T, (U - T) + 1);
end;

function GetParenthesis(S1, S2: PChar): Boolean;
var
  Token, TempBuf: array [0..128] of Char;
  Brackets: Integer;
begin
  { make temporary copy of S1, check for parenthesis }
  StrCopy(TempBuf, S1);
  GetToken(TempBuf, S2);
  if StrComp(S2, '(') = 0 then
  begin
    Brackets := 1;
    S2[0] := Chr(0);
    repeat
      GetToken(TempBuf, Token);
      if StrComp(Token, ')') = 0 then
        Dec(Brackets);
      if Brackets > 0 then
      begin
        StrCat(S2, Token);
        StrCat(S2, ' ');
      end;
      if StrComp(Token, '(') = 0 then
        Inc(Brackets);
    until (StrLen(S1) = 0) or (Brackets = 0);
    if Brackets <> 0 then
    begin
      S2[0] := Chr(0);
      Result := False;
      Exit;
    end;
    StrCopy(S1, TempBuf); { remainder back into S1 }
    Result := True;
  end
  else
  begin { not parenthesis }
    S2[0] := Chr(0);
    Result := False;
    Exit;
  end;
end;

{ Gets a single token like ABC, or gets ABC[X] type reference if present }

procedure GetVarReference(S1, S2, SIdx: PChar);
var
  TempBuf: array [0..128] of Char;
  Brackets: Integer;
begin
  GetToken(S1, S2);
  SIdx[0] := Chr(0);
  PCharEatWhiteChars(S1);
  if S1[0] = '[' then
  begin
    Brackets := 0;
    repeat
      GetToken(S1, TempBuf);
      StrCat(SIdx, TempBuf);
      if StrComp(TempBuf, ']') = 0 then
        Dec(Brackets);
      if StrComp(TempBuf, '[') = 0 then
        Inc(Brackets);

      if StrLen(S1) = 0 then
        Break;
    until Brackets <= 0;

    { Remove outermost brackets }
    StrLCopy(SIdx, SIdx + 1, StrLen(SIdx) - 2);
  end;
end;

{ Expects ABC or ABC[X] type of reference }

function ValidVarReference(S1: PChar): Boolean;
var
  Len1: Integer;
  TempBuf1, TempBuf2: array [0..128] of Char;
begin
  StrCopy(S1, TempBuf1);
  GetToken(TempBuf1, TempBuf2);
  if StrLen(TempBuf1) = 0 then
    Result := ValidIdentifier(S1)
  else
  begin
    Len1 := StrLen(TempBuf1);
    if (TempBuf1[0] = '[') and (TempBuf1[Len1 - 1] = ']') then
      Result := ValidIdentifier(S1)
    else
      Result := False;
  end;
end;

{ debugging and performance tuning information }

function GetTokenCount: Integer;
begin
  Result := TokenCount;
end;

procedure ResetTokenCount;
begin
  TokenCount := 0;
end;

function PadString(const S: string; Len: Integer; PadChar: Char): string;
begin
  Result := S;
  while Length(Result) < Len do
    Result := Result + PadChar;
end;

{ Encoding function named in honor of Dennis Forbes' favourite word }
{procedure Gibble(var S: string);
var
 I, L, c1: Integer;
 lo, hi: Byte;
 X: array [0..255] of Char;
begin
 L := Length(S);
 for I:= 0 to L-1 do
 begin
     c1 := Ord(S[I+1] );
     if (c1  >= 32 ) AND (c1 <= 231) then
     begin
        c1 := c1 - 32;
        lo := (c1 MOD 25);
        hi := c1 div 25;
        lo := 24-lo;
        c1 := ((hi*25)+lo ) +32;
        X[I] := Chr(c1);
     end
     else
        X[I] := Chr(c1);
 end;
 X[L] := Chr(0);
 S := String(X);
end;
 }

function BuildPathName(const PathName, FileName: string): string;
var
  L: Integer;
begin
  L := Length(PathName);
  if L = 0 then
    Result := FileName
  else
  if PathName[L] = '\' then
    Result := PathName + FileName
  else
    Result := PathName + '\' + FileName;
end;

function HexDigitVal(C: Char): Integer;
begin
  if C in DigitSymbols then
    Result := Ord(C) - Ord('0')
  else
  if C in HexadecimalLowercaseLetters then
    Result := Ord(C) - Ord('a') + 10
  else
  if C in HexadecimalUppercaseLetters then
    Result := Ord(C) - Ord('A') + 10
  else
    Result := 0;
end;

function HexToAscii(const S: string): string;
var
  I, Y, L: Integer;
  C: array [0..256] of Char;
begin
  L := Length(S) div 2;
  for I := 0 to L - 1 do
  begin
    Y := (I * 2) + 1;
    C[I] := Char(HexDigitVal(S[Y]) * 16 + HexDigitVal(S[Y + 1]));
  end;
  C[L] := Chr(0);
  Result := C;
end;

function AsciiToHex(const S: string): string;
var
  I: Integer;
  S2: string;
begin
  for I := 1 to Length(S) do
    S2 := S2 + IntToHex(Ord(S[I]), 2);
  Result := S2;
end;

//-----------------------------------------------------------------------------
// GetIntValueFromResultString
//
// Retrieve an integer value from a result string, Formats that are valid
// include:
//
// VariableName: Value  - usual format for status results
// VariableName = Value  - usual format in ini files
// Label Name = Value    - labels names can contain spaces.
//-----------------------------------------------------------------------------

function GetIntValueFromResultString(const VarName: string;
  ResultStrings: TStrings; DefVal: Integer): Integer;
var
  S: string;
begin
  S := GetValueFromResultString(VarName, ResultStrings);
  Result := StrToIntDef(S, DefVal);
end;

//-----------------------------------------------------------------------------
// GetValueFromResultString
//
// Retrieve a value from a result string, Formats that are valid include:
// VariableName: Value  - usual format for status results
// VariableName = Value  - usual format in ini files
// Label Name = Value    - labels names can contain spaces.
//-----------------------------------------------------------------------------

function GetValueFromResultString(const VarName: string; ResultStrings: TStrings): string;
var
  Label1, Value1: string;
  Len1, Pos1, I, Count: Integer;
begin
  if not Assigned(ResultStrings) then
  begin
    Result := 'NIL';
    Exit;
  end;

  Count := ResultStrings.Count;
  for I := 0 to Count - 1 do
  begin
    Len1 := Length(ResultStrings[I]);
    Pos1 := Pos(':', ResultStrings[I]);
    if Pos1 = 0 then
      Pos1 := Pos('=', ResultStrings[I]);
    // found a value to extract:
    if Pos1 > 0 then
    begin
      Label1 := Copy(ResultStrings[I], 1, Pos1 - 1);
      Value1 := Copy(ResultStrings[I], Pos1 + 1, Len1);

      if VarName = Label1 then
      begin // found it!
        Result := Value1;
        Exit;
      end;
    end;
  end;
end;

function StrStrip(S: string): string;
var
  Len, I: Integer;
begin
  Len := Length(S);
  I := 1;
  while (Len >= I) and ((S[I] = ' ') or (S[I] = Tab)) do
    I := I + 1;
  if I > Len then
  begin
    Result := '';
    Exit;
  end;
  S := Copy(S, I, Len);
  Len := Len - I + 1;
  I := Len;
  while (I > 0) and ((S[I] = ' ') or (S[I] = Tab)) do
    I := I - 1;
  Result := Copy(S, 1, I);
end;

function GetString(var Source: string; const Separator: string): string;
var
  I, J, Len: Integer;
begin
  //Source := StrStrip(Source);
  Len := Length(Source);
  I := 0;
  for J := 1 to Len do
    if Pos(Source[J], Separator) > 0 then
    begin
      I := J;
      Break;
    end;
  if I > 0 then
  begin
    Result := StrStrip(Copy(Source, 1, I - 1));
    Source := Copy(Source, I + 1, Length(Source) - I);
    //Source:=StrStrip(source); //???
  end
  else
  begin
    Result := StrStrip(Source);
    Source := '';
  end;
end;

//------------------------------------------------------------------------------------------
// StrSplit
//   Given aString='Blah,Blah,Blah', SplitChar=',', writes to OutStrings an Array
//   ie ('blah','blah','blah ) and returns the integer count of how many items are in
//   the resulting array, or -1 if more than MaxSplit items were found in the input
//   string.
//
// XXX READ THESE NOTES! XXX
//
// XXX DOES NOT HANDLE QUOTING (YOU CAN'T HAVE A COMMA INSIDE QUOTES, AT LEAST NOT YET.) XXX
//
// XXX OutStrings array must be dimensioned to start at element ZERO,
//     if it starts at element 1, then you'll get exceptions XXX
//------------------------------------------------------------------------------------------

function StrSplit(const InString: string; const SplitChar, QuoteChar: Char;
  var OutStrings: array of string; MaxSplit: Integer): Integer;
var
  I, Len, SplitCounter: Integer;
  Ch: Char;
  InQuotes: Boolean;
begin
  InQuotes := False;
  Len := Length(InString);
  for I := Low(OutStrings) to High(OutStrings) do // clear array that is passed in!
    OutStrings[I] := '';

  SplitCounter := 0; // ALWAYS ASSUME THAT ZERO IS VALID IN THE OUTGOING ARRAY.

  for I := 1 to Len do
  begin
    Ch := InString[I];
    if (Ch = SplitChar) and not InQuotes then
    begin
      Inc(SplitCounter);
      if SplitCounter > MaxSplit then
      begin
        Result := -1; // Error!
        Exit;
      end;
    end
    else
    begin
      OutStrings[SplitCounter] := OutStrings[SplitCounter] + Ch;
      if Ch = QuoteChar then
        InQuotes := not InQuotes;
    end;
  end;
  Inc(SplitCounter);
  Result := SplitCounter;
end;

// NEW 2004 WP

function StrSplitStrings(const InString: string; const SplitChar, QuoteChar: Char; OutStrings: TStrings): Integer;
var
  I, Len, SplitCounter: Integer;
  Ch: Char;
  InQuotes: Boolean;
  OutString: string;
begin
  InQuotes := False;
  Len := Length(InString);
  OutStrings.Clear;
  SplitCounter := 0; // ALWAYS ASSUME THAT ZERO IS VALID IN THE OUTGOING ARRAY.

  for I := 1 to Len do
  begin
    Ch := InString[I];
    if (Ch = SplitChar) and not InQuotes then
    begin
      OutStrings.Add(OutString);
      OutString := '';
      Inc(SplitCounter);
    end
    else
    begin
      OutString := OutString + Ch;
      if Ch = QuoteChar then
        InQuotes := not InQuotes;
    end;
  end;
  OutStrings.Add(OutString);
  Inc(SplitCounter);
  Result := SplitCounter;
end;

//--end NEW--

end.