BpcSMScriptLibrary 1

From RiskWiki

Jump to: navigation, search

BPC String Manipulation Library 1

Language: Delphi 7 - 2007


//////////////////////////////////////////////////////////////////////////////////////////
//////// String Based Auto Counter Routines
//////////////////////////////////////////////////////////////////////////////////////////
//////// String & StringList Manipulation Routines
//////////////////////////////////////////////////////////////////////////////////////////
//////// TbpcXMLNodeStringList Manipulation Routines
//////////////////////////////////////////////////////////////////////////////////////////
//////// Module, Database & registry Utilities
//////////////////////////////////////////////////////////////////////////////////////////

{$INCLUDE bpcDefs.PAS}

interface
uses HTTPApp, Classes, DBGrids, Types, ShDocVw, bpcStringList, IdHTTP, ADODB, Windows;
type

TbpcStndFilExtTypes = (bpcfetunkown, bpcfetbmp,bpcfetjpg,bpcfetjpeg,bpcfetjpeg2000,bpcfetwmf,bpcfetemf,bpcfetico,bpcfeticon,bpcfetmpg,bpcfetmpeg,bpcfetwmv,bpcfetavi,bpcfetmov,bpcfetmp3,bpcfetmp4,bpcfetdoc,bpcfetrtf,bpcfettxt,bpcfetxls,bpcfetdat,bpcfetbak,bpcfetmdf,bpcfetlog,bpcfettmp);

// Used in bpcMergeMessageAtMarkupTags(...) as the callback function. It takes a single tag string
// and returns a replacement string. Similar to a tstatementproducer call back routine.
  TbpcMergeMessageFunc= function ( MessageID : string; myProperties : tstringlist; myGFParam : TObject ) : string of object;

// Used for decoding XML strings into Tstrings and back again
TbpcXMLNodeType=(bpcXMLInlineNode, bpcXMLBlockNode );
TbpcXMLNodeStringList = class (TbpcStringList)
public
  TagName : string;
  TagType : TbpcXMLNodeType;
  Content : string;
  // Make an XMLTag object
  constructor create(myTagName : string; myTagType : TbpcXMLNodeType ); overload;
  // Return the Node as an XML Tag block
  function AsXMLTag : string;
end;

//////////////////////////////////////////////////////////////////////////////////////////
//////// String Based Auto Counter Routines
//////////////////////////////////////////////////////////////////////////////////////////

// These routines take a masked string of the form 'QUES###' or 'QUES001' or QU##ES##', etc and
// populate it with a counter to make something like 'QUES001' and then through successive calls
// to bpcMaskIncAutoNumber, return the incremented string QUES001...QUES002...QUES003... etc.
// Use:
// This example fills a mask from the end to the front ('QUES###') with a startstring ('1'),
// the first time through filling the extra '#' with '0', and then increments the RowIdString
// with each subsequent call.
//
//   from j := fromrow to torow do
//      if j=fromrow then
//         RowIdString := bpcMaskFillString( Mask, trim(StartString), MaskChar, '0', true)
//      else
//         RowIdString := bpcMaskIncAutoNumber( RowIdString, Mask, OnlyNums );
//
//
// This example populates a RowIdString with '' initially and takes a mask string ('QUES000') ,
// the first time through, and then increments the RowIdString with each subsequent call.
//
//   RowIdString := '';
//   from j := fromrow to torow do
//       RowIdString := bpcMaskIncAutoNumber( RowIdString, Mask, OnlyNums );

// Takes a masked string and returns the incremented version of that string
// Mask pattern uses numbers for numeric increments from right to left (or all chars otherwise)
// Handles 'carry' of alphanumb autoindex keys
function bpcMaskIncAutoNumber( sQuesIDLastAutoNumber, sQuesIDAutoNumberPattern : string; NumOnly : boolean ) : string;
// Handles 'carry' of alphanumb autoindex keys
function bpcMaskRippleAutoNumber(sQuesIDLastAutoNumber : string; IndChr : char; NumOnly : boolean  ) : string;
// Return a copy of the MaskedSource with mask characters replaced by FillSource characters where characters equal MaskCh.
// Working from the end of the strings to the front if FromEnd is true (else go from the front).
function bpcMaskFillString( MaskedSource, FillSource : string; MaskCh : char; PadCh : char; FromEnd : boolean) : string;

