Open Forum > Business BASIC Migrations

Business BASIC Helper Library

(1/1)

Support:
Here are a few ProvideX Business Basic like functions that can be used to help with your conversion to Script BASIC.


--- Code: Script BASIC ---' BB Function Helper Library  ' BB_ATH - Business BASIC ATH() function'' Converts a text string of hex character pairs to ASCII values.'FUNCTION BB_ATH(HexStr)   LOCAL LenHex, AsciiStr, HexTable, ScanPos, HiByte, LowByte  LenHex = LEN(HexStr)  IF LenHex % 2 = 0 THEN    HexTable = "0123456789ABCDEF"    FOR ScanPos = 1 TO LenHex STEP 2      HiByte = INSTR(HexTable,UCASE(MID(HexStr, ScanPos, 1))) - 1      LowByte = INSTR(HexTable,UCASE(MID(HexStr, ScanPos + 1, 1))) - 1      IF ISINTEGER(HiByte) AND ISINTEGER(LowByte) THEN        AsciiStr &= CHR(HiByte * 16 + LowByte)      ELSE        AsciiStr = ""        GOTO Exit_For              END IF    NEXT ScanPos    Exit_For:  ELSE    AsciiStr = ""  END IF  BB_ATH = AsciiStr END FUNCTION  ' BB_CVS - Business Basic CVS() function'' Action:'  1   = Remove Leading characters'  2   = Remove Trailing characters'  4   = Convert String to Upper Case'  8   = Convert String to Lower Case'  16  = Replace characters < 32 with the control character'  32  = Replace multiple occurrence of the character with one'  64  = * Replace $ with defined Windows currency symbol'  128 = * Replace defined Windows currency, comma and thousand symbol'  256 = * Ucase first char of each word, rest to lower'    * = Not implemented yet.'FUNCTION BB_CVS(StrExpr, Action, CtrlChar)   LOCAL Char, ExprLen, TempStr, ScanPos   IF CtrlChar = undef THEN CtrlChar = " "  Char = ASC(CtrlChar)    ' Remove Leading characters  IF (Action AND 1) THEN       ExprLen = LEN(StrExpr)    IF CtrlChar = " " THEN      StrExpr = LTRIM(StrExpr)    ELSE      TempStr = ""      FOR ScanPos = 1 TO ExprLen        IF MID(StrExpr, ScanPos, 1) <> CtrlChar THEN TempStr &= MID(StrExpr, ScanPos, 1)      NEXT ScanPos      StrExpr = TempStr    END IF  END IF    ' Remove Trailing characters  IF (Action AND 2) THEN       ExprLen = LEN(StrExpr)    IF CtrlChar = " " THEN      StrExpr = RTRIM(StrExpr)    ELSE      TempStr = ""      FOR ScanPos = ExprLen TO 1 STEP - 1        IF MID(StrExpr, ScanPos, 1) = CtrlChar THEN TempStr = LEFT(StrExpr, ScanPos - 1)      NEXT ScanPos      IF LEN(TempStr) THEN StrExpr = TempStr    END IF  END IF    ' Convert String to Upper Case  IF (Action AND 4) THEN       StrExpr = UCASE(StrExpr)  END IF    ' Convert String to Lower Case  IF (Action AND 8) THEN       StrExpr = LCASE(StrExpr)  END IF    ' Replace characters < 32 with the control character  IF (Action AND 16) THEN      FOR ScanPos = 1 TO LEN(StrExpr)         IF ASC(MID(StrExpr, ScanPos, 1)) < 32 THEN StrExpr = LEFT(StrExpr, ScanPos -1) & CtrlChar & MID(StrExpr, ScanPos + 1)    NEXT ScanPos  END IF    ' Replace multiple occurence of the character with one  IF (Action AND 32) THEN      HitCnt = 0    StartPos = 1    NextPos:    ScanPos = INSTR(StrExpr,CtrlChar,StartPos)    IF ISINTEGER(ScanPos) THEN      IF HitCnt THEN           IF ASC(MID(StrExpr, ScanPos,1)) = CtrlChar THEN TeStrExpr = LEFT(StrExpr, ScanPos -1) & MID(StrExpr, ScanPos + 1)      ELSE        HitCnt += 1      END IF      StartPos += 1      GOTO NextPos    END IF  END IF           BB_CVS = StrExpr END FUNCTION  ' BB_DEC - Business BASIC DEC() function'' Returns a two's complement binary equivalent of the string.'FUNCTION BB_DEC(BinStr)                                      LOCAL i, d                                         FOR i = LEN(BinStr) TO 1 STEP -1                             d += ASC(MID(BinStr,i,1)) * 256 ^ ABS(i - LEN(BinStr))  NEXT i                                                      BB_DEC = d                                                 END FUNCTION                                                 ' BB_HTA - Business BASIC HTA() function'' Returns the hexadecimal text string of the pasted argument string.'FUNCTION BB_HTA(AsciiStr)  LOCAL AsciiLen,ScanPos,HexStr  AsciiLen = LEN(AsciiStr)  IF AsciiLen THEN    FOR ScanPos = 1 TO AsciiLen      HexStr &= RIGHT("0" & HEX(ASC(MID(AsciiStr, ScanPos, 1))),2)    NEXT ScanPos  ELSE    HexStr = ""  END IF  BB_HTA = HexStrEND FUNCTION  ' BB_JUL - Business BASIC JUL() function'' Converts a date from year, month, day to a Julian date.'FUNCTION BB_JUL(Y,M,D)   IF Y = undef AND M = undef AND D = undef THEN    BB_JUL = NOW  ELSE    BB_JUL = TIMEVALUE(Y,M,D)  END IF END FUNCTION  ' BB_LRC - Business Basic LRC() function.'' Returns a one byte string containing the longitudinal redundancy checksum of a character string.'FUNCTION BB_LRC(ArgStr)   LOCAL ArgStrLen, ScanPos, LRCVal  LRCVal = 0  ArgStrLen = LEN(ArgStr)  IF ArgStrLen THEN    FOR ScanPos = 1 TO ArgStrLen      LRCVal += LRCVal XOR ASC(MID(ArgStr, ScanPos, 1))    NEXT ScanPos    BB_LRC = CHR(LRCVal)  ELSE    BB_LRC = CHR(&H00)  END IF END FUNCTION  ' BB_PAD - Business BASIC PAD() funtion'' Returns a character string of the length specified (NumExpr)'' NOTE: StrExpr    = String to be processed'       NewLen     = Desired length of string'       HowToPad   = This parameter defines how to pad the string'                     0 - Pad on left  (right justify)'                     1 - Pad on right (left justify)'                     2 - Center in string'       StrPad     = First character of this string used to pad StrExpr'FUNCTION BB_PAD(StrExpr,NewLen,HowToPad,StrPad)   LOCAL StrExpr,NewLen,HowToPad,StrPad,PadVal,StrExprLen,ResultStr,RLPLen  IF HowToPad = undef THEN    PadVal = 1   ELSE IF HowToPad = 0 OR UCASE(HowToPad) = "L" THEN    PadVal = 0  ELSE IF HowToPad = 1 OR UCASE(HowToPad) = "R" THEN      PadVal = 1  ELSE IF HowToPad = 2 OR UCASE(HowToPad) = "C" THEN           PadVal = 2  ELSE    BB_ERR = 41    BB_PAD = ""    EXIT FUNCTION  END IF    IF StrPad = undef THEN StrPad = " "  StrExprLen = LEN(StrExpr)    IF PadVal = 0 THEN    IF NewLen < StrExprLen THEN      ResultStr = RIGHT(StrExpr, NewLen)    ELSE      ResultStr = STRING(NewLen - StrExprLen, StrPad) & StrExpr    END IF  END IF   IF PadVal = 1 THEN    IF NewLen < StrExprLen THEN      ResultStr = LEFT(StrExpr, NewLen)    ELSE      ResultStr = StrExpr & STRING(NewLen - StrExprLen, StrPad)    END IF  END IF   IF PadVal = 2 THEN    IF NewLen < StrExprLen THEN      ResultStr = LEFT(StrExpr, NewLen)    ELSE      RLPLen = (NewLen - StrExprLen) / 2      IF RLPLen % 2 THEN        ResultStr = STRING(FIX(RLPLen),StrPad) & StrExpr & STRING(FIX(RLPLen) + 1,StrPad)      ELSE        ResultStr = STRING(RLPLen,StrPad) & StrExpr & STRING(RLPLen,StrPad)      END IF    ENDIF  END IF   BB_PAD = ResultStr  END FUNCTION  ' BB_POS - Business Basic POS() function' ' BB_POS follows these logic steps:'' 1. If stringA or StringB is null, return 0' 2. Start with first byte in stringB if intA is positive, or the Nth byte'    from the end of stringB if intA is negatine (-N).' 3. If past either the begining or end of stringB then return 0'    (or occurrence count if intB is 0)' 4. Compare stringA with the substring at the current position in stringB.'    The length of substring will be either the length of stringA or the'    remainder of stringB, whichever is shorter.' 5. If a given releationship is true and if this was the Nth successful'    try (specified by intB=N) then return the current scan position.' 6. If the relation was not satisfied then bump the scan position'    (possibly backwards if intA is negative) and go to step 3 and try again.'' Relationship Operators:'' "="   -   Equal To' "<"   -   Less Than' ">"   -   Greater Than' "<="  -   Less Than Or Equal To' ">="  -   Greater Than Or Equal To' "<>"  -   Not Equal To' ":"   -   Equal to Any' "^"   -   Not Equal To Any'FUNCTION BB_POS(MatchStr,ScanStr,Relate,IncVal,OccurVal)   LOCAL LenMatchStr,LenScanStr,ScanPos,OccurCnt,Item,StartVal,EndVal  IF Relate = undef THEN Relate = "="  IF IncVal = undef  THEN IncVal = 1  IF OccurVal = undef  THEN OccurVal = 1  LenMatchStr = LEN(MatchStr)  IF INSTR(":^", Relate) THEN LenMatchStr = 1  LenScanStr = LEN(ScanStr)  IF LenMatchStr = 0 OR LenScanStr = 0 OR OccurVal < 0 THEN    BB_POS = 0    EXIT FUNCTION  END IF  IF IncVal > 0 THEN    StartVal = 1    EndVal = LenScanStr  ELSE    StartVal = LenScanStr    EndVal = 1  END IF  FOR ScanPos = StartVal TO EndVal STEP IncVal    Item = MID(ScanStr, ScanPos, LenMatchStr)    IF Relate = "=" THEN      IF MatchStr = Item THEN OccurCnt += 1    ELSE IF Relate = "<" THEN      IF MatchStr < Item THEN OccurCnt += 1    ELSE IF Relate = ">" THEN      IF MatchStr > Item THEN OccurCnt += 1    ELSE IF Relate = "<=" OR Relate = "=<" THEN      IF MatchStr <= Item THEN OccurCnt += 1    ELSE IF Relate = ">=" OR Relate = "=>" THEN      IF MatchStr >= Item THEN OccurCnt += 1    ELSE IF Relate = "<>" OR Relate = "><" THEN      IF MatchStr <> Item THEN OccurCnt += 1    ELSE IF Relate = ":" THEN      IF INSTR(MatchStr, Item) THEN OccurCnt += 1    ELSE IF Relate = "^" THEN      IF NOT ISNUMERIC(INSTR(MatchStr, Item)) THEN OccurCnt += 1    ELSE      BB_POS = 0      EXIT FUNCTION    END IF    IF OccurVal > 0 THEN      IF OccurCnt = OccurVal THEN GOTO Done    END IF  NEXT ScanPos   Done:   IF OccurVal = 0 THEN    BB_POS = OccurCnt  ELSE IF OccurCnt THEN    BB_POS = ScanPos  ELSE    BB_POS = 0    END IF END FUNCTION 
bbtest.sb

