jvcsvparse.pas

East make Tray Icon in delphi

{-----------------------------------------------------------------------------
The contents of this file are subject to the Mozilla Public License
Version 1.1 (the "License"); you may not use this file except in compliance
with the License. You may obtain a copy of the License at
http://www.mozilla.org/MPL/MPL-1.1.html

Software distributed under the License is distributed on an "AS IS" basis,
WITHOUT WARRANTY OF ANY KIND, either expressed or implied. See the License for
the specific language governing rights and limitations under the License.

The Original Code is: JvaDsgn.PAS, released on 2002-07-04.

The Initial Developers of the Original Code are: Andrei Prygounkov <a dott prygounkov att gmx dott de>
Copyright (c) 1999, 2002 Andrei Prygounkov
All Rights Reserved.

Contributor(s):  Warren Postma (warrenpstma att hotmail dott com)

               Changed StrSplit Function (has one new parameter).

You may retrieve the latest version of this file at the Project JEDI's JVCL home page,
located at http://jvcl.sourceforge.net

Description:
  Internal pchar-manipulation functions required by TJvCsvDataSet data access component.

  Useful extra functions for parsing strings using pascal,
  not present in your basic vanilla Pascal/Delphi standard
  libraries.

  MOST use PChars and char buffers, not the String type.

  These functions are used to implement the
  CsvDataSource component but are generally reuseable in
  any string parsing code.

Known Issues:
-----------------------------------------------------------------------------}
// $Id: JvCsvParse.pas,v 1.28 2005/02/17 10:20:19 marquardt Exp $

unit JvCsvParse;

{$I jvcl.inc}

interface

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  Classes;

const
  MaxInitStrNum = 9;

{ String Class Functions - uses Delphi String objects instead of Pascal PChars }

{new 2003}
function StrSplit(const InString: string; const SplitChar, QuoteChar: Char;
  var OutStrings: array of string; MaxSplit: Integer): Integer;
{new 2004}
function StrSplitStrings(const InString: string; const SplitChar, QuoteChar: Char; OutStrings: TStrings): Integer;

{ circa 1998-2001 classic functions }
function StrStrip(S: string): string; // Strip whitespace, carriage returns, linefeeds.
function GetString(var Source: string; const Separator: string): string;
// Iteratively split off a piece of a string. Modifies original string.
function PadString(const S: string; Len: Integer; PadChar: Char): string;
//procedure Gibble(var S: string); // Deprecated. With a name like Gibble, are you surprised?
function BuildPathName(const PathName, FileName: string): string;
function StrEatWhiteSpace(const S: string): string;
function HexToAscii(const S: string): string;
function AsciiToHex(const S: string): string;
function StripQuotes(const S1: string): string;

{ TStrings helper functions }
function GetIntValueFromResultString(const VarName: string; ResultStrings: TStrings;
  DefVal: Integer): Integer;
function GetValueFromResultString(const VarName: string; ResultStrings: TStrings): string;

{ Pascal Low Level PChar Functions }
function ValidNumericLiteral(S1: PChar): Boolean;
function ValidIntLiteral(S1: PChar): Boolean;
function ValidHexLiteral(S1: PChar): Boolean;
function HexPCharToInt(S1: PChar): Integer;
function ValidStringLiteral(S1: PChar): Boolean;
function StripPCharQuotes(S1: PChar): string;

function ValidIdentifier(S1: PChar): Boolean;
function EndChar(X: Char): Boolean;
procedure GetToken(S1, S2: PChar);
function IsExpressionKeyword(S1: PChar): Boolean;
function IsKeyword(S1: PChar): Boolean;
function ValidVarReference(S1: PChar): Boolean;
function GetParenthesis(S1, S2: PChar): Boolean;
procedure GetVarReference(S1, S2, SIdx: PChar);
procedure PCharEatWhiteChars(S1: PChar);

{ Debugging functions related to GetToken function. }
function GetTokenCount: Integer;
procedure ResetTokenCount;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvCsvParse.pas,v $';
    Revision: '$Revision: 1.28 $';
    Date: '$Date: 2005/02/17 10:20:19 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  SysUtils,
  JvTypes, JvConsts, JvResources;

var
  TokenCount: Integer = 0;

{ Returns true for literals like '123.456', '78', or '-35.1231231' }

function ValidNumericLiteral(S1: PChar): Boolean;
var
  L, X, X1: Integer;
  DecimalFlag: Boolean;