//////////////////////////////////////////////////////////////////////////////////////////
//////// String & StringList Manipulation Routines
//////////////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////
// Display message if testme is true and return testme
// Use like: if bpcShowOnTrue( Failed, 'Ooops. Error.' ) then exit;
function bpcShowOnTrue( testme : boolean; Msg : string ) : boolean ;

///function bpcStrEvalCondition( TheCondition : string; CheckAValue : TbpcGetParamValFunc; TagObject : TObject ) : boolean;

// Slow name-based copy FromValues to ToValues preserving name-value combinations (and replacing them where needed)
function bpcAssignSLValues(ToValues, FromValues : TStrings ) : TStrings;

// Validate a notional ID field (string). Returns an Error Message or '' if ok. Accepts only Alpha Numeric or Underscore and rejects empty or spaced values
// Strips spaces if StripSpace=true and returns the id in FixedID, else returns the original ID (if ok) or '' if not ok.
// Trims spaces and control chars if TrimMe is true and returns the trimmed ID in FixedID, else as above
// Three error messages can be provided - one general non alphnum message (if id contains something other then alpha's, numbers or underscore,
// and a space or blank err message if the ID is contains spaces or is blank.
// If the ErrMsgSP is '' then the ErrMsgBL is used for ids containing spaces as well as empty ids, and if ErrMsgBL is also '', then the ErrMsgNA is used for all errors.
// SO...ErrMsgNA is the only REQUIRED error msg.
function bpcIsValidIdentifier( Id : string; var FixedID : string; TrimMe, StripSpace : boolean;  ErrMsgNA : string; ErrMsgBL: string=''; ErrMsgSP : string='' ) : string;