--- Code: Script BASIC ---' bb.inc test script IMPORT bb.inc  PRINT "HTA()\n"hta = BB_HTA("Script BASIC")PRINT hta,"\n\n"PRINT "ATH()\n"PRINT BB_ATH(hta),"\n\n"PRINT "PAD()\n"s = BB_PAD("BASIC",10,2," ")PRINT "|" & s & "|\n\n"PRINT "POS()\n"s = "The quick brown fox"' yields 5PRINT BB_POS("q",s,"="),"\n"' yields 0PRINT BB_POS("z",s,"="),"\n" ' yields 13PRINT BB_POS("o",s,"=") ,"\n"' yields 18 - Scan from end (fox)PRINT BB_POS("o",s,"=",-1),"\n"' yields 18 - Second occurrence (fox)PRINT BB_POS("o",s,"=",1,2),"\n" ' yields 13 - Checks every 2nd positionPRINT BB_POS("o",s,"=",2),"\n" ' yields 6 - "u" is first char. > "r"PRINT BB_POS("r",s,"<"),"\n" PRINT "CVS()\n"s = "  sb  "PRINT "|" & BB_CVS(s,3," "),"|\n"PRINT "|" & BB_CVS(s,4,""),"|\n\n" 
Output

jrs@laptop:~/sb/sb22/PHB$ time scriba bbtest.sb
HTA()
536372697074204241534943

ATH()
Script BASIC

PAD()
|  BASIC  |

POS()
5
0
13
18
18
13
6
CVS()
|sb|
|  SB  |


real   0m0.026s
user   0m0.022s
sys   0m0.004s
jrs@laptop:~/sb/sb22/PHB$

Navigation

[0] Message Index