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 none 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 //-------------------------------------------------------------------------\r
 265 // Classes\r
 266 //-------------------------------------------------------------------------\r
 267 \r
 268 // String tokenizer class\r
 269 //\r
 270 // Send message methods:\r
 271 //    set_string <string> <delimiter>   - Send the string to be tokenized and the delimiter to split on\r
 272 //    set_string_csv <string>               - Send a CSV string to be tokenized. As per general CSV data:\r
 273 //                                                                                      * Items containting commas to be enclosed in double quotes:  '"'\r
 274 //                                                                                      * Double quotes in quotes to be escaped with a backslash:    '\'\r
 275 //                                                                                      \r
 276 // Set methods:\r
 277 //    token_value \r
 278 //\r
 279 // Get methods:\r
 280 //    token_value \r
 281 //    token_count\r
 282 //    next_token\r
 283 //    token_ptr\r
 284 //\r
 285 // Example usage:\r
 286 //\r
 287 //    object myToken is a StringTokenizer\r
 288 //    end_object\r
 289 //\r
 290 //    send set_string to (myToken(current_object)) tmp ","\r
 291 //\r
 292 //    get token_count of (myToken(current_object)) to x\r
 293 //\r
 294 //    for i from 0 to x\r
 295 //        get token_value of (myToken(current_object)) item i to buf\r
 296 //        showln buf\r
 297 //    loop\r
 298 //\r
 299 //    repeat\r
 300 //        get next_token of (myToken(current_object)) to buf\r
 301 //        showln buf\r
 302 //        get token_ptr of (myToken(current_object)) to i\r
 303 //    until (i = -1)\r
 304 \r
 305 class StringTokenizer is an array\r
 306     procedure construct_object integer argc\r
 307             forward send construct_object\r
 308             property integer c_iTokens public argc\r
 309             property integer c_iTokenOn\r
 310     end_procedure\r
 311 \r
 312     procedure set_string string inString string inSep\r
 313         local integer l_iTokens l_iPos l_iPad\r
 314         local string l_01tmpStr l_02tmpStr\r
 315 \r
 316         move -1 to l_iTokens\r
 317         move (trim(inString)) to l_01tmpStr\r
 318         move (length(inSep)) to l_iPad\r
 319         move 2 to l_iPos\r
 320         \r
 321         while (l_01tmpStr <> "") \r
 322             if (inSep <> "") move (pos(inSep,l_01tmpStr)) to l_iPos\r
 323                 \r
 324             move (left(l_01tmpStr, (l_iPos-1))) to l_02tmpStr\r
 325             if (l_01tmpStr = l_02tmpStr) move "" to l_01tmpStr\r
 326             else move (right(l_01tmpStr,length(l_01tmpStr)-(l_iPos+l_iPad-1))) to l_01tmpStr\r
 327 \r
 328             increment l_iTokens\r
 329             forward set array_value item l_iTokens to l_02tmpStr\r
 330         end \r
 331     \r
 332         set c_iTokenOn to 0\r
 333         set c_iTokens to l_iTokens\r
 334     end_procedure\r
 335     \r
 336         procedure set_string_csv string argv    \r
 337                 local integer l_i l_iQuot l_iTokens\r
 338                 local string l_sChar l_sLast l_sNext l_sBuf\r
 339                 \r
 340                 move -1 to l_iTokens\r
 341                 move 0 to l_iQuot\r
 342                 move "" to l_sLast\r
 343                 \r
 344                 for l_i from 0 to (length(argv))\r
 345                         move (mid(argv,1,l_i)) to l_sChar\r
 346                         move (mid(argv,1,l_i+1)) to l_sNext\r
 347                         move (mid(argv,1,l_i-1)) to l_sLast             \r
 348                         \r
 349                         if ((l_iQuot) and (l_sChar = '\') and (l_sNext = '"')) break begin\r
 350                         \r
 351                         if ((l_sChar = '"') and (l_sLast <> '\')) begin\r
 352                                 if (l_iQuot) move 0 to l_iQuot\r
 353                                 else move 1 to l_iQuot\r
 354                         end\r
 355                         if ((l_sChar = '"') and (l_sLast <> '\')) break begin           \r
 356                         \r
 357                         if ((l_sChar = ',') and not (l_iQuot)) begin\r
 358                                 //fwd to Array\r
 359                                 increment l_iTokens\r
 360                                 forward set array_value item l_iTokens to l_sBuf\r
 361                                 move "" to l_sBuf\r
 362                         end\r
 363                         if ((l_sChar = ',') and not (l_iQuot)) break begin\r
 364                         \r
 365                         append l_sBuf l_sChar\r
 366                 loop\r
 367                 \r
 368                 //fwd to Array\r
 369                 increment l_iTokens             \r
 370                 forward set array_value item l_iTokens to l_sBuf\r
 371 \r
 372                 set c_iTokenOn to 0             \r
 373         set c_iTokens to l_iTokens\r
 374         end_procedure    \r
 375 \r
 376     procedure set token_value integer itemx string val\r
 377         forward set array_value item itemx to val\r
 378     end_procedure\r
 379 \r
 380     function token_value integer itemx returns string\r
 381         local string l_sBuf                \r
 382         forward get string_value item itemx to l_sBuf\r
 383         function_return l_sBuf\r
 384     end_function \r
 385 \r
 386     function next_token returns string\r
 387         local string l_sBuf\r
 388         local string l_iTokenOn l_iTokens\r
 389         \r
 390         get c_iTokenOn to l_iTokenOn                \r
 391         get c_iTokens to l_iTokens\r
 392         forward get string_value item l_iTokenOn to l_sBuf\r
 393         \r
 394         if (l_iTokenOn < l_iTokens) set c_iTokenOn to (l_iTokenOn+1)\r
 395         else set c_iTokenOn to -1\r
 396         function_return l_sBuf\r
 397     end_function \r
 398 \r
 399     function token_ptr returns integer\r
 400         local integer l_iTokenOn\r
 401         get c_iTokenOn to l_iTokenOn\r
 402         function_return l_iTokenOn\r
 403     end_function\r
 404     \r
 405     function token_count returns integer\r
 406         local integer l_iTokens\r
 407         get c_iTokens to l_iTokens\r
 408         function_return l_iTokens\r
 409     end_function\r
 410 end_class\r