// Pattern match the target string in the lhs_target to the pattern in the rhs using soundex phometic comparison
// (if UseSoundEx = true - [the default]), or string comparison (if false).  Default SoundexLength is 4.
// Returns true if the lhs string matches the rhs pattern, else false.
// A pattern may us * (match 0 or many words) or ? (match one word). Spaces,',',(,),.,;,:,!,?,* are ignored in the target string.
// Matching is case insensitive.
// Examples: "I am a good bunny who eats carrots." Matches "* carrots" and "I * bunny ? eats *"
function bpcStrPatternMatch( lhs_target, rhs_pattern  : string; var LastOkIndex : integer; UseSoundEx : boolean=True; SoundexLength : integer=4 ) : boolean;
// A very fast comparison routine. Compares AsubText to AText starting at i (and buffer safe), optionally igonring
// case.
function bpcFastIndexedAnsiStrSame( ASubText, AText : string; i : integer=1; ignorecase : boolean=true ) : boolean;
// Compare substr to buferstr starting at i optionally ignoring the case and using *? to pattern match.
// NOTE: Pattern matching ALWAYS ignores case (sorry!).
function bpcStrMatches( substr, bufferstr : string; i : integer=1; ignorecase : boolean=true; usewildcard: boolean=false ) : boolean;
// Return true if the value is empty or contains a space
function bpcIsValueNilOrSpaced( value : string='' ): boolean;
// Return true if the value is empty
function bpcIsValueNil( value : string='' ): boolean;
// Switches a dbgrid between row selecting and cell selecting mode
procedure bpcGridRowSelectSwitch( var MyDBGrid : TDBGrid; RowSelect : boolean ) ;
// Find the index [0..(count-1)] of the element in strArray matching tagstr or -1
function bpcWSIndexOfList( targstr : string; strArray : array of string ) : integer;
// Find the string at the index [0..(count-1)] of the element in strArray or ''
function bpcWSStringAtIndexOfList( targind : integer; strArray : array of string ) : string;
// Use with the bpcWSIndexOfList to get the string found at an index in an array of string strArray matching tagstr or '' if -1
function bpcStringAtWSIndexOfList( i : integer; strArray : array of string ) : string;
// Classic string 'explode' routine using a substring (psubstr) as the trigger to explode
// S into a atring array.  Strips any characters in the psubstr and allocates a dynamic string array of the
// necessary size. Returns nil if S=''.  If btrimstrings=true then every token is stored in its trimmed form
// and spaces break a word only once, regardless of how many there are.
function bpcStrExplode ( psubstr, S : string; btrimstrings : boolean=false ) : TStringDynArray; overload;
// A Classic string 'explode' routine using splitting on forward scanned pairs of startsubstring (pstartsubstr), endsubstring
// (pendsubstr) as the trigger to explode the string, trimming spaces if btrimstrings=true (FALSE is the default).
// Does not handle nested pairs.  If (exclusive=true) only those strings enclosed by the markers are included in
// the array. So, if (exclusive=true): 'a cat (of the female variety) would eat only fish (or another).'
// exploded on '(' & ')' and trimmed would become [of the female variety][or another]
// If (exclusive=FALSE) - the DEFAULT - 'a cat (of the female variety) would eat only fish (or another).'
// exploded on '(' & ')' and trimmed, would become [a cat][of the female variety][would eat only fish][or another][.]
function bpcStrExplode ( pStartsubstr, pEndsubstr, S : string; btrimstrings : boolean=false; exclusive : boolean=false ) : TStringDynArray; overload;
// Return the an array of strings as a single string seperated by 'seperater'
function bpcAsString( dstringarray : array of string; seperater : string = '') : string; overload;
// Return the an stringlist as a single string seperated by 'seperater'
function bpcAsString( dstringarray : TStrings; seperater : string = '') : string; overload;
// Return the index of the first char after index that is not a 'seperater'
function bpcSkipPos( targstr : string; index : integer; seperaters : string = ' ') : integer;
// Pos - only backwards
function bpcBackPos( substr, targstr : string) : integer;
// Return the true if both arg stringss represent integers or reals
function bpcArgIsNum(lhs : string ) : boolean;
//Return the substring between the start and stop characters
function bpcStrBetweenCh(const S: AnsiString; const Start, Stop: AnsiChar): AnsiString;
// Return the value of the form_var matching FieldName or '' in the query and form blocks of a web-request object
function bpcWSWebFormField( Request: TWebRequest; FieldName : string ) : string;
// Return the value of the form_var matching FieldName or '' in the query and form blocks of a web-request object for MULTI RESPONSE FIELDS
// like select - mutliple, BUT if the query line has the value, forms fields are NOT examined.  This allows query jump lines to override
// form fields -  (hence the SQ in the name - single query).
// Returns the FIRST value found in the result string and all values in the populated TStrings (which must exist, and is cleared prior to use).
function bpcWSWebFormFieldMultiSQ( Request: TWebRequest; FieldName : string; MultiFieldValues : TStrings ) : string;
// Find the char index in strtemp (starting at index) of the first member of strlist to appear, else 0; and the token matched and its length.
// WARNING: CASE SENSITIVE MATCH, IGNORES ENCLOSING BRACKETS, QUOTES, etc - if case insensitivity, quote/bracket based string exclusion
// or the index of the found token is required use bpcWSCmdNestedPosListCS instead.
// Note: If EOSIsEOT is True, the end of the strTemp causes length of Strtemp + 1 to be returned, with tokstr=''.
//       If you want 0 returned at the end of the string, set EOSIsEOT to False.
function bpcWSCmdPosList(  strlist : array of string; EOSIsEOT : boolean; const strTemp : string; index : integer; var tokstr : string; var toklen : integer) : integer;
// Return everything between the opening and closing tag of a block
function bpcCursorMatch( inXML : string; i : integer; TargStr : string ) : boolean;
// Find the char index in strtemp (starting at index) of the first member of strlist to appear, else 0; and the token matched and its length.
// WARNING: CASE SENSITIVE MATCH - if case insensitivity, or the index of the found token is required use bpcWSCmdNestedPosListCS instead.
// 1. Handle nesting (by ignoring matching strings found within a nest) if Nesting is true, from an arbitrary nesting starting point (0 means
// the we are at the outer nest level - this allows us to start from within a nest. Nests are defined by pairs of '' or "" or <> or (), etc presented
// as an string of single chars like ' or " (where the start and end are the same) or an array of strings containing a pair of chars
// like [] or () or {}, etc. The nesting algorythm tracks both the count and the matching of the nest pairs.
// Note: If EOSIsEOT is True, the end of the strTemp causes length of Strtemp + 1 to be returned, with tokstr=''.
//       If you want 0 returned at the end of the string, set EOSIsEOT to False.
function bpcWSCmdNestedPosList( Nesting: boolean; nestlevel : integer; strlist : array of string; nestpairlist : array of string; nestsinglelist : string; EOSIsEOT : boolean; const strTemp : string; index : integer; var tokstr : string; var toklen : integer) : integer;
// Find the char index in strtemp (starting at index) of the first member of strlist to appear, else 0; and the token matched, its index and its length.
// 1. Handle nesting (by ignoring matching strings found within a nest) if Nesting is true, from an arbitrary nesting starting point (0 means
// the we are at the outer nest level - this allows us to start from within a nest. Nests are defined by pairs of '' or "" or <> or (), etc presented
// as an string of single chars like ' or " (where the start and end are the same) or an array of strings containing a pair of chars
// like [] or () or {}, etc. The nesting algorythm tracks both the count and the matching of the nest pairs.
// 2. Ignore case in matching if IgnoreCase is true, else be case sensitive.
// Note: If EOSIsEOT is True, the end of the strTemp causes length of Strtemp + 1 to be returned, with tokstr=''.
//       If you want 0 returned at the end of the string, set EOSIsEOT to False.
function bpcWSCmdNestedPosListIC( IgnoreCase, Nesting: boolean; nestlevel : integer; strlist : array of string; nestpairlist : array of string; nestsinglelist : string; EOSIsEOT : boolean; const strTemp : string; index : integer; var tokstr : string; var tokindex : integer; var toklen : integer) : integer;
// Skip leading spaces and return a trimmed token (as terminated by a member of delimiterlist), ALso return the index of the token end (delimeter) in index, and the delimeter in delimiterstr
function bpcWSCmdGetToken(const strTemp : string; delimiterlist : array of string; Var index : integer; var delimiterstr : string ) : string;
// Skip leading spaces and return a trimmed token (as terminated by a member of delimiterlist), ALso return the index of the token end (delimeter) in index, and the delimeter in delimiterstr
function bpcWSCmdGetNestedToken(const strTemp : string; nestinglevel : integer; delimiterlist : array of string; Var index : integer; var delimiterstr : string ) : string;
// Exactly like TStringList CommaText, except that it doesn't strip "", doesn't break on ' ', (unless these are also
// delimiterlist members) and knows about brackets ()[]{} - preserving nesting in these and " or '.
// An example call is:
//    mystringlist := bpcNestingCommaText( 'my string,( is, [ wild ] ), and; "free"', [',',';'], TStringlist.Create);
// Which will return mystringlist with:
// my string
// ( is, [ wild ] )
// and
// "free"
//
// Uses bpcWSCmdGetNestedToken, and returns a cleared tstrings with each token on a separate line, trimmed of leading
// and trailing white space and Stripped of delimeters in the delimiterlist.
function bpcNestingCommaText(const sourcestr : string; delimiterlist : array of string; myStringList : TStrings) : TStrings;
// Returns the LabelList (after first clearing it) with the sLine broken into trimmed tokens (treats punctuation as a token), kills all white space.
function bpcAsTokenList( sLine: string; LabelList : TStringList; DelimiterList: array of string; GimmeSpace : boolean=false; KeepCase : boolean=false) : TStringList;
// Reads a single CSV record and splits it into strings in a stringlist. It behaves exactly like TStringList CommaText,
// except that it reads from a stream and allows either "" or '' as a field designiator, allowing the other quote to
// appear inside a quoted string, and does not break on ' ' nor CR or LF. If CRLF appears as field end it is treated as
// a line break, which terminates the CSV record. If a quote appears other than at the start of a field it is treated like a normal
// character. If trimddq is true, doublequotes can be nested by doubling them inside an outer single double-quote set - a single doublequote
// will be returned.
function bpcCSVTABText( source : TStream; trimspace : boolean; delimiterlist : array of string; myStringList : TStringList) : TStringList;
function bpcCSVCommaText( source : TStream; trimspace : boolean; myStringList : TStringList) : TStringList; overload;
function bpcCSVCommaText( source : TStream; trimspace : boolean; delimiterlist : array of string; myStringList : TStringList) : TStringList; overload;
function bpcCSVDelimText( source : TStream; trimspace : boolean; delimiter : char; myStringList : TStringList) : TStringList; overload;
function bpcCSVDelimText( source : TStream; trimspace : boolean; trimddq : boolean; delimiter : char; myStringList : TStringList) : TStringList; overload;
function bpcCSVCommaText( source : TStream; trimspace : boolean; trimddq : boolean; delimiterlist : array of string; myStringList : TStringList) : TStringList; overload;
// Return a trimmed complex token (everything from index to the end), ALso return the index of the token end (strTemp length + 1) in index
function bpcWSCmdGetAfterToken(const strTemp : string; Var index : integer ) : string;
// Strip the outer brackets off an already trimmed string, or the string if no brackets.
// Doesn't skip white space, accepts half brackets (ie no closing bracket), else returns what it gets.
function bpcWSCmdGetBracketedExpression(const strTemp : string; delimiterlist : array of string; Var tokenindex : integer ) : string;
// Return a valid Encoded QRL (Question resource locater) comprising the merger of vSID.vQID:vRID with sActionArg (optionally with or without the ':' rule designator as flagged by 'AsRule')
// Senses 'sss', 'sss.qqq', '.', '.qqq', '.[sqg]', ':rrr', 'sss.qqq:rrr' to give 'sss.qqq:rrr' or 'sss.qqq'
function bpcFixJumpTarget(AsRule: boolean; vSID, vQID : string; vRID : integer; sActionArg : string) : string;
// Loads a list of QRL jump targets (after 'fixing'- see bpcFixJumptarget- each) into NextPageList (and simultaneously retunrs a ',' separated list)
function bpcLoadJumpTargets(AsRule: boolean; vSID, vQID : string; vRID : integer; BracketedExpression : string;  var tokenindex : integer; var NextPageList : TStringList; NonQRLList : boolean = False   ) : string;
// Explode a valid QRL held in jumpArgs into jumpSID, jumpQID, jumpRID and true/false on success or syntax failure
function bpcExplodeJumpTarget(jumpArgs: string; var jumpSID, jumpQID : string; var jumpRID: integer ) : boolean;
// Converts a string to a vararray
function bpcStringToPostData(const Value: string): OleVariant;
// Load a browser from a stream
{
function bpcLoadBrowserFromStream(myWebBrowser : TWebBrowser; const myStream: TStream): HRESULT;
}
// Post (or Get) a browser to sURL with stPostData as the content of the http message (nil content causes a get to be used)
// Content may be binary. Call forces refresh (ie. no read from cache)
procedure bpcWBNavigateNoCache(stURL : String;  stPostData:TByteDynArray; var wbWebBrowser: TWebBrowser);
// Post (or Get) an Indy HTTP component to sURL with stPostData as the content of the http message (nil content causes a get to be used)
// Content may be binary. Call forces refresh (ie. no read from cache) AND retunrs the reponse.
function bpcIndyNavigateNoCache(stURL : String;  stPostData: TStream; var wbWebBrowser: TIdHTTP) : string;
// Strip all HTML tags from a string
function bpcStripHTML(S: string): string;
// Return a string with all '<','>','&' contained in inward encoded as '&xx;' sub-strings.
function bpcHtmlEncode( inward : string ) : string;
// Decodes an HTML encoded string
function bpcHtmlDecode( inward : string ) : string;
// Replace all single quotes with double quotes to prevent injection attacks
function bpcSQLSafeQuote( inward : string ) : string;
// Replaces all tags of the form StartMUTag and EndMUTag (eg. [#...#] ) with <#...>. Useful if exchanging tagged HTML with word,
// since word and some other HTML editors are confused by the <#...> combination. This reverses the action of the bpcReplaceSMTagsWithMarkupTags
// routine.
function bpcReplaceMarkupTagsWithSMTags(myBuffer, StartMUTag, EndMUTag : string) : string; overload;
// As for bpcReplaceMarkupTagsWithSMTags(myBuffer, StartMUTag, EndMUTag : string) but assumes StartMUTag and EndMUTag are '[#' and '#]'
function bpcReplaceMarkupTagsWithSMTags(myBuffer : string) : string; overload;
// Replaces all tags of the form <#...> with StartMUTag and EndMUTag (eg. [#...#] ). Useful if exchanging tagged HTML with word,
// since word and some other HTML editors are confused by the <#...> combination. This reverses the action of the bpcReplaceMarkupTagsWithSMTags
// routine.
function bpcReplaceSMTagsWithMarkupTags(myBuffer, StartMUTag, EndMUTag : string) : string; overload;
// As for bpcReplaceSMTagsWithMarkupTags(myBuffer, StartMUTag, EndMUTag : string) but assumes StartMUTag and EndMUTag are '[#' and '#]'
function bpcReplaceSMTagsWithMarkupTags(myBuffer : string) : string; overload;
// Replaces all tags of the form 'start_string' ... 'end_string'  defined by StartMUTag and EndMUTag (eg. [#...#] or <#...>) with the string returned by
// calling the user provided function 'GetMessageFor'. Performs a simple version of the tstatementproducer service.
function bpcMergeMessageAtMarkupTags(myBuffer, StartMUTag, EndMUTag : string; GetMessageFor : TbpcMergeMessageFunc; myProperties : tstringlist; myGFParam : TObject ) : string;
// Calls user provided function GetMessageFor with each tag of the form 'start_string' ... 'end_string'  defined by StartMUTag and EndMUTag (eg. [#...#] or <#...>).
// Performs a simple version of the tstatementproducer service, but doesn't update the calling string.  Typical use would be to cause a sequence of things to happen based on
// a source string containing markup tags.
function bpcCallMessageAtMarkupTags(myBuffer, StartMUTag, EndMUTag : string; GetMessageFor : TbpcMergeMessageFunc; myProperties : tstringlist; myGFParam : TObject ) : string;

