Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
Serial Number with A-Z
Message
De
19/07/2000 10:44:22
Liam O'Hagan
O'Hagan Programming Ltd
Irlande
 
 
À
18/07/2000 23:15:36
Information générale
Forum:
Visual FoxPro
Catégorie:
Codage, syntaxe et commandes
Divers
Thread ID:
00394168
Message ID:
00394333
Vues:
13
>I need a serial # scheme that works like newid(), But uses Letters as well as numbers. Anyone have some code or know where I can get it.
>Oh i'm using vfp 5
>
> Thanks Kelly


Hi Kelly,

The following 2 functions BaseX2Y and NewCode are ones I use regularly and will, when used together, allow you to generate a unique ID for each record in any number of tables and convert that ID into a different number base.

The number base converter in particular could probably be made a lot tighter with not too much effort, but it works fine for me and and I haven't had time to look at it.


HTH

Liam
* This function accepts 3 parameters 
* 1) The source value, ie the value to convert
* 2) the source base, eg 10 (Decimal). Valid bases are 2 - 62
* 3) the destination base, eg 16 (Hex). Valid bases are 2 - 62
Function BaseX2Y(pSrcValue, pSrcBase, pDestBase)
	Local nCounter, cValArray, cSrcValue, nSrcBase, nDestBase, cDestValue, nDecValue, nPower

	cValArray = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"

	* We must have all 3 parameters
	If Parameters() < 3 Then
		Return ""
	Endif

	* Make sure the Source Base is the correct type and is a valid value
	If Type("pSrcBase") = "N" then
		nSrcBase = int(pSrcBase)
	Else
		nSrcBase = int(val(pSrcBase))
	Endif
	If ! Between(nSrcBase, 2, 62) Then
		Return ""
	Endif

	* Make sure the Source Value is the correct type and contains valid data
	If Type("pSrcValue") = "N" then
		cSrcValue = alltrim(str(int(pSrcValue)))  && Make sure there are no decimal points
	Else
		cSrcValue = alltrim(pSrcValue)
	Endif
	If len(cSrcValue) = 0 Then
		Return ""
	Endif
	* If the source base is <= Base 26 then convert the source value to uppercase
	If (nSrcBase <= 26) Then
		cSrcValue = Upper(cSrcValue)
	Endif
	* Make sure that all chars in the source value are valid chars and that they exist within
	* the range of chars allowed for the source base.
	For nCounter = 1 to len(cSrcValue)
		nTmpPosn = at(substr(cSrcValue, nCounter, 1), cValArray) 
		If (nTmpPosn = 0) or (nTmpPosn > nSrcBase) Then
			Return ""
		Endif
	EndFor
	
	* Make sure the Destination Base is the correct type and is a valid value
	If Type("pDestBase") = "N" then
		nDestBase = int(pDestBase)
	Else
		nDestBase = int(val(pDestBase))
	Endif
	If ! Between(nDestBase, 2, 62) Then
		Return ""
	Endif

	* Convert source value to decimal first
	nDecValue = 0
	nPower = 0
	For nCounter = len(cSrcValue) to 1 Step -1
		nDecValue = nDecValue + (at(Substr(cSrcValue, nCounter, 1), cValArray)-1) * (nSrcBase ^ nPower )
		nPower = nPower + 1
	Endfor

	* Then convert to destination base
	cDestValue = ""
	Do While (nDecValue > 0)
		cDestValue = substr(cValArray, (nDecValue%nDestBase)+1, 1) + cDestValue
			nDecValue = Int(nDecValue/nDestBase)
	Enddo
		
	Return cDestValue
EndFunc








Function NewCode(lc_keyfield, lc_CodeWidth)
	Local ln_OldWorkArea, lc_OldReprocess, lc_NewCode

	If parameters() < 2 Then
		lc_CodeWidth = 10
	Endif

	lc_OldWorkArea = Select()
	lc_OldReprocess = SET('REPROCESS')
	
	SET Reprocess To Automatic
	
	IF !Used("Codes") 
		Use data\Codes in 0
	Endif

	Select Codes

	IF Seek(upper(lc_Keyfield), "Codes", "Key")
		IF RLOCK()
			lc_NewCode = Codes.value
			REPLACE Codes.value with padl(alltrim(str(val(lc_NewCode)+1)), lc_CodeWidth, "0")
			UNLOCK
		Endif
	Else
		m.Key = upper(lc_Keyfield)
		lc_NewCode = Padl("1", lc_CodeWidth, "0")
		m.value = Padl("2", lc_CodeWidth, "0")
		Insert Into Codes from memvar
	Endif

	Select(lc_OldWorkArea)
	SET REPROCESS TO lc_OldReprocess
	
	Return lc_NewCode
EndFunc
Liam O'Hagan
MCP VFP Desktop Apps
Précédent
Répondre
Fil
Voir

Click here to load this message in the networking platform