Bishopj: 1 revision imported

2026-04-12T06:36:00Z

1 revision imported

← Older revision	Revision as of 06:36, 12 April 2026
(No difference)

Bishopj: Created page with "==Language Tokenising and Parsing, tree, date and file support library== Language: Delphi 7 - 2007 * String Tokenising functions * BPC FLang1 Language parsing routines * DAT..."

2019-09-11T16:35:33Z

Created page with "==Language Tokenising and Parsing, tree, date and file support library== Language: Delphi 7 - 2007 * String Tokenising functions * BPC FLang1 Language parsing routines * DAT..."

New page

==Language Tokenising and Parsing, tree, date and file support library==

Language: Delphi 7 - 2007

* String Tokenising functions
* BPC FLang1 Language parsing routines
* DATE to String functions
* GENERAL FILE Import/Export Functions - COMMA TEXT

Use the bpcSMScript equivalents in preference to these routines where available.

<pre>
interface
uses windows, classes, Sysutils, db, DBTables;

const
bpslSkipSpace = 1;
bpslDropDelimeters = 2;
bpslPushBack = 4;
bpslMatchSE = 8;
bpslToEOL = 16;
bpslDelimOveridesNum = 32;
bpslCmprsSpace = 64;

type
TbpTreeNodeType = ( tttnCell, tttnOp, tttnVal );
{
TbpTreeNode = class( Tobject )
private
public
NodeType : TbpTreeNodeType;
Token : string;
Done : boolean;
Value : double;
LeftPtr : TbpTreeNode;
RightPtr : TbpTreeNode;
constructor Create( myToken : string);
destructor Destroy ;
function Eval : boolean;
function FindInTree( Target : string ) : TbpTreeNode;
function BuildTree( SourceString : string ) : TbpTreeNode;
end;
}

tbpReservedWord = ( tbpRwNIL, tbpRwILLEGAL, tbpRwVAR, tbpRwIGNORE, tbpRwPOST, tbpRwHOLD, tbpRwIF, tbpRwDO, tbpRwEQ, tbpRwNEQ, tbpRwLT, tbpRwGT ,
tbpRwLTE, tbpRwGTE ,tbpRwASSIGN, tbpRwPLUS, tbpRwMINUS, tbpRwTIMES,
tbpRwDIVIDE, tbpRwPERIOD, tbpRwSEMIC, tbpRwCOLON, tbpRwCOMMA, tbpRwLEFTBRACKET, tbpRwRIGHTBRACKET,
tbpRwNOT, tbpRwTRUE, tbpRwFALSE, tbpRwAND, tbpRwOR );

TbpTokenType = (ttComma, ttMapArg, ttReserved );
TbpMapArgType = (ftxNil, ftxInt, ftxDateYearLead, ftxDateLongMonLead, ftxDateDayLeadTime, ftxDateDayLead, ftxDateYearLeadTime, ftxDateYearLeadWithDiv, ftxChar, ftxMoney, ftxFloat, ftxLogical, ftxBlob, ftxQChar, ftxQNil);
TbpTrimType = (ttTrimLeft, ttTrimRight, ttTrimBoth );
TbpTokenListType = (tltRelation, tltMap);

TbpToken = class(TObject)
private
public
TokenType : TbpTokenType;
TokenString : string;
end;

TbpMapDividerToken = class(TbpToken)
private
public
DividerWord : string;
constructor Create(myDivider : string);
end;

TbpMapReservedWordToken = class(TbpToken)
private
public
ReservedWord : string;
constructor Create(myReservedWord : string);
end;

TbpMapArgToken = class(TbpToken)
private
public
MapToName : string;
MapSrcType : TbpMapArgType;
Size : integer;
constructor Create(myMapToName : string; myMapSrcType : TbpMapArgType; mySize : integer );
function MapTo( MyDataSet : TDataSet ; var Erra : string ) : boolean;
end;

TbpTokenList = class(TStringlist)
private
{ Private declarations }
public
ListType : TbpTokenListType ;
procedure AddToken( TokenName : string; MyToken : TbpToken );
procedure DelToken( TokenName : string );
function GetTokenStrIfComma( i : integer) : string;
function GetToken( i : integer) : TbpToken;
end;

TbpMapTokenList = class(TbpTokenList)
private
{ Private declarations }
public
{ Public declarations }
Rows : string;
Criteria : string;
MergeWith : string;
Action : string;
Prep : string;
SrcLine : string;
SrcMask : string;
ParseError : string;
SrcIgnored : string;
SrcParseError : tstringlist;
constructor Create;
destructor Destroy; override;
function IsCriteriaMatch( sourceline : string ) : boolean;
function ReLoadSrc( TargetDataSet : TDataSet) : boolean;
function LoadMask : boolean;
function LoadSrc ( TargetDataSet : TDataSet; NoPost : boolean = false ) : boolean;
end;