//////////////////////////////////////////////////////////////////////////////////////////
//////// Other String Conversion Routines
//////////////////////////////////////////////////////////////////////////////////////////

// Map filename extensions to -1 (if not known), or an integer 0...n in the following order:
// Note: Accepts strings with or without a leading period
// '.bmp','.jpg','.jpeg','.jpeg2000','.wmf','.emf','.ico','.icon'
function bpcMapExtToImageType( myext : string ) : TbpcStndFilExtTypes;

//////////////////////////////////////////////////////////////////////////////////////////
//////// TbpcXMLNodeStringList Manipulation Routines
//////////////////////////////////////////////////////////////////////////////////////////

// This group of routines carves up XML inline and block tags into a TbpcXMLNodeStringList
// which is essentially a TbpcStringList (ie. an TStringList with extra value and
// string array routines) that contains a Content string (for block tags) and a TagType
// to distibguish block and inline tags (TbpcXMLNodeType of either bpcXMLInlineNode or bpcXMLBlockNode).
// The stringlist contains name value pairs for
// TagName (the XML tag id),
// TagType (either 'inline' or 'block')
// Any other attribute found in the open tag string
// Attribute strings with outer quotes are NOT stripped
// Attributes are terminated by space or / or > unless quoted, in which case quotes terminate
// Quote-in-quote is correctly handled.


