Level Extreme platform
Subscription
Corporate profile
Products & Services
Support
Legal
Français
ALINES() replacement
Message
 
To
05/03/2004 16:59:22
General information
Forum:
Visual FoxPro
Category:
FoxPro 2.x
Miscellaneous
Thread ID:
00883701
Message ID:
00883707
Views:
10
This message has been marked as the solution to the initial question of the thread.
>Hi all,
>
>Does anyone have an "ALINES()" emulator user-defined function for FPD? I'm planning on creating a UDF this coming Monday but would appreciate if someone already did one. Hoping this "wheel" is already invented.
>
>Have a nice weekend to all.


We use this in 2.6, hope it is what you want:
*******************************************************************************
*                                                                             *
* Name         : toarray.prg                                                  *
*                                                                             *
* Description  : Transform a comma separated string to an array               *
*                                                                             *
* Parameters   : marray     - (?) The array where the result will be stored.  *
*                             Should be passed by reference and it will be re-*
*                              dimensioned unless the 2nd parameter is empty, *
*                             in which case this variable remains unchanged.  *
*                   default = [Mandatory]                                     *
*                mstring    - (C) The comma separated String. All text between*
*                              simple or double quotes is treatead like a     *
*                             whole.                                          *
*                             Ex: 'item1,item2' is only one object.           *
*                   default = [Mandatory]                                     *
*                mtrim      - (L) .t. if each element should be trimmed       *
*                   default = .f.                                             *
*                mchar      - (C) The item separator char                     *
*                   default = ','                                             *
*                mignempty  - (L) Flag to ignore empty entries                *
*                   default = .f.                                             *
*                msort      - (L) Flag to sort the array                      *
*                   default = .f.                                             *
*                                                                             *
* Returns      : (N) The dimension of the array.                              *
*                                                                             *
* Tables       : [None]                                                       *
*                                                                             *
* Libraries    : [None]                                                       *
*                                                                             *
* Notes        :                                                              *
*                                                                             *
* Platform     : DOS / WIN                                                    *
*                                                                             *
* Status       : In Use                                                       *
*******************************************************************************

parameters marray, mstring, mtrim, mchar, mignempty, msort

private mpos, malen, mstring, mtalk, mtrim, mposr, maux, mstr, mignempty, msort

if type("marray")="U"
	return 0
endif

if type("mstring")<>"C"
	return 0
endif

if empty(mstring)
	return 0
endif

mtrim=iif(parameters()=3 and type('mtrim')='L', mtrim, .t.)
mchar=iif(type('mchar')='C' and not empty(mchar), left(mchar, 1), ',')
mtalk=set('talk')
set talk off					&& to avoid error messages from substr()
mstring=alltrim(mstring)
malen=0
do while not empty(mstring)
	mpos=xatchar(mstring, "'"+'"'+mchar)		&& Single quote, double quote and separator char
	if mpos<>0 and substr(mstring, mpos, 1)<>mchar
		mposr=at(substr(mstring, mpos, 1), mstring, 2)		&& End of quote
		if mposr<>0
			maux=substr(mstring, mpos, mposr-mpos+1)
			mstring=strtran(mstring, maux, strtran(maux, mchar, chr(1)))
			mpos=at(mchar, mstring)
			maux=strtran(maux, mchar, chr(1))
			mstring=strtran(mstring, maux, strtran(maux, chr(1), mchar))
		else				&& Found sigle quote, proceed normally, like [it's]
			mpos=at(mchar, mstring)
		endif
	endif
	mpos=iif(mpos=0, len(mstring)+1, mpos)
	mstr=iif(mpos=1, '', left(mstring, mpos-1))
	if mignempty and empty(mstr)
	else
		malen=malen+1
		dimension marray(malen)
		if mtrim
			marray[malen]=alltrim(mstr)
		else
			marray[malen]=mstr
		endif
	endif
	mstring=substr(mstring, mpos+1)
enddo
if msort
	=asort(marray)
endif
set talk &mtalk
return malen
"The five senses obstruct or deform the apprehension of reality."
Jorge L. Borges?

"Premature optimization is the root of all evil in programming."
Donald Knuth, repeating C. A. R. Hoare

"To die for a religion is easier than to live it absolutely"
Jorge L. Borges
Previous
Next
Reply
Map
View

Click here to load this message in the networking platform