TbpListTokenList = class(TStringlist)
private
{ Private declarations }
public
{ Public declarations }
SrcLines : TStringList;
SrcMasks : TStringList;
ParseErrors : TStringList;
SrcIgnoreds : TStringList;

constructor Create;
destructor Destroy; override;
function MatchSourceToMaskCriteria( SourceLine : String ) : integer;
procedure ClearMasks ;
function LoadMasks : boolean;
function LoadSrcs(debugflg : boolean; Imid, Imbid : integer; TargetDataSet : TDataSet; SourceLines : TStringList) : boolean;
end;

/////////////////////////////////
//// String Tokenising functions
/////////////////////////////////

// Return a copy of the string bounded by start and end
function bpStrWhatsBetween(strTokenStart, strSource, strTokenEnd : string ): string;
// Returns the index of the closing delimeter matching the nesting level of the
// current start delimeters, (or the outermost match if direction is not forward).
// Source string unaffected
function bpNextMatchDelim(bGoForwards : boolean; strTokenStart, strTokenEnd, strSource: string; startpos : integer ): integer;
// Returns the index of the next delimeter from startpos or the last occurence
// in string if direction is not forward). Forward Search starts from startpos.
// Source string unaffected
function bpNextDelimiter(bGoForwards : boolean; strTokenDelim, strSource : string; startpos : integer ): integer;
// Returns a string without the removechars. Doesn't Change Source
function bpStripCh(removechars : string; targetstr : string ) : string;
// Returns a string token optionally delimetered by start and pos, according to a variety of rules in Flags. Changes Source
function bpStrStripToken(Num : integer; Flags:integer; strTokenStart, strPunct, strTokenEnd : string; var strSource : string; var bTokenComplete : boolean; NumChar : integer = 0 ) : string;
// Returns the Map type given a string type name
function bpstrtoMapArgToken( strArgType : string ) : TbpMapArgType;
// Trim leading and trailing trimchars
function bpChTrim( LTrimByString, RTrimByString: string; TokenString: string): string;
// Move the sign char at the back to the front
function bpSignToLeft( chSign : string; TokenString: string): string;
// Returns the value part of a Name/Value pair in the string of the form:
// Name="MyValue" or Name.MyValue
function RetrieveValue(strSource,strName,strAssign,strTokenStart,strTokenEnd : string) : string;
// Returns a simple token : "word" | Punctuation
function RetrieveToken(strSource : string; var curpos : integer ) : string;
// Retrieves the entire first line after index <startfrom> in the tstring <strSource>
// that matches the pattern 'CALC.<strinstance> <strsubname>="<strsubinstance>" '
// Returns the entire line string including all attributes - use RetrieveValue to extract the
// component attributes or filter further
// the CALC pattern where " symbol is replaced by <strTokenStart>, <strTokenEnd>
// EG: StartingOffset := 0;
// RetrievSPattern( FormuliStringList, StartingOffset, 'BASXL', 'PeriodGroup', 'Monthly' );
// If <strsubname> is '' then the match is to the CALC.strinstance tag alone and
// <strsubinstance> is ignored.
// ##JB : Assumes CALC name and subName pair are unique, or queued
function RetrieveSPattern( strSource : TStrings; var StartFrom : integer; strName, strInstance, strSubName, strSubInstance : string) : string;
// Uses RetrieveSPattern to return CALC formula (the value attribute of the tag) or ''
// EG: RetrievePeriodCalc( FormuliStringList, 'BASXL', 'Monthly', '"', '"');
function RetrievePeriodCalcValue( strSource : TStrings; strInstance, strSubInstance, strTokenStart,strTokenEnd : string) : string;