begin
  L := StrLen(S1);
  DecimalFlag := False;
  X1 := 0;

  if L <= 0 then
  begin
    Result := False;
    Exit;
  end;

  { detect leading minus }
  if S1[0] = '-' then
    Inc(X1); // skip the minus, as it's okay as a leading character

  { Detect a decimal number or integer number }
  for X := X1 to L - 1 do
    if S1[X] = '.' then
    begin
      if DecimalFlag then
      begin
        Result := False; // two decimal places is invalid.
        Exit;
      end;
      DecimalFlag := True;
    end
    else
    if not (S1[X] in DigitSymbols) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

{ Returns true for integer literals only, like -35 or 199, but not
  for values like '123.45' }

function ValidIntLiteral(S1: PChar): Boolean;
var
  L, X, X1: Integer;
begin
  L := StrLen(S1);
  X1 := 0;
  if L <= 0 then
  begin
    Result := False;
    Exit;
  end;
  { detect leading minus }
  if S1[0] = '-' then
    Inc(X1); // skip the minus, as it's okay as a leading character

  { Detect a decimal number or integer number }
  for X := X1 to L - 1 do
    if not (S1[X] in DigitSymbols) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

{ Returns true for integer literals only, like -35 or 199, but not
  for values like '123.45' }

function ValidHexLiteral(S1: PChar): Boolean;
var
  L, X: Integer;
begin
  L := StrLen(S1);
  //  X1 := 0;

  { detect hex code type indicator }
  if (L < 2) or (S1[0] <> '$') then
  begin
    Result := False;
    Exit;
  end;

  { Detect hex digits }
  for X := 1 to L - 2 do
    if not (S1[X] in HexadecimalSymbols) then
    begin
      Result := False;
      Exit;
    end;
  Result := True;
end;

function HexPCharToInt(S1: PChar): Integer;
var
  X, L: Integer;
  Digit, Val: Integer;
begin
  L := StrLen(S1);
  if (L < 2) or (L > 9) then
    raise EJVCLException.CreateRes(@RsEInvalidHexLiteral);
  if S1[0] <> '$' then
    raise EJVCLException.CreateRes(@RsEInvalidHexLiteral);
  Val := 0;
  for X := 1 to L - 2 do
  begin
    Val := Val * 16; { shift right four bits at a time }
    if S1[X] in DigitSymbols then
      Digit := Ord(S1[X]) - Ord('0')
    else
    if S1[X] in HexadecimalLowercaseLetters then
      Digit := Ord(S1[X]) - Ord('a') + 10
    else
    if S1[X] in HexadecimalUppercaseLetters then
      Digit := Ord(S1[X]) - Ord('A') + 10
    else
      raise EJVCLException.CreateRes(@RsEInvalidHexLiteral);
    Val := Val + Digit;
  end;
  Result := Val;
end;

function ValidStringLiteral(S1: PChar): Boolean;
begin
  Result := (S1[0] = '"') and (S1[StrLen(S1) - 1] = '"');
end;

{ Strip quotes and return as a real Delphi String }

function StripQuotes(const S1: string): string;
begin
  if ValidStringLiteral(PChar(S1)) then
    Result := Copy(S1, 2, Length(S1) - 2)
  else
    Result := S1;
end;

// This function is limited to 1 to 254 characters:

function StripPCharQuotes(S1: PChar): string;
var
  TempBuf: array [0..256] of Char;
  L: Integer;
begin
  L := StrLen(S1);
  if L > 255 then
    L := 255;
  if ValidStringLiteral(S1) then
    StrLCopy(TempBuf, S1 + 1, L - 2);
  Result := string(TempBuf);
end;

{ Prevent confusion between expression-keywords and variable identifiers }

function IsExpressionKeyword(S1: PChar): Boolean;
begin
  if StrIComp(S1, 'AND') = 0 then
    Result := True
  else
  if StrIComp(S1, 'OR') = 0 then
    Result := True
  else
  if StrIComp(S1, 'XOR') = 0 then
    Result := True
  else
  if StrIComp(S1, 'NOT') = 0 then
    Result := True
  else
  if StrIComp(S1, 'DIV') = 0 then
    Result := True
  else
  if StrIComp(S1, 'SHR') = 0 then
    Result := True
  else
  if StrIComp(S1, 'SHL') = 0 then
    Result := True
  else
    Result := False;