// THESE ROUTINES MUST WORK TOGETHER - the i param is left in the correct
// location after the bpcGetXMLOpenTag for bpcGetXMLContent and then for bpcGetXMLCloseTag.

// Return a full XML tag object from a single XML object
// By Default the routine will expand/decode the HTML encoded content - if you want to preserve the encoding of
// < > ' " etc then set NoHTMLDecode=true.
// This is the main routine eg:
//    i := 1;
//    resultObj := bpcGetXMLTagObject('<test attrib1="mystring" attrib2=23 />',i );
//    if resultObj.TagType=bpcXMLInlineNode then ...
function bpcGetXMLTagObject( inXML : string; var i : integer; NoHTMLDecode : boolean=False; SenseQuotes : boolean=false  ) : TbpcXMLNodeStringList;
// Return a XML tag object attribute list from an open XML tag
function bpcGetXMLAttributeList( inTagStr : string ) : TbpcXMLNodeStringList;
// Return an XML token as a single string. A token is either a quoted string or a
// alphanum terminated by a space or '/' or '>' object attribute list from an open XML tag
function bpcGetXMLToken( inXML : string; var index : integer ) : string;
// Return everything inside the closing tag of a block. If SenseQuotes is true, tags inside quotation marks are
// ignored. The algorythm assumes that quotes never appear after alphanums.  A quote appearing after an
// alphanum is assumed to be a single orphaned quote.  As in isn't he nice.  In this sentense the single
// quote will not confuse the algorythm, and it will be ignored, but in: I "am the light </name >" I said. The
// double quote would be assumed to be the start of the string and </name > would not be seen as the closing tag for
// <name ></name >.
function bpcGetXMLCloseTag( inXML : string; var index : integer; SenseQuotes : boolean=false ) : string;
// Return everything between the opening and closing tag of a block
function bpcGetXMLContent( inXML : string; var index : integer; endtagname : string; SenseQuotes : boolean=false ) : string;
// Return everything inside the opening tag.
function bpcGetXMLOpenTag( inXML : string; var index : integer; SenseQuotes : boolean=false ) : string;
// Return the starting index of a target tag block, OR i > length( inXML ) if failed.
function bpcSeekXMLTagStart( inXML : string; i : integer; TargStr : string ) : integer;

