1 //-------------------------------------------------------------------------
\r
3 // This file contains some DataFlex 3.2 Console Mode functions
\r
4 // and classes to provide extended string manipulation capabilities.
\r
6 // This file is to be included in df32func.mk
\r
8 // Copyright (c) 2006-2015, glyn@8kb.co.uk
\r
10 // df32func/string.inc
\r
11 //-------------------------------------------------------------------------
\r
13 //-------------------------------------------------------------------------
\r
15 //-------------------------------------------------------------------------
\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
22 move "" to l_01tmpStr
\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
31 append l_01tmpStr (lowercase(mid(argv,(l_01tmpInt-1),2)))
\r
32 trim (mid(argv,(length(argv)),(l_01tmpInt+1))) to argv
\r
36 function_return l_01tmpStr
\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
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
48 function_return argv2
\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
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
59 function_return l_01tmpStr
\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
66 move "" to l_01tmpStr
\r
67 move (repeat(" ",(argv2-(length(trim(argv)))))) to l_01tmpStr
\r
68 append l_01tmpStr (trim(argv))
\r
70 function_return l_01tmpStr
\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
78 move (length(argv)) to l_iLen
\r
79 move "" to l_sReturn
\r
81 for l_i from 0 to l_iLen
\r
82 append l_sReturn (mid(argv,1,l_iLen-l_i))
\r
85 function_return l_sReturn
\r
88 // Standard escaping via C standard.
\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
99 move (replaces("\",argv,"\\")) to l_sReturn
\r
100 #IFDEF NO_BACKSLASH_QUOTE
\r
101 move (replaces("'",l_sReturn,"''")) to l_sReturn
\r
103 move (replaces("'",l_sReturn,"\'")) to l_sReturn
\r
105 move (replaces('"',l_sReturn,'\"')) to l_sReturn
\r
107 function_return l_sReturn
\r
110 // Standard escaping for quoted CSV standard
\r
111 function quotecsv global string argv returns string
\r
112 local string l_sReturn
\r
114 move (replaces('"',argv,'""')) to l_sReturn
\r
116 function_return l_sReturn
\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
124 move (integer(l_iInput)) to l_iReturn
\r
126 function_return l_iReturn
\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
134 move (number(l_nInput)) to l_nReturn
\r
136 function_return l_nReturn
\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
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
151 if (length(l_sInput) <> 0) begin
\r
152 if (l_sLevel = "SQL") move (addslashes(l_sInput)) to l_sReturn
\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
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
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
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
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
196 if (l_iBadScore > 1) begin
\r
197 move "" to l_sReturn
\r
203 move l_sInput to l_sReturn
\r
206 function_return l_sReturn
\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
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
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
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
236 indicate g_bMsxslPresent true
\r
238 else indicate g_bMsxslPresent false
\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
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
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
257 else move outfile to l_sReturn
\r
261 function_return l_sReturn
\r
264 // Check if a string looks like a valid dataflex number
\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
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
278 // Is the value negative
\r
279 if (ascii(mid(argv,1,1)) = 45);
\r
284 move (length(argv)) to l_iLen
\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
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
299 function_return ((l_iNum+l_iNeg) = l_iLen)
\r
303 // Check if a string looks like a valid dataflex integer
\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
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
317 move (length(argv)) to l_iLen
\r
319 //Is the value negative
\r
320 if (ascii(mid(argv,1,1)) = 45);
\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
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
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
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
345 function_return ((l_iInt+l_iNeg) = l_iLen)
\r
348 //-------------------------------------------------------------------------
\r
350 //-------------------------------------------------------------------------
\r
352 // String tokenizer class
\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
371 // object myToken is a StringTokenizer
\r
374 // send set_string to (myToken(current_object)) tmp ","
\r
376 // get token_count of (myToken(current_object)) to x
\r
378 // for i from 0 to x
\r
379 // get token_value of (myToken(current_object)) item i to buf
\r
384 // get next_token of (myToken(current_object)) to buf
\r
386 // get token_ptr of (myToken(current_object)) to i
\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
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
400 move -1 to l_iTokens
\r
401 move (trim(inString)) to l_01tmpStr
\r
402 move (length(inSep)) to l_iPad
\r
405 while (l_01tmpStr <> "")
\r
406 if (inSep <> "") move (pos(inSep,l_01tmpStr)) to l_iPos
\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
412 increment l_iTokens
\r
413 forward set array_value item l_iTokens to l_02tmpStr
\r
416 set c_iTokenOn to 0
\r
417 set c_iTokens to l_iTokens
\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
424 move -1 to l_iTokens
\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
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
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
440 if ((l_sChar = '"') and (l_sLast <> '\')) break begin
\r
442 if ((l_sChar = ',') and not (l_iQuot)) begin
\r
444 increment l_iTokens
\r
445 forward set array_value item l_iTokens to l_sBuf
\r
448 if ((l_sChar = ',') and not (l_iQuot)) break begin
\r
450 append l_sBuf l_sChar
\r
454 increment l_iTokens
\r
455 forward set array_value item l_iTokens to l_sBuf
\r
457 set c_iTokenOn to 0
\r
458 set c_iTokens to l_iTokens
\r
461 procedure set token_value integer itemx string val
\r
462 forward set array_value item itemx to val
\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
471 function next_token returns string
\r
472 local string l_sBuf
\r
473 local string l_iTokenOn l_iTokens
\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
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
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
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