end;

function IsKeyword(S1: PChar): Boolean;
begin
  Result := (StrIComp(S1, 'SET') = 0) or (StrIComp(S1, 'LET') = 0) or
    (StrIComp(S1, 'DIM') = 0) or (StrIComp(S1, 'ARRAYCOPY') = 0) or
    (StrIComp(S1, 'STRCOPY') = 0) or (StrIComp(S1, 'STRPAD') = 0) or
    (StrIComp(S1, 'STRSTRIP') = 0) or (StrIComp(S1, 'END') = 0) or
    (StrIComp(S1, 'INC') = 0) or (StrIComp(S1, 'DEC') = 0) or
    (StrIComp(S1, 'PARAM') = 0) or (StrIComp(S1, 'JUMP') = 0) or
    (StrIComp(S1, 'SLEEP') = 0) or (StrIComp(S1, 'GOTO') = 0) or
    (StrIComp(S1, 'IF') = 0) or (StrIComp(S1, 'CALL') = 0) or
    (StrIComp(S1, 'STOP') = 0) or (StrIComp(S1, 'CONST') = 0);
end;

{ ValidIdentifier:

  Valid identifier must start with a-z or A-Z or _, and can have alphanumeric or underscore(_)
  as subsequent characters, no spaces, punctuation, or other characters allowed.  Same rules as
  most programming languages, Cobol being one particularly nasty exception! <grin>

    --Warren.
}

function ValidIdentifier(S1: PChar): Boolean;
var
  X, Y: Integer;
  Pass: Boolean;
begin
  Pass := True;

  if IsExpressionKeyword(S1) then
  begin
    Result := False;
    Exit;
  end;

  X := StrLen(S1);
  if (X < 1) or (X > 32) then
  begin
    Result := False;
    Exit;
  end;

  if not (S1[0] in IdentifierFirstSymbols) then
    Pass := False;

  if Pass and (X > 1) then
    for Y := 1 to X - 1 do
      if not (S1[Y] in IdentifierSymbols) then
      begin
        Pass := False;
        Result := Pass;
        Exit;
      end;

  Result := Pass;
end;

function EndChar(X: Char): Boolean;
begin
  Result := (X = ',') or (X = ';') or (X = ':') or (X = '[') or (X = ']') or
    (X = '(') or (X = ')') or (X = '#') or (X = '<') or (X = '>') or (X = '=') or
    (X = '*') or (X = '/') or (X = '+') or (X = Chr(0));
end;

procedure GetToken(S1, S2: PChar);
var
  W, X, Y: Integer;
  InQuotes: Boolean;
begin
  X := 0;
  W := 0;

  { Empty in, Empty Out }
  if StrLen(S1) = 0 then
    S2[0] := Chr(0);

  InQuotes := False;

  { skip leading space }
  while (S1[X] = ' ') or (S1[X] = Tab) do
    Inc(X);

  while True do
  begin
    if EndChar(S1[X]) and not InQuotes then
    begin
      { return punctuation one symbol at a time }
      if W < 1 then
      begin
        S2[W] := S1[X];
        Inc(W);
        Inc(X);
      end;
      Break;
    end;

    if S1[X] = '"' then
      InQuotes := not InQuotes;

    { Break if space found and not in quotes }
    if (S1[X] = ' ') and not InQuotes then
      Break
    else
    begin
      S2[W] := S1[X];
      Inc(W);
    end;

    Inc(X);
  end;
  // S2[X] := Chr(0);

  { detect not-equal, less-than-or-equal and greater-than-or-equal operators }
  if W = 1 then
    if (S2[0] = '<') and (S1[X] = '>') then
    begin
      S2[W] := '>';
      Inc(X);
      Inc(W); // char literal
    end
    else
    if (S2[0] = '<') and (S1[X] = '=') then
    begin
      S2[W] := '=';
      Inc(X);
      Inc(W);
    end
    else
    if (S2[0] = '>') and (S1[X] = '=') then
    begin
      S2[W] := '=';
      Inc(X);
      Inc(W);
    end;

  { remove token from initial buffer, move to second buffer }
  Y := Integer(StrLen(S1)) - X;
  if Y > 0 then
    StrLCopy(S1, S1 + X, Y) { copy remaining characters }
  else
    S1[0] := Chr(0); { just erase all of old string }