///////////////////////////////////////////////////////
// These routines do useful database & registry things
///////////////////////////////////////////////////////

// Return a stringlist containg key field names for ADO-XML table schemas
// Relies on the MSXML ADO Schema Definition created when a Db table is saved to file
// from an ADO dataset.
function bpcXMLADOKeyFieldList( XMLStr : string; KeyFields : TStrings ) : TStrings;
// Sets a SMLibrary Key, to a value assuming a SM Style registry structure.
// Eg:  bpcSetTheSMLibraryToTheKeyValue('BPCSurveyManager1', 'Localisation', 'DEV1' );
procedure bpcSetTheSMLibraryToTheKeyValue(sDBIPath, sKey, sValue : string);
function bpcGetTheSMLibraryForTheKeyValue(sDBIPath, sKey : string) : string;
// Returns a subpath with a closing '\' - gauranteed, or '' if subpath is ''
function bpcAsRegistrySubPath( subpath : String ) : string;
// Returns a subpath with a closing '/' - gauranteed, or '' if subpath is ''
function bpcAsURLSubPath( subpath : String ) : string;
// Create a key path for SM keys (ie. Do not include the sRegKey here - just the sRegSubPath
// Ie bpcCreateKeyPathForSMLibrary('BPCSurveyManager1' )
procedure bpcCreateKeySubPathForSMLibrary( sRegSubPath : string  ) ;
// Get all keys from a key path (sRegSubPath) for the BPC registry offset .
procedure bpcListSubPathsForSMLibrary( sRegSubPath : string; const Key: string; const List: TStrings  ) ;
// Get all value keys from a key path for for the BPC registry offset.
procedure bpcListValueKeysForSMLibrary( sRegSubPath : string; const List: TStrings  ) ;
// Read an entry from the registry representing an ADO connection string and assign it to an ADO connection and open it.
// Returns non-zero iErrorVal if the connection cannot be successfully established, else zero. The error is in sErrorMsg.
// Example call:
// iErrorVal := bpcDBOpenConnectionFromRegistry(MyDataMod.ADOConnection1, HKEY_LOCAL_MACHINE, 'SOFTWARE\BishopPhillips\BPCSurveyManager1', 'DBConnectString', sErrorMsg);
function bpcDBOpenConnectionFromRegistry(myADOConnection : TADOConnection; RootKey : HKEY; sRegPath, sDBRegConnectName : string; var sErrorMsg : string) : integer;
// Opens a database using bpcDBOpenConnectionFromRegistry, but assumes a SM Style registry structure.
function bpcDBOpenSMConnectionFromRegistry(myADOConnection : TADOConnection; sDBIPath : string; var sErrorMsg : string) : integer;
// Sets a database connection string to the SMLibrary Key, assuming a SM Style registry structure.
procedure bpcSetTheSMLibraryToTheDBConnection(sDBIPath, sDBConnect : string);
// This routine assumes a Registry key (sDBIPath + 'DBConnectString') containing an DB connection string of which sDBI
// is the initial catalogue (database).  If the supplied sDBI does not match that in the registry database, or
// the registry entry does not exist, the routine returns False, else True.
// Example Use: Use this routine with a module name (like a dll) and a matching registry key path with the expected database,
// if this latter differs from the expected database, the database must be reset & reloaded (or the key changed).
// Eg. If the expected database is 'SurveyDB' and the calling dll (from bpcGetDLLModuleName) is bpcSurveyManager1.dll, and
// the registry is set up with a DBConnectString held in "SOFTWARE\BishopPhillips\bpcSurveyManager1 [DBConnectString]", then
// bpcDoesDBImatchSMLibrary( 'SurveyDB', 'bpcSurveyManager1') would return True if SurveyDB was the correct db for this module.
function bpcDoesDBIMatchSMLibrary( sDBI, sDBIPath : string  ) : boolean;
// Exactly like bpcDoesDBImatchSMLibrary, but uses the entire key value.
// A typical use of this might be to force the reload of a configuration file in a dll that has an arbitrary life
function bpcDoesKeyMatchSMLibrary( sExpectedValue, sRegSubPath, sRegKey : string  ) : boolean;
// Used in conjunction with bpcDoesKeyMatchSMLibrary to get the current value of the registry key
function bpcGetCurrentKeyForSMLibrary( sRegSubPath, sRegKey : string  ) : string;
// Get the current value of the registry key with sDefVal as default on nil value in registry
function bpcGetCurrentKeyForModuleWithDefault( sRegSubPath, sRegKey, sDefVal : string  ) : string;
// Merge a list of name=value pairs (SectAsValues) with the keys in sRegSubPath. Create sRegSubPath if required.
procedure bpcMapStringsToRegistry(sRegSubPath : string; SectAsValues : tstrings);
// Merge a list of name=value pairs defined in SectAsList from the keys in sRegSubPath and store them in SectAsValues.
// Create SectasValue entries as required.
function bpcMapStringsFromRegistry( sRegSubPath : string; SectAsList : Tstrings; SectAsValues : TStrings=nil ) : tstrings;
// Exract and return the database name from an ADO SQL Server Connection String
function bpcGetDBNameFromMSSQLConnectionString( sConnectionString : string  ) : string;
// Set/replace the database name in an ADO SQL Server Connection String
function bpcSetDatabaseInMSSQLConnectionString( sConnectionString, sDataBaseName : string  ) : string;
// Set/replace the user and password in an ADO SQL Server Connection String with a correctly formed user and password
function bpcSetUserInMSSQLConnectionString( sConnectionString, sUserName, sPassword : string  ) : string;
// Set/replace the source name in an ADO SQL Server Connection String with a correctly formed source name comprising server/instance
function bpcSetDataSourceInMSSQLConnectionString( sConnectionString, sServer, sInstance : string  ) : string;
// Replace the source name (server/instance ) in an ADO SQL Server Connection String
function bpcReplaceDataSourceInMSSQLConnectionString( sConnectionString, NewDataSource : string  ) : string;
// Replace a arbitrary parameter in an ADO SQL Server Connection String
function bpcReplaceAParamInAnMSSQLConnectionString( sConnectionString, TargParam, NewArg : string  ) : string;

