home *** CD-ROM | disk | FTP | other *** search
/ Best Objectech Shareware Selections / UNTITLED.iso / boss / data / dbas / 004 / strings.prg < prev    next >
Encoding:
Text File  |  1992-08-31  |  43.1 KB  |  1,214 lines
  1. *-------------------------------------------------------------------------------
  2. *-- Program...: STRINGS.PRG
  3. *-- Programmer: Ken Mayer (KENMAYER)
  4. *-- Date......: 08/31/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: README.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. FUNCTION Plural
  776. *-------------------------------------------------------------------------------
  777. *-- Programmer..: Kelvin Smith (KELVIN)
  778. *-- Date........: 08/27/1992
  779. *-- Notes.......: Returns number in string form, and pluralized form of
  780. *--               noun, including converting "y" to "ies", unless the "y"
  781. *--               is preceded by a vowel.  Works with either upper or lower
  782. *--               case nouns (based on last character).
  783. *--                  As no doubt all are aware, English includes many
  784. *--               irregular plural forms; to trap for all is not worthwhile
  785. *--               (how often do you really need to print out die/dice?).
  786. *--               This should handle the vast majority of needs.
  787. *-- Written for.: dBASE IV, 1.5
  788. *-- Rev. History: 08/27/1992 1.0 - Original version
  789. *-- Calls.......: None
  790. *-- Called by...: Any
  791. *-- Usage.......: Plural(<nCnt>, <cNoun>)
  792. *-- Examples....: Plural(1, "flag")    returns "1 flag"
  793. *--               Plural(0, "store")   returns "0 stores"
  794. *--               Plural(5, "COMPANY") returns "5 COMPANIES"
  795. *-- Returns.....: String with number and noun, no trailing spaces
  796. *-- Parameters..: nCnt  = Count value for noun (how many of cNoun?)
  797. *--               cNoun = Noun to pluralize
  798. *-------------------------------------------------------------------------------
  799.  
  800.    parameters nCnt, cNoun
  801.    private cNounOut, cLast, c2Last, cLast2, lUpper
  802.  
  803.    if nCnt = 1
  804.       cNounOut = trim(cNoun)
  805.    else
  806.       cNounOut = trim(cNoun)          && No trailing spaces
  807.       cLast = right(cNounOut, 1)
  808.       lUpper = isupper(cLast)         && Upper case?
  809.       cLast = upper(cLast)
  810.       c2Last = upper(substr(cNounOut, len(cNounOut) - 1, 1))
  811.       cLast2 = c2Last + cLast
  812.  
  813.       * If the noun ends in "Y", normally we change "Y" to "IES".
  814.       * However, if the "Y" is preceded by a vowel, just add "S".
  815.       if cLast = "Y" .and. at(c2Last, "AEIOU") = 0
  816.          cNounOut = left(cNounOut, len(cNounOut) - 1) +;
  817.                     iif(lUpper, "IES", "ies")
  818.       else
  819.          if cLast = "S" .or. cLast = "X" ;
  820.                         .or. cLast2 = "CH" .or. cLast2 = "SH"
  821.             cNounOut = cNounOut + iif(lUpper, "ES", "es")
  822.          else
  823.             cNounOut = cNounOut + iif(lUpper, "S", "s")
  824.          endif
  825.       endif
  826.    endif
  827.  
  828. RETURN ltrim(str(nCnt)) + " " + cNounOut
  829. *-- EoF: Plural()
  830.  
  831. FUNCTION StrComp
  832. *-------------------------------------------------------------------------------
  833. *-- Programmer..: Sri Raju (Borland Technical Support)
  834. *-- Date........: 08/xx/1992
  835. *-- Notes.......: From Technotes, August, 1992, "Strings and Things"
  836. *--               This function compares the contents of two strings.
  837. *--               If cStr1 is less than cStr2, return -1
  838. *--               If cStr1 is equal to  cStr2, return 0
  839. *--               If cStr1 is greaterh than cStr2, return 1
  840. *-- Written for.: dBASE IV, 1.5
  841. *-- Rev. History: None
  842. *-- Calls.......: None
  843. *-- Called by...: Any
  844. *-- Usage.......: StrComp(<cStr1>,<cStr2>)
  845. *-- Example.....: ? StrComp("TEST","TEXT")
  846. *-- Returns.....: Numeric (see notes)
  847. *-- Parameters..: cStr1 = First string
  848. *--               cStr2 = Second string
  849. *-------------------------------------------------------------------------------
  850.     
  851.     parameters cStr1,cStr2
  852.     
  853.     cExact = set("EXACT")
  854.     set exact on
  855.     
  856.     do case
  857.         case cStr1 = cStr2
  858.             nReturn = 0
  859.         case cStr1 > cStr2
  860.             nReturn = 1
  861.         case cStr1 < cStr2
  862.             nReturn = -1
  863.     endcase
  864.     
  865.     set exact &cExact
  866.  
  867. RETURN nReturn
  868. *-- EoF: StrComp()
  869.  
  870. FUNCTION StrOccur
  871. *-------------------------------------------------------------------------------
  872. *-- Programmer..: Sri Raju (Borland Technical Support)
  873. *-- Date........: 08/xx/1992
  874. *-- Notes.......: TechNotes, August, 1992, "Strings and Things"
  875. *--               Calculates the number of occurences of a string in another
  876. *--               given character or memo field.
  877. *-- Written for.: dBASE IV, 1.5
  878. *-- Rev. History: None
  879. *-- Calls.......: NumOccur()           Function in STRINGS.PRG
  880. *-- Called by...: Any
  881. *-- Usage.......: StrOccur(<cInString>,<cFindString>)
  882. *-- Example.....: ? StrOccur("NOTES","every")  && find all occurences of "every"
  883. *--                                            && in Memo: NOTES.
  884. *-- Returns.....: Numeric
  885. *-- Parameters..: cInString   = "Large" string -- to be looked "in". If a Memo,
  886. *--                             name of memo field must be in quotes or passed
  887. *--                             as a memvar, and record pointer must be on
  888. *--                             correct record.
  889. *--               cFindString = "Small" string -- to be found in larger string.
  890. *-------------------------------------------------------------------------------
  891.  
  892.     parameters cInString, cFindString
  893.     
  894.     nBytes = 0
  895.     lMemo = .f.
  896.     nReturn = 0
  897.     
  898.     if pCount() # 2   && not enough parameters or too many parameters passed ...
  899.         ?"ERROR. Usage: StrOccur(<string>|<memo fld name>,<string>)"
  900.         RETURN (0)
  901.     endif
  902.     if type("CINSTRING") = "M"
  903.         lMemo = .t.
  904.     else
  905.         RETURN (NumOccur(cInstring,cFindString))
  906.     endif
  907.     
  908.     *-- process a memo ...
  909.     if lMemo
  910.         nTotLen = len(&cInString)
  911.         n = 1
  912.         nOffSet = 0
  913.         cTempStr = " "
  914.         do while nOffSet <= nTotLen
  915.             cTempStr = "arr"+ltrim(str(n))  && ?
  916.             if (nOffSet + 254) > nTotLen
  917.                 cTempStr = substr(&cInString,nOffSet+1,nOffSet+254)
  918.             else
  919.                 cTempStr = substr(&cInString,nOffSet+1,nTotLen)
  920.             endif
  921.             nReturn = nReturn + NumOccur(cTempStr,cFindStr)
  922.             n = n + 1
  923.             nOffSet = nOffSet + 254
  924.         enddo
  925.     endif
  926.  
  927. RETURN (nReturn)
  928. *-- EoF: StrOccur()
  929.  
  930. FUNCTION NumOccur
  931. *-------------------------------------------------------------------------------
  932. *-- Programmer..: Sri Raju (Borland Technical Support)
  933. *-- Date........: 08/xx/1992
  934. *-- Notes.......: TechNotes, August, 1992, "Strings and Things"
  935. *--               Calculates the number of occurences of a string in another
  936. *--               string.
  937. *-- Written for.: dBASE IV, 1.5
  938. *-- Rev. History: None
  939. *-- Calls.......: None
  940. *-- Called by...: StrOccur()           Function in STRINGS.PRG
  941. *-- Usage.......: NumOccur(<cInString>,<cFindString>)
  942. *-- Example.....: ? NumOccur("This is a string","is")
  943. *-- Returns.....: Numeric (integer -- # of times string occurs)
  944. *-- Parameters..: cInString   = "Large" string -- to be looked 'in'
  945. *--               cFindString = "Small" string -- to be looked for
  946. *-------------------------------------------------------------------------------
  947.  
  948.     parameters cInString, cFindString
  949.     
  950.     cHoldStr = " "
  951.     nReturn = 0
  952.     cInit = cInString
  953.     
  954.     do while len(cInit) => 1
  955.         cHoldStr = cInit
  956.         if at(cFindString,cHoldStr) > 0
  957.             nReturn = nReturn + 1
  958.             cInit = substr(cHoldStr,at(cFindString,cHoldStr)+len(cFindString))
  959.         else
  960.             cInit = ""
  961.         endif
  962.     enddo
  963.  
  964. RETURN (nReturn)
  965. *-- EoF: NumOccur()
  966.  
  967. FUNCTION ReplMemo
  968. *-------------------------------------------------------------------------------
  969. *-- Programmer..: Sri Raju (Borland Technical Support)
  970. *-- Date........: 08/xx/1992
  971. *-- Notes.......: TechNotes, August, 1992, "Strings and Things"
  972. *--               Globally searches and replaces a string with another string
  973. *--               in a character field/memvar or memo field.
  974. *-- Written for.: dBASE IV, 1.5
  975. *-- Rev. History: None
  976. *-- Calls.......: MemStuff()           Function in STRINGS.PRG
  977. *-- Called by...: Any
  978. *-- Usage.......: ReplMemo("cSource",<cCurrStr>,<cNewStr>)
  979. *-- Example.....: ?ReplMemo("NOTES","Test","testing")
  980. *-- Returns.....: .T. if a memo field, or character string with changes
  981. *-- Parameters..: cSource  = Source to make changes IN
  982. *--               cCurrStr = Current string (item(s)) to be changed
  983. *--               cNewStr  = Change 'Current' to this ....
  984. *-------------------------------------------------------------------------------
  985.  
  986.     parameters cSource, cCurrStr, cNewStr
  987.     cConsole = set("CONSOLE")
  988.     
  989.     nBytes = 0
  990.     nPointer = 0
  991.     nMaster = 0
  992.     
  993.     *-- error
  994.     if pcount() # 3   && valid number of parms
  995.         ?"Error."
  996.         ?"Usage: ReplMemo(<Memo/string>,<Current String>,<New String>)"
  997.         RETURN .f.
  998.     endif
  999.     
  1000.     *-- start
  1001.     if type(cSource) = "M"                         && if a memo ...
  1002.         if len(&cSource) > 254                      && if > 254 char
  1003.             cNewFile = (cSource)+".TXT"              && create a temp file
  1004.             erase cNewFile
  1005.             nPointer = fcreate(cNewFile,"A")
  1006.         endif
  1007.     else
  1008.         *-- if not a memo, just perform the replace ...
  1009.         RETURN (MemStuff(cSource,cCurrStr,cNewStr))
  1010.     endif
  1011.     
  1012.     *-- memo handling ...
  1013.     nTotLen = len(&cSource)
  1014.     nCounter = 1
  1015.     nOffSet = 0
  1016.     do while nOffSet <= nTotLen
  1017.         cTempStr = "arr"+ltrim(str(nCounter))
  1018.         if (nOffSet+200) < nTotLen
  1019.             cTempStr = substr(&cSource,nOffSet+1,200)
  1020.         else
  1021.             cTempStr = substr(&cSource,nOffSet+1,nTotLen)
  1022.         endif
  1023.         cTemp2 = space(200)
  1024.         cTemp2 = MemStuff(cTempStr, cCurrStr, cNewStr)
  1025.         nBytes = fwrite(nPointer,cTemp2)
  1026.         
  1027.         nCounter = nCounter + 1
  1028.         nOffSet = nOffSet + 200
  1029.     enddo
  1030.     
  1031.     nNull = fclose(nPointer)
  1032.     append memo &cSource) from (newfile) overwrite
  1033.  
  1034. RETURN .T.
  1035. *-- EoF: ReplMemo()
  1036.  
  1037. FUNCTION MemStuff
  1038. *-------------------------------------------------------------------------------
  1039. *-- Programmer..: Sri Raju (Borland Technical Support)
  1040. *-- Date........: 08/xx/1992
  1041. *-- Notes.......: TechNotes, August, 1992, "Strings and Things"
  1042. *--               Replaces a specific string in a character string, by another,
  1043. *--               and returns the resultant string.
  1044. *-- Written for.: dBASE IV, 1.5
  1045. *-- Rev. History: None
  1046. *-- Calls.......: Stub()               Function in STRINGS.PRG
  1047. *-- Called by...: ReplMemo()           Funciton in STRINGS.PRG
  1048. *-- Usage.......: MemStuff(<cSource>,<cCurrStr>,<cNewStr>)
  1049. *-- Example.....: ? MemStuff(cTestStr,"Test","Testing")
  1050. *-- Returns.....: Character
  1051. *-- Parameters..: cSource  = Source to make changes IN
  1052. *--               cCurrStr = Current string (item(s)) to be changed
  1053. *--               cNewStr  = Change 'Current' to this ....
  1054. *-------------------------------------------------------------------------------
  1055.  
  1056.     parameters cSource, cCurrStr, cNewStr
  1057.     private cSource, cCurrStr, cNewStr
  1058.     cRetStr  = ""
  1059.     cHoldStr = ""
  1060.     cInitStr = cSource
  1061.     
  1062.     do while len(cInitStr) => 1
  1063.         cHoldStr = cInitStr
  1064.         if at(cCurrStr,cNewStr) > 0
  1065.             cTemp = substr(cInitStr,1,at(cCurrStr,cHoldStr))
  1066.             nPos  = at(cCurrStr,cHoldStr)
  1067.             cReturn = cReturn+Stub(cTemp,nPos,cNewStr)
  1068.             cInitStr = substr(cHoldStr,at(cReplace,cHoldStr)+len(cNewStr))
  1069.         else
  1070.             cReturn = trim(cInitStr)+trim(cHoldStr)
  1071.             cInitStr = ""
  1072.         endif
  1073.     enddo
  1074.  
  1075. RETURN (cReturn)
  1076. *-- EoF: MemStuff()
  1077.  
  1078. FUNCTION Stub
  1079. *-------------------------------------------------------------------------------
  1080. *-- Programmer..: Sri Raju (Borland Technical Support)
  1081. *-- Date........: 08/xx/1992
  1082. *-- Notes.......: This returns a specific number of characters from the given
  1083. *--               string specified by the parameter innum, added to the
  1084. *--               third parameter.
  1085. *-- Written for.: dBASE IV, 1.5
  1086. *-- Rev. History: None
  1087. *-- Calls.......: None
  1088. *-- Called by...: MemStuff()           Function in STRINGS.PRG
  1089. *-- Usage.......: Stub(<cString>,nIn,<cIn>)
  1090. *-- Example.....: ? Stub(cTest,5,"Test")
  1091. *-- Returns.....: Character
  1092. *-- Parameters..: cString = Character string to look in
  1093. *--               nIn     = # of characters to return
  1094. *--               cIn     = characters to add to the end of ...
  1095. *-------------------------------------------------------------------------------
  1096.  
  1097.     parameters cString, nIn, cIn
  1098.  
  1099. RETURN trim(substr(cString,1,nIn-1)+cIn)
  1100. *-- EoF: Stub()
  1101.  
  1102. FUNCTION FirstMem
  1103. *-------------------------------------------------------------------------------
  1104. *-- Programmer..: Sri Raju (Borland Technical Support)
  1105. *-- Date........: 08/xx/1992
  1106. *-- Notes.......: TechNotes, August, 1992, "Strings and Things"
  1107. *--               Capitalizes the first character of all the words in the string
  1108. *--               that is passed as a parameter, and returns the resultant
  1109. *--               string. If a name of a memo field is pass as the parameter,
  1110. *--               it re-writes the memo field, and returns a .T.
  1111. *-- Written for.: dBASE IV, 1.5
  1112. *-- Rev. History: None
  1113. *-- Calls.......: FirstCap()           Function in STRINGS.PRG
  1114. *-- Called by...: None
  1115. *-- Usage.......: FirstMem(cInStr)
  1116. *-- Example.....: ? FirstMem("this is a string")
  1117. *-- Returns.....: Either character string with first letter of each word
  1118. *--               capitalized, or .T. (if a Memo).
  1119. *-- Parameters..: cInStr = character string or Memo Field name
  1120. *-------------------------------------------------------------------------------
  1121.     
  1122.     parameters cInStr
  1123.  
  1124.     nBytes = 0
  1125.     lMemo = .F.
  1126.     lReturn = .T.
  1127.     nFPtr = 0
  1128.     nMasterCnt = 0
  1129.  
  1130.     if pcount() # 1
  1131.         ? "Error."
  1132.         ? "Usage:- FIRSTMEM (<string>) "
  1133.         lMemo = .F.
  1134.     else
  1135.         if type(instr) = "M"
  1136.             lMemo = .T.
  1137.             cNewFile = (cInStr) + ".txt"
  1138.             erase (cnewfile)
  1139.             nFPtr = fcreate(cNewFile, "A")
  1140.         else
  1141.             lReturn = .F.
  1142.         endif
  1143.     endif
  1144.         
  1145.     if lMemo 
  1146.         nTotLen = len(&CInStr)
  1147.         nCntr = 1
  1148.         nOffSet = 0
  1149.             do while nOffSet <= nTotLen
  1150.                 if (nOffSet + 250) < nTotLen
  1151.                     cTemp = substr(&cInStr, nOffSet + 1, 250)
  1152.                 else
  1153.                     cTemp = substr(&CInStr, nOffSet + 1, nTotLen)
  1154.                 endif
  1155.                 cTempStr = space(250)
  1156.                 cTempStr = FirstCap(cTemp)
  1157.                 nBytes = fwrite(nFPtr, cTempStr)
  1158.                 
  1159.                 nCntr = nCntr + 1
  1160.                 nOffSet = nOffSet + 250
  1161.             enddo
  1162.             x = fclose(nFPtr)
  1163.             append memo &cInStr from (CNewFile) overwrite
  1164.     endif
  1165.  
  1166.     if lMemo .or. lReturn
  1167.         RETURN (.F.)
  1168.     else
  1169.         RETURN (FirstCap(cInStr))
  1170.     endif
  1171. *-- EoF: FirstMem()
  1172.  
  1173. FUNCTION FirstCap
  1174. *-------------------------------------------------------------------------------
  1175. *-- Programmer..: Sri Raju (Borland Technical Support)
  1176. *-- Date........: 08/xx/1992
  1177. *-- Notes.......: TechNotes, August, 1992, "Strings and Things"
  1178. *--               Capitalizes the first character of a string.
  1179. *-- Written for.: dBASE IV, 1.5
  1180. *-- Rev. History: None
  1181. *-- Calls.......: None
  1182. *-- Called by...: FirstMem()           Function in STRINGS.PRG
  1183. *-- Usage.......: FirstCap(<cInString>) 
  1184. *-- Example.....: ?FirstCap("stringofcharacters")
  1185. *-- Returns.....: String with first character captilized.
  1186. *-- Parameters..: cInString = String to cap the first letter of
  1187. *-------------------------------------------------------------------------------
  1188.  
  1189.     parameters cInString
  1190.     cRetString = ""
  1191.     cIStr = cInString
  1192.  
  1193.     do while len(cIStr) > 1
  1194.         nPos = at(" ", cIStr) 
  1195.         if nPos <> 0
  1196.             cRetString = cRetString + upper(left(cIStr, 1)) + ;
  1197.                 substr(cIStr, 2, nPos-1)
  1198.         else
  1199.             cRetString = cRetString + upper(left(cIStr, 1)) + substr(cIStr, 2)
  1200.             exit
  1201.         endif
  1202.         do while substr(cIStr, nPos, 1) = " "
  1203.             nPos = nPos + 1
  1204.         enddo
  1205.         cIStr = substr(cIStr, nPos)
  1206.     enddo
  1207.  
  1208. RETURN (cRetString)
  1209. *-- EoF: FirstCap()
  1210.  
  1211. *-------------------------------------------------------------------------------
  1212. *-- EoP: STRINGS.PRG
  1213. *-------------------------------------------------------------------------------
  1214.