Category : Dbase (Clipper, FoxBase, etc) Languages Source Code
Archive : NN0505.ZIP
Filename : FOREIGN.PRG
Output of file : FOREIGN.PRG contained in archive : NN0505.ZIP
Function : ForIndex(
Arguments: cStrg => Character String
lOverite => Overwrite/insert normal characters
Default value is FALSE.
IF lOverite == FALSE
Every foreign character will be preceeded by its
English equivalent. This places the sort order
by the ASCII code value - INCLUDING those of the
foreign characters. That is:
Natural Ending Underlying
Order Sort Order ForIndex() Step
======== ========== ===============
FRA FRC FREC
FRD FRB FReB
FRC FRE FReE
FRB FRD FReD
FRE FRA FReA
ELSE
Every foreign character will be replaced by its
English equivalent, hence, the order will only
accomodate for these "replacements", as in:
Natural Ending Underlying
Order Sort Order ForIndex() Step
======== ========== ===============
FRA FRC FREC
FRD FRA FReA
FRC FRB FReB
FRB FRD FReD
FRE FRE FReE
ENDIF
Please note the difference in sort order between the two!
Also, the changes affect the keys in the index file only,
and NOT the dbf file...
Usage: Translates cStrg into an alternate string that
can be indexed properly with the Foreign
character set.
Syntax:
INDEX ON ForIndex(
SEEK ForIndex( < cExp > [, .T. ] )
Notes: cStrg's length will expand if foreign characters
are encountered and lOverite is FALSE.
Return: cNewStrg => Expanded character string
Author: Tony M. (The Terrorist) and the guys at Nantucket Canada.
Date: April 8th, 1991.
*****/
#define cAlowSet " " // The order of the characters
#define cAuppSet "" // in the set is important
#define cClowSet "" // for the ForUpper() UDF
#define cCuppSet "" //
#define cElowSet "" // Small caps should be in the
#define cEuppSet "" // same position as corres-
#define cIlowSet "¡" // ponding Capitals.
#define cNlowSet "¤"
#define cNuppSet "¥"
#define cOlowSet "¢"
#define cOuppSet ""
#define cUlowSet "£"
#define cUuppSet ""
#define cYlowSet ""
#define cForeiSet cAlowSet+cClowSet+cElowSet+;
cIlowSet+cOlowSet+cNlowSet+cUlowSet+cYlowSet+;
cAuppSet+cCuppSet+cEuppSet+cNuppSet+;
cOuppSet+cUuppSet
STATIC FUNCTION ForIndex( cStrg, lOverite )
LOCAL cOldStrg := cStrg,;
nNewLen := LEN((cStrg:=TRIM(cStrg))),;
cNewStrg := "",; // The output string to be indexed
i, char
#define MAXLEN 254 // Max length for character string
lOverite := IIF( lOverite == NIL, .F., lOverite )
IF nNewLen == 0 // Check if Strg is EMPTY
RETURN (cOldStrg)
ENDIF
/*
Check for Foreign characters
*/
FOR i = 1 TO nNewLen
char = SUBS(cStrg,i,1)
IF char $ cForeiSet
IF char $ cAlowSet
char = "a" + char
ELSEIF char == cClowSet
char = "c" + char
ELSEIF char $ cElowSet
char = "e" + char
ELSEIF char $ cIlowSet
char = "i" + char
ELSEIF char == cNlowSet
char = "n" + char
ELSEIF char $ cOlowSet
char = "o" + char
ELSEIF char $ cUlowSet
char = "u" + char
ELSEIF char == cYlowSet
char = "y" + char
ELSEIF char $ cAuppSet
char = "A" + char
ELSEIF char == cCuppSet
char = "C" + char
ELSEIF char == cEuppSet
char = "E" + char
ELSEIF char == cNuppSet
char = "N" + char
ELSEIF char == cOuppSet
char = "O" + char
ELSEIF char == cUuppSet
char = "U" + char
ENDIF
ENDIF
/* IF lOverite is TRUE then only put the first character */
char := IIF( lOverite, LEFT( char, 1 ), char )
/*
Check if the length of the new string is bigger than the
allowed length if yes, just truncate it to nMaxLen
else, add the string char to it.
*/
IF LEN(cNewStrg+char) >= MAXLEN
cNewStrg += LEFT( char, MAXLEN-LEN(cNewStrg) )
EXIT
ELSE
cNewStrg += char
ENDIF
NEXT
RETURN ( cNewStrg )
*************************************************************
*
* Function: ForUpper(
* Parameters: cStrg => Character String
* Description: Translates cStrg into an upper case string.
ASCII table. i.e.: Herv ==> HERV
* Notes:
* Usage: cVar = ForUpper(
* Return: cNewStrg => String in Upper Case
* Author: Tony M. (The Terrorist) Nantucket Canada.
* Date : February 15th, 1991.
*************************************************************
STATIC FUNCTION ForUpper( cStrg )
LOCAL cOldStrg := cStrg,;
nOldLen := LEN(cStrg),;
nNewLen := LEN( ( cStrg:=TRIM( UPPER( cStrg ) ) ) ),;
cNewStrg := "",; // The output string to be indexed
i, char, n1
IF nNewLen == 0 // Check if Strg is EMPTY
RETURN(cOldStrg)
ENDIF
* Check for Foreign characters
FOR i = 1 TO nNewLen
char = SUBSTR(cStrg,i,1)
IF char $ cForeiSet
IF (n1 := AT(char,cAlowSet)) != 0
char = IF(n1>3, "A", SUBS(cAuppSet,n1,1) )
ELSEIF char == cClowSet
char = cCuppSet
ELSEIF (n1 := AT(char,cElowSet)) != 0
char = IF(n1==1, cEuppSet, "E")
ELSEIF char $ cIlowSet
char = "I"
ELSEIF char $ cNlowSet
char = cNuppSet
ELSEIF (n1 := AT(char,cOlowSet)) != 0
char = IF(n1==1, cOuppSet, "O")
ELSEIF (n1 := AT(char,cUlowSet)) != 0
char = IF(n1==1, cUuppSet, "U")
ELSEIF char==cYlowSet
char = "Y"
ENDIF
ENDIF
cNewStrg += char
NEXT
RETURN ( PADR(cNewStrg,nOldLen) )
// EOF: Foreign.prg
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/