git.8kb.co.uk Git - dataflex/df32func/blob - src/df32/string.inc

   1 //-------------------------------------------------------------------------\r
   2 // string.inc\r
   3 //      This file contains some DataFlex 3.2 Console Mode functions\r
   4 //      and classes to provide extended string manipulation capabilities.\r
   5 //\r
   6 // This file is to be included in df32func.mk\r
   7 //\r
   8 // Copyright (c) 2006-2015, glyn@8kb.co.uk\r
   9 // \r
  10 // df32func/string.inc\r
  11 //-------------------------------------------------------------------------\r
  12 \r
  13 //-------------------------------------------------------------------------\r
  14 // Functions\r
  15 //-------------------------------------------------------------------------\r
  16 \r
  17 // Convert a string to titlecase\r
  18 function titlecase global string argv returns string\r
  19     local string l_01tmpStr\r
  20     local integer l_01tmpInt\r
  21 \r
  22     move "" to l_01tmpStr\r
  23     lp_maketitle01:\r
  24     append l_01tmpStr (uppercase(left(argv,1)))\r
  25     pos " " in argv to l_01tmpInt\r
  26     if l_01tmpInt eq 0 begin\r
  27         length (trim(argv)) to l_01tmpInt\r
  28         append l_01tmpStr (lowercase(right(argv,(l_01tmpInt-1))))\r
  29         goto lp_exittitle01\r
  30     end\r
  31     append l_01tmpStr (lowercase(mid(argv,(l_01tmpInt-1),2)))        \r
  32     trim (mid(argv,(length(argv)),(l_01tmpInt+1))) to argv        \r
  33     goto lp_maketitle01\r
  34     lp_exittitle01:\r
  35 \r
  36     function_return l_01tmpStr\r
  37 end_function\r
  38 \r
  39 //replace all characters in argv2 found in argv with srting in argv3 - see replaces\r
  40 function replaceall global string argv string argv2 string argv3 returns string\r
  41     local integer l_01tmpInt\r
  42     \r
  43     move (trim(argv)) to argv\r
  44     for l_01tmpInt from 1 to (length(argv))\r
  45         move (replaces((mid(argv,1,l_01tmpInt)),argv2,argv3)) to argv2\r
  46     loop\r
  47     \r
  48     function_return argv2\r
  49 end_function\r
  50 \r
  51 // Pad a string with zeros to the left\r
  52 function zeropad global string argv integer argv2 returns string\r
  53     local string l_01tmpStr\r
  54     \r
  55     move "" to l_01tmpStr\r
  56     move (repeat("0",(argv2-(length(trim(argv)))))) to l_01tmpStr\r
  57     append l_01tmpStr (trim(argv))\r
  58     \r
  59     function_return l_01tmpStr\r
  60 end_function\r
  61 \r
  62 // Padd a string with spaces to the left\r
  63 function leftpad global string argv integer argv2 returns string\r
  64     local string l_01tmpStr\r
  65     \r
  66     move "" to l_01tmpStr\r
  67     move (repeat(" ",(argv2-(length(trim(argv)))))) to l_01tmpStr\r
  68     append l_01tmpStr (trim(argv))\r
  69     \r
  70     function_return l_01tmpStr\r
  71 end_function\r
  72 \r
  73 // Returns the string in reverse\r
  74 function reverse global string argv returns string\r
  75     local string l_sReturn\r
  76     local integer l_i l_iLen\r
  77     \r
  78     move (length(argv)) to l_iLen\r
  79     move "" to l_sReturn\r
  80     \r
  81     for l_i from 0 to l_iLen\r
  82         append l_sReturn (mid(argv,1,l_iLen-l_i))\r
  83     loop\r
  84     \r
  85     function_return l_sReturn\r
  86 end_function\r
  87 \r
  88 // Standard escaping via C standard.\r
  89 //\r
  90 // For PostgreSQL when NO_BACKSLASH_QUOTE is defined single quotes are \r
  91 // escaped per SQL standard by doubling '' rather than \' because in \r
  92 // some encodings multibyte characters have a last byte numerically \r
  93 // equivalent to ASCII escaped by backslash "\".\r
  94 // This should not be required if client encoding is LATIN1\r
  95 // and safe_encoding is set.\r
  96 function addslashes global string argv returns string\r
  97     local string l_sReturn\r
  98     \r
  99     move (replaces("\",argv,"\\")) to l_sReturn\r
 100     #IFDEF NO_BACKSLASH_QUOTE\r
 101         move (replaces("'",l_sReturn,"''")) to l_sReturn\r
 102     #ELSE\r
 103         move (replaces("'",l_sReturn,"\'")) to l_sReturn\r
 104     #ENDIF\r
 105     move (replaces('"',l_sReturn,'\"')) to l_sReturn\r
 106     \r
 107     function_return l_sReturn\r
 108 end_function\r
 109 \r
 110 // Standard escaping for quoted CSV standard\r
 111 function quotecsv global string argv returns string\r
 112     local string l_sReturn\r
 113     \r
 114     move (replaces('"',argv,'""')) to l_sReturn\r
 115     \r
 116     function_return l_sReturn\r
 117 end_function\r
 118 \r
 119 // Sanitize an integer for use in an sql statement. \r
 120 // This doesn't do anything other than make sure the value fits in the integer\r
 121 function sanitize_int global integer l_iInput integer bound returns integer\r
 122     local integer l_iReturn\r
 123     \r
 124     move (integer(l_iInput)) to l_iReturn\r
 125     \r
 126     function_return l_iReturn   \r
 127 end_function\r
 128 \r
 129 // Sanitize an number for use in an sql statement. \r
 130 // This doesn't do anything other than make sure the value fits in the number\r
 131 function sanitize_num global number l_nInput returns integer\r
 132     local number l_nReturn\r
 133     \r
 134     move (number(l_nInput)) to l_nReturn\r
 135     \r
 136     function_return l_nReturn   \r
 137 end_function\r
 138 \r
 139 // Sanitize a string. 3 Modes\r
 140 // SQL - this just does addslashes \r
 141 // SYSTEM - removes all characters that could be problematic at the console\r
 142 // PARANOID - removes all non alphanumeric characters and any aparent sql it is worried about.\r
 143 function sanitize_str global string l_sInput string l_sLevel returns string\r
 144     local string l_sReturn\r
 145     local integer l_i l_iCode l_iBadScore\r
 146     \r
 147     move (uppercase(trim(l_sLevel))) to l_sLevel\r
 148     if ((l_sLevel <> "SQL") and (l_sLevel <> "SYSTEM") and (l_sLevel <> "PARANOID")) move "PARANOID" to l_sLevel\r
 149     move "" to l_sReturn\r
 150     \r
 151     if (length(l_sInput) <> 0) begin\r
 152         if (l_sLevel = "SQL") move (addslashes(l_sInput)) to l_sReturn\r
 153         \r
 154         if (l_sLevel = "SYSTEM") begin\r
 155             move (replaceall("!=()<>/\|`'^~%$#;&",l_sInput,"")) to l_sReturn\r
 156             move (replaces(character(10),l_sReturn,"")) to l_sReturn\r
 157             move (replaces(character(13),l_sReturn,"")) to l_sReturn\r
 158             move (replaces('"',l_sReturn,'')) to l_sReturn\r
 159         end\r
 160         if (l_sLevel = "PARANOID") begin\r
 161             for l_i from 1 to (length(l_sInput))\r
 162                 move (ascii(mid(l_sInput,1,l_i))) to l_iCode\r
 163                 if (((l_iCode >= 48) and (l_iCode <= 57)) or ((l_iCode >= 65) and (l_iCode <=90)) or ((l_iCode >= 97) and (l_iCode <=122)) or (l_iCode = 32)) begin\r
 164                     append l_sReturn (mid(l_sInput,1,l_i))\r
 165                 end\r
 166             loop\r
 167             \r
 168             move 0 to l_iBadScore\r
 169             if ((uppercase(l_sReturn) contains "DROP ") or (uppercase(l_sReturn) contains "CREATE ") or (uppercase(l_sReturn) contains "ALTER ") or (uppercase(l_sReturn) contains "TRUNCATE ") or (uppercase(l_sReturn) contains "COPY ")) begin\r
 170                 increment l_iBadScore\r
 171                 if (uppercase(l_sReturn) contains " TABLE ") increment l_iBadScore\r
 172                 if (uppercase(l_sReturn) contains " INDEX ") increment l_iBadScore\r
 173                 if (uppercase(l_sReturn) contains " DATABASE ") increment l_iBadScore\r
 174                 if (uppercase(l_sReturn) contains " GROUP ") increment l_iBadScore\r
 175                 if (uppercase(l_sReturn) contains " FUNCTION ") increment l_iBadScore\r
 176                 if (uppercase(l_sReturn) contains " RULE ") increment l_iBadScore\r
 177                 if (uppercase(l_sReturn) contains " AGGREGATE ") increment l_iBadScore\r
 178                 if (uppercase(l_sReturn) contains " TYPE ") increment l_iBadScore\r
 179                 if (uppercase(l_sReturn) contains " TRIGGER ") increment l_iBadScore\r
 180                 if (uppercase(l_sReturn) contains " OPERATOR ") increment l_iBadScore\r
 181                 if (uppercase(l_sReturn) contains " USER ") increment l_iBadScore\r
 182                 if (uppercase(l_sReturn) contains " SEQUENCE ") increment l_iBadScore\r
 183             end\r
 184             else if ((uppercase(l_sReturn) contains "GRANT ") or (uppercase(l_sReturn) contains "REVOKE ")) begin\r
 185                 increment l_iBadScore\r
 186                 if ((uppercase(l_sReturn) contains " ON ") and (uppercase(l_sReturn) contains " TO ")) increment l_iBadScore\r
 187                 if ((uppercase(l_sReturn) contains " ON ") and (uppercase(l_sReturn) contains " FROM ")) increment l_iBadScore\r
 188                 if (uppercase(l_sReturn) contains " ALL ") increment l_iBadScore\r
 189                 if (uppercase(l_sReturn) contains " ALL ") increment l_iBadScore\r
 190                 \r
 191             end\r
 192             else if ((uppercase(l_sReturn) contains "UPDATE ") or (uppercase(l_sReturn) contains "DELETE ")) begin\r
 193                 increment l_iBadScore\r
 194                 if (not (uppercase(l_sReturn)) contains " WHERE") increment l_iBadScore\r
 195             end\r
 196             if (l_iBadScore > 1) begin\r
 197                 move "" to l_sReturn\r
 198             end\r
 199         end\r
 200         \r
 201     end\r
 202     else begin\r
 203         move l_sInput to l_sReturn\r
 204     end\r
 205     \r
 206     function_return l_sReturn   \r
 207 end_function\r
 208 \r
 209 // Return one blank of two strings\r
 210 function nbstring global string argv string argv2 returns string\r
 211     if (argv <> "") function_return argv\r
 212     else if (argv2 <> "") function_return argv2\r
 213     else function_return ""\r
 214 end_function\r
 215 \r
 216 // Do transformation of xml based on xsl stylesheet\r
 217 // E.g. msxsl("\\somehost\bin\msxsl.exe", "c:\test.xml","c:\test.xsl","","c:\test.html")\r
 218 function msxsl global string engine string source string stylesheet string params string outfile returns string\r
 219     local string l_sRemoteEngine l_sFile l_sOpts l_sReturn\r
 220     local string l_iThrow l_iFileSize\r
 221     \r
 222     move (trim(engine)) to engine\r
 223     move (trim(source)) to source\r
 224     move (trim(stylesheet)) to stylesheet\r
 225     move (trim(params)) to params\r
 226     move (trim(outfile)) to outfile\r
 227     move "" to l_sReturn \r
 228     \r
 229     // Attempt to keep a copy of the executable locally regardless of location\r
 230     if not (g_bMsxslPresent) begin\r
 231         if (does_exist(engine) = 1) begin\r
 232             if (does_exist(g_sMsxslEngine) = 0) begin\r
 233                 move (fileopp("copy",engine,g_sMsxslEngine)) to l_iThrow\r
 234                 if (l_iThrow <> 0) move engine to g_sMsxslEngine\r
 235             end\r
 236             indicate g_bMsxslPresent true\r
 237         end\r
 238         else indicate g_bMsxslPresent false\r
 239     end\r
 240     \r
 241     if (g_bMsxslPresent) begin\r
 242         if (outfile = "") move (trim(cstring(get_local_temp(0)))+"msxsl."+(create_guid())) to l_sFile\r
 243         else move outfile to l_sFile\r
 244     \r
 245         if ((source <> "") and (does_exist(source) = 1) and (stylesheet <> "") and (does_exist(stylesheet) = 1)) begin\r
 246             move (source+" "+stylesheet+" -o "+l_sFile) to l_sOpts\r
 247             if (params <> "") append l_sOpts " " params\r
 248             move (create_proc(g_sMsxslEngine+" "+l_sOpts,0,0,0)) to l_iThrow\r
 249 \r
 250             if (outfile = "") begin\r
 251                 move (file_size_bytes(l_sFile)) to l_iFileSize\r
 252                 direct_input channel DEFAULT_FILE_CHANNEL l_sFile\r
 253                     read_block channel DEFAULT_FILE_CHANNEL l_sReturn l_iFileSize\r
 254                 close_input channel DEFAULT_FILE_CHANNEL\r
 255                 move (fileopp("delete",l_sFile,"")) to l_iThrow\r
 256             end\r
 257             else move outfile to l_sReturn\r
 258         end\r
 259     end\r
 260     \r
 261     function_return l_sReturn\r
 262 end_function\r
 263 \r
 264 // Check if a string looks like a valid dataflex number\r
 265 //True\r
 266 // showln (is_number("99999999999999.99999999")) (is_number("-99999999999999.99999999"))\r
 267 // showln (is_number("99999999999999.0")) (is_number("0")) (is_number("-0")) (is_number("100"))\r
 268 //False\r
 269 // showln (is_number("99999999999999.999999999")) (is_number("-999999999999999.99999999"))\r
 270 // showln (is_number("999999999999999.99999999")) (is_number("1-0")) (is_number(".0D"))\r
 271 // showln (is_number("")) (is_number("-")) (is_number("100A")) (is_number("A100"))\r
 272 function is_number global string argv returns integer\r
 273     local integer l_iChar l_iDec l_iNum l_iLen l_i l_iNeg\r
 274         \r
 275     move 0 to l_iNum    \r
 276     move 0 to l_iDec\r
 277     \r
 278     // Is the value negative\r
 279     if (ascii(mid(argv,1,1)) = 45);\r
 280         move 1 to l_iNeg\r
 281     else;\r
 282         move 0 to l_iNeg\r
 283     \r
 284     move (length(argv)) to l_iLen\r
 285     \r
 286     // Check basic length conforms to number\r
 287     if ((l_iLen-L_iNeg = 0) or (l_iLen-l_iNeg > 23)) function_return 0\r
 288     \r
 289     //Check for non numerics\r
 290     for l_i from (1+l_iNeg) to l_iLen\r
 291         move (ascii(mid(argv,1,l_i))) to l_iChar\r
 292         if ((l_iChar = 46) and ((l_iDec = 1) or (l_i > 15+l_iNeg))) break\r
 293         if not ((l_iChar >= 48) and (l_iChar <= 57) or (l_iChar = 46)) break                        \r
 294         if (l_iChar = 46);\r
 295             move 1 to l_iDec\r
 296         increment l_iNum\r
 297     loop\r
 298     \r
 299     function_return ((l_iNum+l_iNeg) = l_iLen)\r
 300 end_function\r
 301 \r
 302 \r
 303 // Check if a string looks like a valid dataflex integer\r
 304 //True\r
 305 // showln (is_integer("2147483647")) (is_integer("2147483638")) \r
 306 // showln (is_integer("-2147483647")) (is_integer("-2147483648")) \r
 307 // showln (is_integer("0")) (is_integer("-0"))\r
 308 //False\r
 309 // showln (is_integer("214748364 ")) (is_integer("2147483648")) (is_integer("2947483647"))\r
 310 // showln (is_integer("-2147483649")) (is_integer("21474836478")) (is_integer("21474836470"))\r
 311 // showln (is_integer("-21474836470")) (is_integer("214748364A")) (is_integer("-A"))\r
 312 // showln (is_integer("-214748364A")) (is_integer("-")) (is_integer("-21474B364P"))\r
 313 function is_integer global string argv returns integer\r
 314     local integer l_iChar l_iInt l_iLen l_i l_iNeg \r
 315     \r
 316     move 0 to l_iInt\r
 317     move (length(argv)) to l_iLen\r
 318     \r
 319     //Is the value negative\r
 320     if (ascii(mid(argv,1,1)) = 45);\r
 321         move 1 to l_iNeg\r
 322     else;\r
 323         move 0 to l_iNeg    \r
 324     \r
 325     // Check basic length conforms to integer\r
 326     if ((l_iLen-L_iNeg = 0) or (l_iLen-l_iNeg > 10)) function_return 0  \r
 327     \r
 328     //Check for non numerics\r
 329     for l_i from (1+l_iNeg) to l_iLen\r
 330         move (ascii(mid(argv,1,l_i))) to l_iChar\r
 331         if not ((l_iChar >= 48) and (l_iChar <= 57)) break\r
 332         increment l_iInt\r
 333     loop\r
 334 \r
 335     //Check for 32 bit signed integer bounds\r
 336     if ((l_iLen-l_iNeg = 10) and ((l_iInt+l_iNeg) = l_iLen)) begin              \r
 337         if (integer(mid(argv,9,1+l_iNeg)) > 214748364);\r
 338             function_return 0\r
 339         if (integer(mid(argv,9,1+l_iNeg)) = 214748364) begin        \r
 340             if (integer(mid(argv,1,10+l_iNeg)) > 7+l_iNeg);\r
 341                 function_return 0\r
 342         end\r
 343     end\r
 344         \r
 345     function_return ((l_iInt+l_iNeg) = l_iLen)\r
 346 end_function\r
 347 \r
 348 //-------------------------------------------------------------------------\r
 349 // Classes\r
 350 //-------------------------------------------------------------------------\r
 351 \r
 352 // String tokenizer class\r
 353 //\r
 354 // Send message methods:\r
 355 //    set_string <string> <delimiter>   - Send the string to be tokenized and the delimiter to split on\r
 356 //    set_string_csv <string>           - Send a CSV string to be tokenized. As per general CSV data:\r
 357 //                                          * Items containting commas to be enclosed in double quotes:  '"'\r
 358 //                                          * Double quotes in quotes to be escaped with a backslash:    '\'\r
 359 //                                          \r
 360 // Set methods:\r
 361 //    token_value \r
 362 //\r
 363 // Get methods:\r
 364 //    token_value \r
 365 //    token_count\r
 366 //    next_token\r
 367 //    token_ptr\r
 368 //\r
 369 // Example usage:\r
 370 //\r
 371 //    object myToken is a StringTokenizer\r
 372 //    end_object\r
 373 //\r
 374 //    send set_string to (myToken(current_object)) tmp ","\r
 375 //\r
 376 //    get token_count of (myToken(current_object)) to x\r
 377 //\r
 378 //    for i from 0 to x\r
 379 //        get token_value of (myToken(current_object)) item i to buf\r
 380 //        showln buf\r
 381 //    loop\r
 382 //\r
 383 //    repeat\r
 384 //        get next_token of (myToken(current_object)) to buf\r
 385 //        showln buf\r
 386 //        get token_ptr of (myToken(current_object)) to i\r
 387 //    until (i = -1)\r
 388 \r
 389 class StringTokenizer is an array\r
 390     procedure construct_object integer argc\r
 391             forward send construct_object\r
 392             property integer c_iTokens public argc\r
 393             property integer c_iTokenOn\r
 394     end_procedure\r
 395 \r
 396     procedure set_string string inString string inSep\r
 397         local integer l_iTokens l_iPos l_iPad\r
 398         local string l_01tmpStr l_02tmpStr\r
 399 \r
 400         move -1 to l_iTokens\r
 401         move (trim(inString)) to l_01tmpStr\r
 402         move (length(inSep)) to l_iPad\r
 403         move 2 to l_iPos\r
 404         \r
 405         while (l_01tmpStr <> "") \r
 406             if (inSep <> "") move (pos(inSep,l_01tmpStr)) to l_iPos\r
 407                 \r
 408             move (left(l_01tmpStr, (l_iPos-1))) to l_02tmpStr\r
 409             if (l_01tmpStr = l_02tmpStr) move "" to l_01tmpStr\r
 410             else move (right(l_01tmpStr,length(l_01tmpStr)-(l_iPos+l_iPad-1))) to l_01tmpStr\r
 411 \r
 412             increment l_iTokens\r
 413             forward set array_value item l_iTokens to l_02tmpStr\r
 414         end \r
 415     \r
 416         set c_iTokenOn to 0\r
 417         set c_iTokens to l_iTokens\r
 418     end_procedure\r
 419     \r
 420     procedure set_string_csv string argv    \r
 421         local integer l_i l_iQuot l_iTokens\r
 422         local string l_sChar l_sLast l_sNext l_sBuf\r
 423         \r
 424         move -1 to l_iTokens\r
 425         move 0 to l_iQuot\r
 426         move "" to l_sLast\r
 427         \r
 428         for l_i from 0 to (length(argv))\r
 429             move (mid(argv,1,l_i)) to l_sChar\r
 430             move (mid(argv,1,l_i+1)) to l_sNext\r
 431             move (mid(argv,1,l_i-1)) to l_sLast     \r
 432             \r
 433             if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '"')) break begin\r
 434             if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '\')) break begin\r
 435             \r
 436             if ((l_sChar = '"') and (l_sLast <> '\')) begin\r
 437                 if (l_iQuot) move 0 to l_iQuot\r
 438                 else move 1 to l_iQuot\r
 439             end\r
 440             if ((l_sChar = '"') and (l_sLast <> '\')) break begin       \r
 441             \r
 442             if ((l_sChar = ',') and not (l_iQuot)) begin\r
 443                 //fwd to Array\r
 444                 increment l_iTokens\r
 445                 forward set array_value item l_iTokens to l_sBuf\r
 446                 move "" to l_sBuf\r
 447             end\r
 448             if ((l_sChar = ',') and not (l_iQuot)) break begin\r
 449             \r
 450             append l_sBuf l_sChar\r
 451         loop\r
 452         \r
 453         //fwd to Array\r
 454         increment l_iTokens     \r
 455         forward set array_value item l_iTokens to l_sBuf\r
 456 \r
 457         set c_iTokenOn to 0     \r
 458         set c_iTokens to l_iTokens\r
 459     end_procedure    \r
 460 \r
 461     procedure set token_value integer itemx string val\r
 462         forward set array_value item itemx to val\r
 463     end_procedure\r
 464 \r
 465     function token_value integer itemx returns string\r
 466         local string l_sBuf                \r
 467         forward get string_value item itemx to l_sBuf\r
 468         function_return l_sBuf\r
 469     end_function \r
 470 \r
 471     function next_token returns string\r
 472         local string l_sBuf\r
 473         local string l_iTokenOn l_iTokens\r
 474         \r
 475         get c_iTokenOn to l_iTokenOn                \r
 476         get c_iTokens to l_iTokens\r
 477         forward get string_value item l_iTokenOn to l_sBuf\r
 478         \r
 479         if (l_iTokenOn < l_iTokens) set c_iTokenOn to (l_iTokenOn+1)\r
 480         else set c_iTokenOn to -1\r
 481         function_return l_sBuf\r
 482     end_function \r
 483 \r
 484     function token_ptr returns integer\r
 485         local integer l_iTokenOn\r
 486         get c_iTokenOn to l_iTokenOn\r
 487         function_return l_iTokenOn\r
 488     end_function\r
 489     \r
 490     function token_count returns integer\r
 491         local integer l_iTokens\r
 492         get c_iTokens to l_iTokens\r
 493         function_return l_iTokens\r
 494     end_function\r
 495 end_class\r