home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / xbase / library / dbase / duflp / strings.prg < prev    next >
Text File  |  1992-06-25  |  29KB  |  778 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: STRINGS.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 06/25/1992
  5. *-- Notes.....: String manipulation routines -- These routines are all designed
  6. *--             to handle the processing of "Strings" (Character Strings).
  7. *--             They range from simple checking of the location of a string 
  8. *--             inside another, to reversing the contents of a string ... 
  9. *--             and lots more. See the file: REAME.TXT for details on use
  10. *--             of this (and the other) library file(s).
  11. *-------------------------------------------------------------------------------
  12.  
  13. FUNCTION Proper
  14. *-------------------------------------------------------------------------------
  15. *-- Programmer..: Clinton L. Warren (VBCES)
  16. *-- Date........: 07/10/1991
  17. *-- Notes.......: Returns cBaseStr converted to proper case.  Converts
  18. *--               "Mc", "Mac", and "'s" as special cases.  Inspired by
  19. *--               A-T's CCB Proper function.  cBaseStr isn't modified.
  20. *-- Written for.: dBASE IV, 1.1
  21. *-- Rev. History: 07/10/1991 1.0 - Original version (VBCES/CLW)
  22. *-- Calls.......: None
  23. *-- Called by...: Any
  24. *-- Usage.......: Proper(<cBaseStr>)
  25. *-- Example.....: Proper("mcdonald's") returns "McDonald's"
  26. *-- Returns.....: Propertized string (e.g. "Test String")
  27. *-- Parameters..: cBaseStr = String to be propertized
  28. *-------------------------------------------------------------------------------
  29.  
  30.     PARAMETERS cBaseStr
  31.     private nPos, cDeli, cWrkStr
  32.  
  33.     cWrkStr = lower(cBaseStr) + ' '             && space necessary for 's process
  34.  
  35.     nPos = at('mc', cWrkStr)                    && "Mc" handling
  36.     do while nPos # 0
  37.        cWrkStr = stuff(cWrkStr, nPos, 3, upper(substr(cWrkStr, nPos, 1)) ;
  38.                 + lower(substr(cWrkStr, nPos + 1, 1)) ;
  39.                 + upper(substr(cWrkStr, nPos + 2, 1)))
  40.         nPos = at('mc', cWrkStr)
  41.       enddo
  42.  
  43.     nPos = at('mac', cWrkStr)                    && "Mac" handling
  44.     do while nPos # 0
  45.        cWrkStr = stuff(cWrkStr, nPos, 4, upper(substr(cWrkStr, nPos, 1)) ;
  46.                                 + lower(substr(cWrkStr, nPos + 1, 2)) ;
  47.                                 + upper(substr(cWrkStr, nPos + 3, 1)))
  48.         nPos = at('mac', cWrkStr)
  49.     enddo
  50.  
  51.     cWrkStr = stuff(cWrkStr, 1, 1, upper(substr(cWrkStr, 1, 1)))
  52.     nPos = 2
  53.     cDeli = [ -.'"\/`]                           && standard delimiters
  54.  
  55.     do while nPos <= len(cWrkStr)                && 'routine' processing
  56.         if substr(cWrkStr,nPos-1,1) $ cDeli
  57.           cWrkStr = stuff(cWrkStr, nPos, 1, upper(substr(cWrkStr,nPos,1)))
  58.         endif
  59.         nPos = nPos + 1
  60.     enddo
  61.  
  62.     nPos = at("'S ", cWrkStr)                    && 's processing
  63.     do while nPos # 0
  64.         cWrkStr = stuff(cWrkStr, nPos, 2, lower(substr(cWrkStr, nPos, 2)))
  65.         nPos = at('mac', cWrkStr)
  66.     enddo
  67.  
  68. RETURN (cWrkStr)
  69. *-- EoF: Proper()
  70.  
  71. FUNCTION Justify
  72. *-------------------------------------------------------------------------------
  73. *-- Programmer..: Roland Bouchereau (Ashton-Tate)
  74. *-- Date........: 12/17/1991
  75. *-- Notes.......: Used to pad a field/string on the right, left or both,
  76. *--               justifying or centering it within the length specified.
  77. *--               If the length of the string passed is greater than
  78. *--               the size needed, the function will truncate it. 
  79. *--               Taken from Technotes, June 1990. Defaults to Left Justify
  80. *--               if invalid TYPE is passed ...
  81. *-- Written for.: dBASE IV, 1.0
  82. *-- Rev. History: Original function 06/15/1991/
  83. *--               12/17/1991 -- Modified into ONE function from three by
  84. *--               Ken Mayer, added a third parameter to handle that.
  85. *-- Calls.......: None
  86. *-- Called by...: Any
  87. *-- Usage.......: Justify(<cFld>,<nLength>,"<cType>")
  88. *-- Example.....: ?? Justify(Address,25,"R")
  89. *-- Returns.....: Padded/truncated field
  90. *-- Parameters..: cFld    =  Field/Memvar/Character String to justify
  91. *--               nLength =  Width to justify within
  92. *--               cType   =  Type of justification: L=Left, C=Center,R=Right
  93. *-------------------------------------------------------------------------------
  94.     
  95.     parameters cFld,nLength,cType
  96.     private cReturn
  97.     
  98.     cType = upper(cType)    && just making sure ...
  99.     if type("cFld")+type("nLength")+type("cType") $ "CNC,CFC"
  100.        *-- set a picture function of 'X's, with @I,@J or @B function
  101.         cReturn = transform(cFld,iif(cType="C","@I ",iif(cType="R","@J ","@B "));
  102.             +replicate("X",max(0,min(nLength,254))))
  103.     else
  104.         cReturn = ""
  105.     endif
  106.  
  107. RETURN cReturn
  108. *-- EoF: Justify()
  109.  
  110. FUNCTION Dots
  111. *-------------------------------------------------------------------------------
  112. *-- Programmer..: Ken Mayer (KENMAYER)
  113. *-- Date........: 12/17/1991
  114. *-- Notes.......: Based on ideas from Technotes, June, 1990 (see JUSTIFY() ),
  115. *--               this function should pad a field or memvar with dots to the
  116. *--               left, right or both sides. Note that if the field is too
  117. *--               large for the length passed (nLength) it will be truncated.
  118. *-- Written for.: dBASE IV, 1.1
  119. *-- Rev. History: None
  120. *-- Calls.......: ALLTRIM()            Function in PROC.PRG
  121. *-- Called by...: Any
  122. *-- Usage.......: Dots(<cFld>,<nLength>,"<cType>")
  123. *-- Example.....: ?? Dots(Address,25,"R")
  124. *-- Returns.....: Field/memvar with dot leader/trailer ...
  125. *-- Parameters..: cFld    =  Field/Memvar/Character String to justify
  126. *--               nLength =  Width to justify within
  127. *--               cType   =  Type of justification: L=Left, C=Center,R=Right
  128. *-------------------------------------------------------------------------------
  129.     
  130.     parameters cFld,nLength,cType
  131.     private cReturn, nVal, nMore
  132.     
  133.     if type("cFld")+type("nLength")+type("cType") $ "CNC,CFC"
  134.     
  135.         cType   = upper(cType)      && just to make sure ...
  136.         cReturn = AllTrim(cFld)     && trim this puppy on all sides
  137.         if len(cReturn) => nLength  && check length against parameter
  138.                                     && truncate if necessary
  139.             cReturn = substr(cReturn,1,nLength)
  140.         endif
  141.         
  142.         do case
  143.             case cType = "L"  && Left -- add trailing dots to field
  144.                 cReturn = cReturn + replicate(".",nLength-len(cReturn))
  145.             case cType = "R"  && Right -- add leading dots to field
  146.                 cReturn = replicate(".",nLength-len(cReturn))+cReturn
  147.             case cType = "C"  && Center -- add 'em to both sides ...
  148.                 nVal = int( (nLength - len(cReturn)) / 2)
  149.                 *-- here, we have to deal with fractions ...
  150.                 nMore = mod(nlength - len(cReturn), 2)
  151.                 *-- add dots on left, field, dots on right (add one if a fraction)
  152.                 cReturn = replicate(".",nVal)+cReturn+;
  153.                           replicate(".",nVal+iif(nMore>0,1,0))
  154.             otherwise         && invalid parameter ... return nothing
  155.                 cReturn = ""
  156.         endcase
  157.     else
  158.         cReturn = ""
  159.     endif
  160.  
  161. RETURN cReturn
  162. *-- EoF: Dots()
  163.  
  164. FUNCTION CutPaste
  165. *-------------------------------------------------------------------------------
  166. *-- Programmer..: Martin Leon (HMAN)
  167. *-- Date........: 03/05/1992
  168. *-- Notes.......: Used to do a cut and paste within a field/character string.
  169. *--               (Taken from an issue of Technotes, can't remember which)
  170. *--               This function will not allow you to overflow the field/char
  171. *--               string -- i.e., if the Paste part of the function would cause
  172. *--               the returned field to be longer than it started out, it will
  173. *--               not perform the cut/paste (STUFF()). For example, if your 
  174. *--               field were 15 characters, and you wanted to replace 5 of them
  175. *--               with a 10 character string:
  176. *--                      (CutPaste(field,"12345","1234567890"))
  177. *--               If this would cause the field returned to be longer than 15,
  178. *--               the function will return the original field.
  179. *-- Written for.: dBASE IV, 1.1
  180. *-- Rev. History: Original function 12/17/1991
  181. *--               03/05/1992 -- minor change to TRIM(cFLD) in the early
  182. *--               bits, solving a minor problem with phone numbers that
  183. *--               Dave Creek (DCREEK) discovered.
  184. *-- Calls.......: None
  185. *-- Called by...: Any
  186. *-- Usage.......: CutPaste(<cFld>,"<cLookFor>","<cRepWith>")
  187. *-- Example.....: Replace all city with CutPaste(City,"L.A.","Los Angeles")
  188. *-- Returns.....: The field with text replaced (or not, if no match is found)
  189. *-- Parameters..: cFld     = Field/Memvar/Expression to replace in 
  190. *--               cLookFor = Item to look for (Cut)
  191. *--               cRepWith = What to replace it with (Paste)
  192. *-------------------------------------------------------------------------------
  193.  
  194.     parameters cFld,cLookFor,cRepWith
  195.     private lMatched,nLookLen,nLen,nRepLen,cRetFld,nTrimLen,nCutAt
  196.     
  197.     *-- Make sure they're all character fields/strings
  198.     if type("cFld")+type("cLookFor")+type("cRepWith") # "CCC"
  199.         RETURN cFld
  200.     endif
  201.     
  202.     lMatched = .f.
  203.     nLookLen = len(cLookFor)  && length of field to look for
  204.     nLen     = len(cFld)      && length of original field
  205.     nRepLen  = len(cRepWith)  && length of field to replace with
  206.     cRetFld  = trim(cFld)     && trim it ... (DCREEK's suggestion)
  207.     
  208.     *-- the loop will allow a cut/paste to occur more than once in the field
  209.     do while at(cLookFor,cRetFld) > 0
  210.         lMatched = .t.
  211.         cRetFld  = trim(cRetFld)
  212.         nTrimLen = len(cRetFld)
  213.         
  214.         *-- the following IF statement prevents the replacement text
  215.         *-- from overflowing the length of the original string ...
  216.         if(nTrimLen - nLookLen) + nRepLen > nLen
  217.             RETURN cRetFld
  218.         endif
  219.         
  220.         *-- here we figure where to "cut" at
  221.         nCutAt = at(cLookFor,cRetFld)
  222.         *-- let's do the paste ... (using dBASE STUFF() function)
  223.         cRetFld = stuff(cRetFld,nCutAt,nLookLen,cRepWith)
  224.     enddo
  225.     
  226.     if .not. lMatched  && no match with cLookFor, return original field
  227.         RETURN cFld
  228.     endif
  229.     
  230. RETURN cRetFld
  231. *-- EoF: CutPaste
  232.  
  233. FUNCTION LastWord
  234. *-------------------------------------------------------------------------------
  235. *-- Programmer..: Martin Leon (HMAN)
  236. *-- Date........: 12/19/1991
  237. *-- Notes.......: Returns the last word in a character string.
  238. *-- Written for.: dBASE IV, 1.1
  239. *-- Rev. History: None
  240. *-- Calls.......: None
  241. *-- Called by...: Any
  242. *-- Usage.......: LastWord("<cString>")
  243. *-- Example.....: ? LastWord("This is a test string") 
  244. *-- Returns.....: The Last word (bracketed with spaces), i.e.:"string"
  245. *-- Parameters..: cString = string to be searched 
  246. *-------------------------------------------------------------------------------
  247.     
  248.     parameters cString
  249.     private cReturn
  250.     
  251.     cReturn = trim(cString)
  252.     do while at(" ",cReturn) # 0
  253.         cReturn = substr(cReturn,at(" ",cReturn)+1)
  254.     enddo
  255.     
  256. RETURN cReturn
  257. *-- EoF: LastWord()
  258.  
  259. FUNCTION VStretch
  260. *-------------------------------------------------------------------------------
  261. *-- Programmer...: Martin Leon (HMAN -- Ashton Tate/Borland BBS)
  262. *-- Date.........: 10/30/91
  263. *-- Notes........: Used to display a long character field, with proper word wrap
  264. *-- Written for..: dBASE IV, 1.1
  265. *-- Rev. History.: Once upon a time, Martin helped me write a more complicated
  266. *--                routine for use in a browse table. He came up with this
  267. *--                much less complex version recently and sent to me via EMail.
  268. *-- Calls........: None
  269. *-- Called by....: Any
  270. *-- Usage........: ?VStretch(<cLFld>,<nULRow>,<nULCol>,<nBRRow>,<nBRCol>)
  271. *-- Example......: ?VStretch(Notes,20,10,24,60,"rg+/gb")
  272. *-- Returns......: ""  (Nul)
  273. *-- Parameters...: cLFld  = Long Field to be wrapped on screen
  274. *--                nULRow = Upper Left Row of window
  275. *--                nULCol = Upper Left Column
  276. *--                nBRRow = Bottom Right Row of window
  277. *--                nBRCol = Bottom Right Column
  278. *-------------------------------------------------------------------------------
  279.  
  280.     parameter cLFld,nULRow,nULCol,nBRRow,nBRCol
  281.     private nWinWidth
  282.     
  283.     nWinWidth = ltrim(str((nBRCol - nULCol)-1,2))
  284.     *-- define window without any border ...
  285.     define window wStretch from nULRow,nULCol to nBRRow,nBRCol none
  286.     activate window wStretch
  287.     *-- make sure window is empty ...
  288.     clear
  289.     *-- display field
  290.     ?? cLFld picture "@V"+nWinWidth at 0  && the @V function causes word wrap
  291.     save screen to sTemp
  292.     activate screen
  293.     release window wStretch
  294.     restore screen from sTemp
  295.     release screen sTemp
  296.  
  297. RETURN ""
  298. *-- EoF: VStretch()
  299.  
  300. FUNCTION AtCount
  301. *-------------------------------------------------------------------------------
  302. *-- Programmer..: Jay Parsons (JPARSONS)
  303. *-- Date........: 03/01/92
  304. *-- Notes.......: returns the number of times FindString is found in Bigstring
  305. *-- Written for.: dBASE IV
  306. *-- Rev. History: None
  307. *-- Calls.......: None
  308. *-- Called by...: Any
  309. *-- Usage.......: AtCount("<cFindStr>","<cBigStr>")
  310. *-- Example.....: ? AtCount("Test","This is a Test string, with Test data")
  311. *-- Returns.....: Numeric value
  312. *-- Parameters..: cFindStr = string to find in cBigStr
  313. *--               cBigStr  = string to look in
  314. *-------------------------------------------------------------------------------
  315.  
  316.     parameters cFindstr, cBigstr
  317.     private cTarget, nCount
  318.     
  319.     cTarget = cBigstr
  320.     nCount = 0
  321.     
  322.     do while .t.
  323.         if at( cFindStr,cTarget ) > 0
  324.             nCount = nCount + 1
  325.             cTarget = substr( cTarget, at( cFindstr, cTarget ) + 1 )
  326.         else
  327.          exit
  328.         endif
  329.     enddo
  330.     
  331. RETURN nCount
  332. *-- EoF: AtCount()
  333.         
  334. FUNCTION IsAlNum
  335. *-------------------------------------------------------------------------------
  336. *-- Programmer..: Jay Parsons (JPARSONS)
  337. *-- Date........: 03/01/92
  338. *-- Notes.......: Returns .T. if the first character of cChar is alphanumeric,
  339. *--               otherwise it is false.
  340. *-- Written for.: dBASE IV
  341. *-- Rev. History: None
  342. *-- Calls.......: None
  343. *-- Called by...: Any
  344. *-- Usage.......: IsAlNum("<cChar>")
  345. *-- Example.....: ? IsAlNum("Test")
  346. *-- Returns.....: Logical
  347. *-- Parameters..: cChar = character string to check for Alphanumeric ...
  348. *-------------------------------------------------------------------------------
  349.  
  350.     parameters cChar
  351.     
  352. RETURN isalpha( cChar ) .or. left( cChar, 1 ) $ "0123456789"
  353. *-- EoF: IsAlNum()
  354.  
  355. FUNCTION IsAscii
  356. *-------------------------------------------------------------------------------
  357. *-- Programmer..: Jay Parsons (JPARSONS)
  358. *-- Date........: 03/01/92
  359. *-- Notes.......: Returns .t. if the first character of cChar is in the lower
  360. *--               half of the ASCII set ( value < 128 )
  361. *-- Written for.: dBASE IV
  362. *-- Rev. History: None
  363. *-- Calls.......: None
  364. *-- Called by...: Any
  365. *-- Usage.......: IsAscii("<cChar>")
  366. *-- Example.....: ? IsAscii("Teststring")
  367. *-- Returns.....: Logical
  368. *-- Parameters..: cChar = string to test
  369. *-------------------------------------------------------------------------------
  370.  
  371.     parameters cChar
  372.     
  373. RETURN asc( cChar ) < 128
  374. *-- EoF: IsAscii()
  375.  
  376. FUNCTION IsCntrl
  377. *-------------------------------------------------------------------------------
  378. *-- Programmer..: Jay Parsons (JPARSONS)
  379. *-- Date........: 03/01/92
  380. *-- Notes.......: Returns .t. if the first character of cChar is a delete,
  381. *--               or a control character.
  382. *-- Written for.: dBASE IV
  383. *-- Rev. History: None
  384. *-- Calls.......: None
  385. *-- Called by...: Any
  386. *-- Usage.......: IsCntrl("<cChar>")
  387. *-- Example.....: ? IsCntrl("Test")
  388. *-- Returns.....: Logical
  389. *-- Parameters..: cChar = string to test
  390. *-------------------------------------------------------------------------------
  391.  
  392.     parameters cChar
  393.     private nCharval
  394.     nCharval = asc(cChar)
  395.     
  396. RETURN nCharval = 127 .or. nCharval < 32
  397. *-- EoF: IsCntrl()
  398.  
  399. FUNCTION IsDigit
  400. *-------------------------------------------------------------------------------
  401. *-- Programmer..: Jay Parsons (JPARSONS)
  402. *-- Date........: 03/01/92
  403. *-- Notes.......: If the first character of cChar is a digit, returns .T.
  404. *-- Written for.: dBASE IV
  405. *-- Rev. History: None
  406. *-- Calls.......: None
  407. *-- Called by...: Any
  408. *-- Usage.......: IsDigit("<cChar>")
  409. *-- Example.....: ? IsDigit("123Test")
  410. *-- Returns.....: Logical
  411. *-- Parameters..: cChar = string to test
  412. *-------------------------------------------------------------------------------
  413.  
  414.     parameters cChar
  415.  
  416. RETURN left( cChar, 1 ) $ "0123456789"
  417. *-- EoF: IsDigit()
  418.  
  419. FUNCTION IsPrint
  420. *-------------------------------------------------------------------------------
  421. *-- Programmer..: Jay Parsons (JPARSONS)
  422. *-- Date........: 03/01/92
  423. *-- Notes.......: Returns .t. if first character of cChar is a printing 
  424. *--               character (space through chr(126) ).
  425. *-- Written for.: dBASE IV
  426. *-- Rev. History: None
  427. *-- Calls.......: None
  428. *-- Called by...: Any
  429. *-- Usage.......: IsPrint("<cChar>")
  430. *-- Example.....: ? IsPrint("Test")
  431. *-- Returns.....: Logical
  432. *-- Parameters..: cChar = string to test
  433. *-------------------------------------------------------------------------------
  434.  
  435.     parameters cChar
  436.     private nCharval
  437.     nCharval = asc(cChar)
  438.     
  439. RETURN nCharval > 31 .and. nCharval < 127
  440. *-- EoF: IsPrint()
  441.  
  442. FUNCTION IsXDigit
  443. *-------------------------------------------------------------------------------
  444. *-- Programmer..: Jay Parsons (JPARSONS)
  445. *-- Date........: 03/01/92
  446. *-- Notes.......: Returns .t. if first character of cChar is a possible
  447. *--               hexidecimal digit.
  448. *-- Written for.: dBASE IV
  449. *-- Rev. History: None
  450. *-- Calls.......: None
  451. *-- Called by...: Any
  452. *-- Usage.......: IsXDigit("<cChar>")
  453. *-- Example.....: ? IsXDigit("F000")
  454. *-- Returns.....: Logical
  455. *-- Parameters..: cChar = string to test
  456. *-------------------------------------------------------------------------------
  457.  
  458.     parameters cChar
  459.     
  460. RETURN left( cChar, 1 ) $ "0123456789ABCDEFabcdef"
  461. *-- EoF: IsXDigit()
  462.  
  463. FUNCTION IsSpace
  464. *-------------------------------------------------------------------------------
  465. *-- Programmer..: Jay Parsons (JPARSONS)
  466. *-- Date........: 03/01/92
  467. *-- Notes.......: Returns .T. if first character of cChar is in set of space,
  468. *--               tab, carriage return, line feed, vertical tab or formfeed,
  469. *--               otherwise .F.  Differs from C function of the same
  470. *--               name in treating chr(141), used as carriage return
  471. *--               in dBASE memo fields, as a space.
  472. *-- Written for.: dBASE IV
  473. *-- Rev. History: None
  474. *-- Calls.......: None
  475. *-- Called by...: Any
  476. *-- Usage.......: IsSpace("<cChar>")
  477. *-- Example.....: ? IsSpace(" Test")
  478. *-- Returns.....: Logical
  479. *-- Parameters..: cChar = string to test
  480. *-------------------------------------------------------------------------------
  481.  
  482.     parameters cChar
  483.     private cSpacestr
  484.     cSpacestr = " "+chr(9)+chr(10)+chr(11)+chr(12)+chr(13)+chr(141)
  485.  
  486. RETURN left( cChar, 1 ) $ cSpacestr
  487. *-- EoF: IsSpace()
  488.  
  489. FUNCTION Name2Label
  490. *-------------------------------------------------------------------------------
  491. *-- Programmer..: Jay Parsons (JPARSONS)
  492. *-- Date........: 03/01/92
  493. *-- Notes.......: Returns a name held in five separate fields or memvars as it
  494. *--               should appear on a label of a given length in characters.
  495. *--               The order of abbreviating is somewhat arbitrary--you may
  496. *--               prefer to remove the suffix before the prefix, or to remove 
  497. *--               both before abbreviating the first name.  This can be 
  498. *--               accomplished by rearranging the CASE statements, which operate 
  499. *--               in the order of their appearance.
  500. *-- Written for.: dBASE IV
  501. *-- Rev. History: None
  502. *-- Calls.......: None
  503. *-- Called by...: Any
  504. *-- Usage.......: Name2Label(<nLength>,"<cPrefix>","<cFirstName>",;
  505. *--                          "<cMidName>","<cLastName>","<cSuffix>")
  506. *-- Example.....: ? Name2Label(20,"The Rev.","Elmore","Norbert","Smedley","III")
  507. *-- Returns.....: Character String, in this case "E. N. Smedley, III"
  508. *-- Parameters..: nLength     = length of label
  509. *--               cPrefix     = Prefix to name, such as Mr., Ms., Dr...
  510. *--               cFirstName  = self explanatory
  511. *--               cMiddleName = self explanatory
  512. *--               cLastName   = self explanatory
  513. *--               cSuffix     = "Jr.", "M.D.", "PhD", etc.
  514. *-------------------------------------------------------------------------------
  515.  
  516.     parameters nLength, cPrefix, cFirstname, cMidname, cLastname, cSuffix
  517.     private cTrypref, cTryfirst, cTrymid, cTrylast, cTrysuff, cTryname
  518.     cTrypref  = ltrim( trim( cPrefix ) )
  519.     cTryfirst = ltrim( trim( cFirstname ) )
  520.     cTrymid   = ltrim( trim( cMidname ) )
  521.     cTrylast  = ltrim( trim( cLastname ) )
  522.     cTrysuff  = ltrim( trim( cSuffix ) )
  523.     do while .t.
  524.       cTryname = cTrylast
  525.       if "" # cTrymid
  526.         cTryname = cTrymid + " " + cTryname
  527.       endif
  528.       if "" # cTryfirst
  529.         cTryname = cTryfirst + " " + cTryname
  530.       endif
  531.       if "" # cTrypref
  532.         cTryname = cTrypref + " " + cTryname
  533.       endif
  534.       if "" # cTrysuff
  535.         cTryname = cTryname + ", " + cTrysuff
  536.       endif
  537.       if len(cTryname) <= nLength
  538.          exit
  539.       endif
  540.       do case
  541.         case "" # cTrymid .AND. right( cTrymid, 1 ) # "."
  542.           cTrymid = left( cTrymid, 1 ) + "."    && convert middle name to initial
  543.         case "" # cTryfirst .AND. right( cTryfirst, 1 ) # "."
  544.           cTryfirst = left( cTryfirst, 1 ) + "." && convert first name to initial
  545.         case "" # cTrypref
  546.           cTrypref = ""                          && drop prefix
  547.         case "" # cTrysuff
  548.           cTrysuff = ""                          && drop suffix
  549.         case "" # cTrymid
  550.           cTrymid = ""                           && drop middle initial
  551.         case "" # cTryfirst
  552.           cTryfirst = ""                         && drop first initial
  553.         otherwise
  554.           cTrylast = left( cTrylast, nLength )   && truncate last name
  555.       endcase
  556.     enddo
  557.     
  558. RETURN cTryName
  559. *-- EoF: Name2Label()
  560.  
  561. FUNCTION StrPBrk
  562. *-------------------------------------------------------------------------------
  563. *-- Programmer..: Jay Parsons (JPARSONS)
  564. *-- Date........: 03/01/92
  565. *-- Notes.......: Search string for first occurrence of any of the
  566. *--               characters in charset.  Returns its position as
  567. *--               with at().  Contrary to ANSI.C definition, returns
  568. *--               0 if none of characters is found.
  569. *-- Written for.: dBASE IV
  570. *-- Rev. History: None
  571. *-- Calls.......: None
  572. *-- Called by...: Any
  573. *-- Usage.......: StrPBrk("<cCharSet>","<cBigStr>")
  574. *-- Example.....: ? StrPBrk("Tt","This is a Test string, with Test data")
  575. *-- Returns.....: Numeric value
  576. *-- Parameters..: cCharSet = characters to look for in cBigStr
  577. *--               cBigStr  = string to look in
  578. *-------------------------------------------------------------------------------
  579.  
  580.     parameters cCharset, cBigstring
  581.     private nPos, nLooklen
  582.     nPos = 0
  583.     nLooklen = len( cBigstring )
  584.     do while nPos < nLooklen
  585.       nPos = nPos + 1
  586.         if at( substr( cBigstring, nPos, 1 ), cCharset ) > 0
  587.          exit
  588.        endif
  589.     enddo
  590.     
  591. RETURN iif(nPos=nLookLen,0,nPos)
  592. *-- EoF: StrPBrk()
  593.  
  594. FUNCTION Rat
  595. *-------------------------------------------------------------------------------
  596. *-- Programmer..: Jay Parsons (JPARSONS)
  597. *-- Date........: 03/01/92
  598. *-- Notes.......: Reverse "at", returns position a character string is last
  599. *--               AT in a larger string.
  600. *-- Written for.: dBASE IV
  601. *-- Rev. History: None
  602. *-- Calls.......: None
  603. *-- Called by...: Any
  604. *-- Usage.......: Rat("<cFindStr>","<cBigStr>")
  605. *-- Example.....: ? Rat("Test","This is a Test string, with Test data")
  606. *-- Returns.....: Numeric value
  607. *-- Parameters..: cFindStr = string to find in cBigStr
  608. *--               cBigStr  = string to look in
  609. *-------------------------------------------------------------------------------
  610.  
  611.     parameters cFindstr, cBigstr
  612.     private nPos,nLen
  613.     nLen = len( cFindstr )
  614.     nPos = len( cBigstr ) - nLen + 1
  615.     do while nPos > 0
  616.         if substr( cBigstr, nPos, nLen ) = cFindstr
  617.             exit
  618.         else
  619.             nPos = nPos - 1
  620.         endif
  621.     enddo
  622.     
  623. RETURN max( nPos, 0 )
  624. *-- EoF: RAt()
  625.  
  626. FUNCTION StrRev
  627. *-------------------------------------------------------------------------------
  628. *-- Programmer..: Jay Parsons (JPARSONS)
  629. *-- Date........: 03/01/92
  630. *-- Notes.......: Reverses a string of characters, returns that reversed string.
  631. *-- Written for.: dBASE IV
  632. *-- Rev. History: None
  633. *-- Calls.......: None
  634. *-- Called by...: Any
  635. *-- Usage.......: StrRev("<cAnyStr>")
  636. *-- Example.....: ? StrRev("This is a Test")
  637. *-- Returns.....: Character string
  638. *-- Parameters..: cAnyStr = String of characters to reverse ...
  639. *-------------------------------------------------------------------------------
  640.  
  641.     parameters cAnystr
  642.     private cRevstring, nX,nY
  643.     nX = len( cAnystr )
  644.     nY = 1
  645.     cRevstring = space( nX )
  646.     do while nX > 0
  647.           cRevstring = stuff(cRevstring,nY,1,substr(cAnyStr,nX,1))
  648.       nY = nY + 1
  649.       nX = nX - 1
  650.     enddo
  651.     
  652. RETURN cRevstring
  653. *-- EoF: StrRev()
  654.  
  655. FUNCTION Strip2Val
  656. *-------------------------------------------------------------------------------
  657. *-- Programmer..: Jay Parsons (JPARSONS)
  658. *-- Date........: 03/01/92
  659. *-- Notes.......: Strip characters from the left of a string until reaching
  660. *--               one that might start a number.
  661. *-- Written for.: dBASE IV
  662. *-- Rev. History: None
  663. *-- Calls.......: None
  664. *-- Called by...: Any
  665. *-- Usage.......: Strip2Val("<cStr>")
  666. *-- Example.....: ? Strip2Val("Test345")
  667. *-- Returns.....: character string
  668. *-- Parameters..: cStr = string to search
  669. *-------------------------------------------------------------------------------
  670.  
  671.     parameters cStr
  672.    private cNew
  673.    cNew = cStr
  674.    do while "" # cNew
  675.       if left( cNew, 1 ) $ "-.0123456789"
  676.          exit
  677.        endif
  678.       cNew = substr( cNew, 2 )
  679.     enddo
  680.     
  681. RETURN cNew
  682. *-- EoF: Strip2Val()
  683.  
  684. FUNCTION StripVal
  685. *-------------------------------------------------------------------------------
  686. *-- Programmer..: Jay Parsons (JPARSONS)
  687. *-- Date........: 03/01/92
  688. *-- Notes.......: Strip characters from the left of the string until
  689. *--               reaching one that is not part of a number.  A hyphen
  690. *--               following numerics, or a second period,
  691. *--               is treated as not part of a number.
  692. *-- Written for.: dBASE IV
  693. *-- Rev. History: None
  694. *-- Calls.......: None
  695. *-- Called by...: Any
  696. *-- Usage.......: StripVal("<cStr>")
  697. *-- Example.....: ? StripVal("123.2Test")
  698. *-- Returns.....: Character
  699. *-- Parameters..: cStr = string to test
  700. *-------------------------------------------------------------------------------
  701.  
  702.     parameters cStr
  703.    private cNew, cChar, lGotminus, lGotdot
  704.    cNew = cStr
  705.    store .f. to lGotminus, lGotdot
  706.    do while "" # cNew
  707.       cChar = left( cNew, 1 )
  708.        do case
  709.           case .not. cChar $ "-.0123456789"
  710.             exit
  711.          case cChar = "-"
  712.              if lGotminus
  713.                exit
  714.             endif
  715.            case cChar = "."
  716.              if lGotdot
  717.                exit
  718.              else
  719.                 lGotdot = .T.
  720.              endif
  721.        endcase
  722.       cNew = substr( cNew, 2 )
  723.        lGotminus = .T.
  724.     enddo
  725.     
  726. RETURN cNew
  727. *-- EoF: StripVal()
  728.  
  729. FUNCTION ParseWord
  730. *-------------------------------------------------------------------------------
  731. *-- Programmer..: Jay Parsons (Jparsons).
  732. *-- Date........: 04/26/1992
  733. *-- Notes.......: returns the first word of a string
  734. *-- Written for.: dBASE IV, 1.1, 1.5
  735. *-- Rev. History: None
  736. *-- Calls       : None
  737. *-- Called by...: Any
  738. *-- Usage.......: ? ParseWord(<cString>)
  739. *-- Example.....: Command = ParseWord( cProgramline )
  740. *-- Parameters..: cString - character string to be stripped.
  741. *-- Returns     : that portion, trimmed on both ends, of the passed string
  742. *--               that includes the characters up to the first interior space.
  743. *-------------------------------------------------------------------------------
  744.    parameters string
  745.    private cW
  746.    cW = trim( ltrim( string ) )
  747.  
  748. RETURN iif( " " $ cW, rtrim( left( cW, at( " ", cW ) - 1 ) ), cW )
  749. *-- EoF: ParseWord()
  750.  
  751. FUNCTION StripWord
  752. *-------------------------------------------------------------------------------
  753. *-- Programmer..: Jay Parsons (Jparsons).
  754. *-- Date........: 04/26/1992
  755. *-- Notes.......: discards first word of a string
  756. *-- Written for.: dBASE IV, 1.1, 1.5
  757. *-- Rev. History: None
  758. *-- Calls       : None
  759. *-- Called by...: Any
  760. *-- Usage.......: ? StripWord(<cString>)
  761. *-- Example.....: Lastname = StripWord( "Carrie Nation" )
  762. *-- Parameters..: cString - character string to be stripped.
  763. *-- Returns     : string trimmed of trailing spaces, and trimmed on the
  764. *--               left to remove leading spaces and, if the passed string
  765. *--               contained interior spaces, also to remove everything before
  766. *--               the first nonspace character after the first interior space.
  767. *-------------------------------------------------------------------------------
  768.    parameters string
  769.    private cW
  770.    cW = trim( ltrim( string ) )
  771.  
  772. RETURN iif( " " $ cW, ltrim( substr( cW, at( " ", cW ) + 1 ) ), cW )
  773. *-- EoF: StripWord()
  774.  
  775. *-------------------------------------------------------------------------------
  776. *-- EoP: STRINGS.PRG
  777. *-------------------------------------------------------------------------------
  778.