BPCStndLib1
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.
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;