//////////////////////////////////////////////////////////////////////////////////////////
/// Language parsing routines
{
In all cases the source is not damaged and (except for RetrieveValue,
the structure of the calling pascal function is:
<func>(<source string>, Var <curpos> ; Var <return args> ) : <parsed ok>;
where <func> is function name
<source string> is the source string
<curpos> next char position immediately after expression or 1 if at start of line
or -1 if EOLN
<return args> the arguments returned
<parsed ok> a boolean verifying correct syntax
These routines assume a language of expressions containing (examples):
value="POST" or value="POST;"
value="if( NE(a,b), POST, HOLD)"
value="if( NE(a,b), if( NE(a,c), POST, do( =(a,d), POST), HOLD));"

LANGUAGE GRAMMAR:

<statementlist> = [<statement>]...;
<statement> = <postfunc> | <holdfunc> | <iffunc> | <dofunc> | <assignfunc> | <mathfunc>
<arglist> = ( <statement> [,<statement>]... )
<postfunc> = POST // return true
<holdfunc> = HOLD // return true
<dofunc> = DO ( <statement> [, <statement>]... ) // return last statement executed
<iffunc> = IF ( <conditionpart>, <truepart>, <falsepart> ) // return whichever part is executed
<conditionpart> = <logicfunc> ( <logicarg>, <logicarg>) | <logicliteral>
<logicfunc> = EQ | NE | LT | GT | LTE | GTE | OR | AND
<logicliteral> = TRUE | FALSE
<logicarg> = <literal> | <var> | <logicliteral>
<mathfunc> = [+ | - | * | / ]( <statement> [, <statement>]... )
<assignfunc> = =( <lvalue>, <rvalue> )
<lvalue> = <var>
<rvalue> = <logicfunc> | <var> | <literal> | <iffunc>
<literal> = <logicliteral> | <value>

END GRAMMAR.

An example of the use is:
curpos := 1;
myValStr := RetrieveValue( 'Relation.R1 value="if( NE(a,b), if( NE(a,c), POST, do( =( a,b), HOLD ), HOLD)"', 'value', '=', '"', '"');
if EvalStatementList( myValStr, curpos, strStatementList) then
Parse Complete;

EvalLiteral
RetrieveToken( strSource, curpos );

EvalStatementList
while curpos > 0 do
begin
parseok := EvalStatement(myValStr, curpos, strstatement );
if curpos >= length(myValStr) then curpos := -1;
end;

EvalStatement

}

//////////////////////////////////////////////////////////////////////////////////////////
// Returns the statement list of a string of the form (terminates on EOL):
// "statement;statement;"
function RetrieveStatementList( strSource: string; var curpos : integer; var strStatementList : string ) : boolean;
// Returns the statement part of a string of the form (terminates statement part on ; or EOL):
// "function < optionally some other stuff>;"
function RetrieveStatement( strSource: string; var curpos : integer; var strStatement : string) : boolean;
// Returns the Function part of a string of the form (terminates function part on space, ; or EOL:
// "function < optionally some other stuff>;"
function RetrieveFunction( strSource : string; var curpos : integer; var strFunc, strArglist : string ) : boolean;
// Returns true if parsed OK and Decomposes an ifexpression into its component parts of the form:
// "(condition action )? true action : false action"
// "if ( a<>b )? POST : HOLD;"
function RetrieveIfExpr(strSource: string; var strCondition: string; strIfTrue, strIfFalse : string ) : boolean;

// Returns the Function part of a string of the form (terminates function part on space, ; or EOL:
// "function < optionally some other stuff>;"
{function RetrieveFunction( strSource; var ) : string;
var
begin
end;
}

// True if ch at curpos is numeric else false
function bpChIsNum( strSource : string; curpos : integer ) : boolean;
// True if ch at curpos is A..z
function bpChIsAlpha( strSource : string; curpos : integer ) : boolean;
// Returns the index of the strSource after chars (spaces) skipped
function bpSkip( strDelims, strSource : string; var curpos : integer ) : integer;

// Returns the reserved word corresponding (or VAR flag or illegal flag ) to the token
function bpWhichReservedWord( strSource : string ) : tbpReservedWord;

///////////////////////////////
//// DATE to String functions
///////////////////////////////

// Return the Number of Days in a month (1..12) - use IsLeapYear [Borland VCL]
// for isleapy test.
function DaysInMonth( monthint : integer; isleapy : boolean ) : integer;
// convert a month num (1..12) to a month string
function MonthToStr( monthint : integer ) : string;
// convert a month string to the closest possible month num (1..12)
function StrToMonth( month : string ) : integer;

//////////////////////////////////////////////////////
//////////////////////////////////////////////////////
/// GENERAL FILE Import/Export Functions - COMMA TEXT
//////////////////////////////////////////////////////

// General Table Import Routine
function ImportATable( TargetTableName: string; TargetTable : TDataSet; FileName : string; DoMemFields : boolean = False ) : boolean;
// General Table Export Routine
function ExportATable( FileName : string ; TargetTable : TDataSet; DoMemFields : boolean = False ) : boolean;

</pre>

=BackLinks=

{{#dpl: linksto={{FULLPAGENAME}} }}

BPCStndLib1 - Revision history

Bishopj: 1 revision imported

Bishopj: Created page with "==Language Tokenising and Parsing, tree, date and file support library== Language: Delphi 7 - 2007 * String Tokenising functions * BPC FLang1 Language parsing routines * DAT..."