////////////////////////////////////////////////////////////////
// like "Application.ExeName", but in a DLL you get the name of
// the DLL instead of the application name
function bpcGetDLLModuleName: String;
////////////////////////////////////////////////////////////////
// like "Application.ExeName", but in a DLL you get the drive:path of
// the DLL instead of the application name and it is guaranteed to end
// with a separater
function bpcGetDLLModulePath: String;
////////////////////////////////////////////////////////////////
// like "Application.ExeName", but in a DLL you get the name of
// the DLL instead of the application name and prefixed with a subpath
// from sProdFamily : sProdFamily\DLLModuleName
function bpcGetProdFamilyDLLModuleName( sProdFamily : String ) : String;
////////////////////////////////////////////////////////////////
// like "Application.ExeName", but in a DLL you get the drive:path of
// the DLL instead of the sProdFamily\DLLModuleName name and it is guaranteed to end
// with a separater
function bpcGetProdFamilyDLLModulePath( sProdFamily : String ): String;
// Various prodfamily prefixed bpc dll modulename routines for registry access
function bpcGetSM1_DLLModuleName: String;
function bpcGetRM_DLLModuleName: String;
function bpcGetGM1_DLLModuleName: String;

const
  CNST_SM1ProdFamily : string = 'BPCSurveyManager1\' ;
  CNST_RMProdFamily : string = 'BPCRiskManager\' ;
  CNST_GMProdFamily : string = 'BPCGovManager1\' ;


BackLinks



CopyRight Bishop Phillips Consulting Pty Ltd 1997-2012 ( BpcSMScriptLibrary 1 )
Personal tools