;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrTranslateV1 (strString, strTableOut, strTableIn, strPad) ; speed performance = low = 100 pct. If strTableOut == "" Then If strTableIn == "" Then Return StrUpper (strString) If strPad == "" Then strPad = " " hdlBBTable = BinaryAlloc (256) For intI = 0 To 255 BinaryPoke (hdlBBTable, intI, intI) Next intLenString = StrLen (strString) intLenIn = StrLen (strTableIn) strTableOut = StrFix (strTableOut, strPad, intLenIn) intLenOut = StrLen (strTableOut) For intI = 1 To intLenIn BinaryPoke (hdlBBTable, Char2Num (StrSub (strTableIn, intI, 1)), Char2Num (StrSub (strTableOut, intI, 1))) Next strOut = "" For intI = 1 To intLenString strOut = strOut : Num2Char (BinaryPeek (hdlBBTable, Char2Num (StrSub (strString, intI, 1)))) Next BinaryFree (hdlBBTable) Return strOut ;.......................................................................................................................................... ; Detlev Dalitz.20020219. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrTranslateV2 (strString, strTableOut, strTableIn, strPad) ; speed performance = middle = 92..96 pct. If strTableOut == "" Then If strTableIn == "" Then Return StrUpper (strString) If strPad == "" Then strPad = " " hdlBBTable = BinaryAlloc (256) For intI = 0 To 255 BinaryPoke (hdlBBTable, intI, intI) Next intLenString = StrLen (strString) intLenIn = StrLen (strTableIn) strTableOut = StrFix (strTableOut, strPad, intLenIn) intLenOut = StrLen (strTableOut) hdlBBString = BinaryAlloc (intLenString) hdlBBOut = BinaryAlloc (intLenOut) hdlBBIn = BinaryAlloc (intLenIn) BinaryPokeStr (hdlBBString, 0, strString) BinaryPokeStr (hdlBBOut, 0, strTableOut) BinaryPokeStr (hdlBBIn, 0, strTableIn) intlen = intLenIn - 1 For intI = 0 To intlen BinaryCopy (hdlBBTable, BinaryPeek (hdlBBIn, intI), hdlBBOut, intI, 1) Next BinaryXlate (hdlBBString, hdlBBTable, 0) strOut = BinaryPeekStr (hdlBBString, 0, intLenString) BinaryFree (hdlBBTable) BinaryFree (hdlBBString) BinaryFree (hdlBBOut) BinaryFree (hdlBBIn) Return strOut ;.......................................................................................................................................... ; Detlev Dalitz.20020219. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrTranslateV3 (strString, strTableOut, strTableIn, strPad) If strTableOut == "" Then If strTableIn == "" Then Return StrUpper (strString) If strPad == "" Then strPad = " " arrArray = ArrDimension (256) For intI = 0 To 255 arrArray [intI] = intI Next intLenString = StrLen (strString) intLenIn = StrLen (strTableIn) strTableOut = StrFix (strTableOut, strPad, intLenIn) intLenOut = StrLen (strTableOut) For intI = 1 To intLenIn arrArray [Char2Num (StrSub (strTableIn, intI, 1))] = Char2Num (StrSub (strTableOut, intI, 1)) Next strOut = "" For intI = 1 To intLenString strOut = strOut : Num2Char (arrArray [Char2Num (StrSub (strString, intI, 1))]) Next Return strOut ;.......................................................................................................................................... ; Detlev Dalitz.20020219. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrTranslateV4 (strString, strTableOut, strTableIn, strPad) If strTableOut == "" Then If strTableIn == "" Then Return StrUpper (strString) If strPad == "" Then strPad = " " arrT = ArrDimension (256) For intI = 0 To 255 arrT [intI] = intI Next arrS = ArrayFromStr (strString) arrI = ArrayFromStr (strTableIn) arrO = ArrayFromStr (StrFix (strTableOut, strPad, ArrInfo (arrI, 1))) intLast = ArrInfo (arrI, 1) - 1 For intI = 0 To intLast arrT [Char2Num (arrI[intI])] = Char2Num (arrO[intI]) Next intLast = ArrInfo (arrS, 1) - 1 For intI = 0 To intLast arrS[intI] = Num2Char (arrT [Char2Num (arrS[intI])]) Next Return ArrayToStr (arrS) ;.......................................................................................................................................... ; Detlev Dalitz.20100202. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ; Test. GoSub TestFunctionVariants GoSub Test_ROT13 GoSub Test_Remove_Accents GoSub Test_FormatNumberString GoSub Test_Lowcase GoSub Soundex0 GoSub Soundex1 GoSub Performancetest Exit ;========================================================================================================================================== ; GoSub's ;------------------------------------------------------------------------------------------------------------------------------------------ :TestFunctionVariants ;------------------------------------------------------------------------------------------------------------------------------------------ For intDemo = 1 To 4 strMsgTitle = "Demo udfStrTranslateV" : intDemo : " (strString, strTableOut, strTableIn, strPad)" strMsgText = "" strTestItem = 'udfStrTranslateV' : intDemo : ' ("abczyx", "", "", "")' strMsgText = strMsgText : `%strTestItem%` : @TAB : ' = ' : %strTestItem% : " (""ABCZYX"")" : @LF ; ABCZYX strTestItem = 'udfStrTranslateV' : intDemo : ' ("abzyx!", "1234?", "abcd!","")' strMsgText = strMsgText : `%strTestItem%` : @TAB : ' = ' : %strTestItem% : " (""12zyx?"")" : @LF ; 12zyx? strTestItem = 'udfStrTranslateV' : intDemo : ' ("5678/12/34", "mmddyyyy:", "12345678/", "")' strMsgText = strMsgText : `%strTestItem%` : @TAB : ' = ' : %strTestItem% : " (""yyyy:mm:dd"")" : @LF ; yyyy:mm:dd strTestItem = 'udfStrTranslateV' : intDemo : ' ("1.22.333.4", "-", ".0123456789", "?")' strMsgText = strMsgText : `%strTestItem%` : @TAB : ' = ' : %strTestItem% : " (""?-??-???-?"")" : @LF ; ?-??-???-? strTestItem = 'udfStrTranslateV' : intDemo : ' ("1.2.3.4", "-0123456789", ".", "?")' strMsgText = strMsgText : `%strTestItem%` : @TAB : ' = ' : %strTestItem% : " (""1-2-3-4"")" : @LF ; 1-2-3-4 Message (strMsgTitle, strMsgText) Next Return ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ :Performancetest ;------------------------------------------------------------------------------------------------------------------------------------------ strMsgTitle = "Demo udfStrTranslate (strString, strTableOut, strTableIn, strPad) Performance Test" ; strTestItem = '("abcdefg", "", "", "")' strTestItem = '("5678/12/34", "12345678/", "mmddyyyy:", "")' intTestLoop = 20 intTestMin = 1 intTestMax = 4 For intT = intTestMin To intTestMax Display (1, strMsgTitle, "Running Test " : intT : ", please wait ...") Exclusive (@ON) intTicksStart = GetTickCount () For intL = 1 To intTestLoop strResult = udfStrTranslateV%intT% %strTestItem% Next intTicksStop = GetTickCount () Exclusive (@OFF) intTicks%intT% = intTicksStop - intTicksStart Next intTicksMax = 0 For intT = intTestMin To intTestMax intTicksMax = Max (intTicksMax, intTicks%intT%) Next For intT = intTestMin To intTestMax intPct%intT% = 100 * intTicks%intT% / intTicksMax Next strMsgText = "" For intT = intTestMin To intTestMax strMsgText = strMsgText : "Test " : intT : @TAB : "Ticks = " : @TAB : intTicks%intT% : @TAB : intPct%intT% : " %%" : @LF Next Message (strMsgTitle, strMsgText) ClipPut (strMsgText) Return ;------------------------------------------------------------------------------------------------------------------------------------------ ; Test 1 Ticks = 516 100 % ; Test 2 Ticks = 390 75 % ; Test 3 Ticks = 297 57 % ; Test 4 Ticks = 250 48 % <== The winner. ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ :Test_ROT13 ;------------------------------------------------------------------------------------------------------------------------------------------ ; As an alternative to the function "udfStrROT13 (strString)". ;------------------------------------------------------------------------------------------------------------------------------------------ strString = "{[# ABC -- WinBatch rotates *You* -- XYZ !]}" strTableIn = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ" strTableOut = "nopqrstuvwxyzabcdefghijklmNOPQRSTUVWXYZABCDEFGHIJKLM" strPad = "" strROT13 = udfStrTranslateV4 (strString, strTableOut, strTableIn, strPad) ; "# NOP -- JvaOngpu ebgngrf *Lbh* -- KLM !" strROTROT13 = udfStrTranslateV4 (strROT13, strTableOut, strTableIn, strPad) ; "# ABC -- WinBatch rotates *You* -- XYZ !" strMsgText = strString : @LF : strROT13 : @LF : strROTROT13 strMsgTitle = "Demo udfStrTranslate (strString, strTableOut, strTableIn, strPad)" Message (strMsgTitle, strMsgText) Return ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ :Test_Remove_Accents ;------------------------------------------------------------------------------------------------------------------------------------------ strString = "Šêñòr Žž Øçÿ íßt ÑËÜ." strTableIn = "ŠŒŽšœžŸ¥µÀÁÂÃÄÅÆÇÈÉÊËÌÍÎÏÐÑÒÓÔÕÖØÙÚÛÜÝßàáâãäåæçèéêëìíîïðñòóôõöøùúûüýÿ" strTableOut = "SOZsozYYuAAAAAAACEEEEIIIIDNOOOOOOUUUUYsaaaaaaaceeeeiiiionoooooouuuuyy" strPad = "" strTrans = udfStrTranslateV4 (strString, strTableOut, strTableIn, strPad) ; "Senor Zz Ocy ist NEU." strMsgText = strString : @LF : strTrans strMsgTitle = "Demo udfStrTranslate (strString, strTableOut, strTableIn, strPad)" Message (strMsgTitle, strMsgText) Return ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ :Test_Lowcase ;------------------------------------------------------------------------------------------------------------------------------------------ ; As an alternative to the not-yet-existing php function "stritr". ;------------------------------------------------------------------------------------------------------------------------------------------ strString = "aAb" ; ==> "xxy" strTableIn = "ABCabc" strTableOut = "xyzxyz" strPad = "" strTrans = udfStrTranslateV4 (strString, strTableOut, strTableIn, strPad) ; "xyz" strMsgText = strString : @LF : strTrans strMsgTitle = "Demo udfStrTranslate (strString, strTableOut, strTableIn, strPad)" Message (strMsgTitle, strMsgText) Return ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ :Test_FormatNumberString ;------------------------------------------------------------------------------------------------------------------------------------------ strString = "(abc) defg-hijk" strTableIn = "abcdefghijk" strTableOut = "12345678901" ; ==> "(123) 4567-8901" strPad = "" strTrans = udfStrTranslateV4 (strString, strTableOut, strTableIn, strPad) strMsgText = strString : @LF : strTrans strMsgTitle = "Demo udfStrTranslate (strString, strTableOut, strTableIn, strPad)" Message (strMsgTitle, strMsgText) Return ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ :Soundex0 ;---------------------------------------------------------- ; Soundex und SoundexEx with udfStrTranslate() ;---------------------------------------------------------- strName = "Ashcraft" ; "A261". strName = "Spears" ; "S162". strName = "Superzicke" ; "S162". strName = "Knight" ; "K523". strName = "Herman" ; "H650". strName = "psychology" ; "P242". strName = "Schmit" ; "S253". strName = "Kristen" ; "K623". strName = "Gutierrez" ; "G362". strName = "Tymczak" ; "T522". strName = "Dalitz" ; "D432". intMode = 0 ; 0 = Normal, 1 = Extended Soundex. strTabin = "WHYEAUIOBFPVCGJKQSXZDTLMNR" strTabout0 = "00000000111122222222334556" strTabout1 = "00000000121234435355667889" strSoundex = StrClean (strName, strTabin, "", @FALSE, 2) strSoundex = StrUpper (strSoundex) strSoundex1 = StrSub (strSoundex, 1, 1) strSoundex = udfStrTranslateV4 (strSoundex, strTabout%intMode%, strTabin, "") strSoundex = StrSub (strSoundex, 2, -1) strSoundex = strSoundex1 : strSoundex strSoundex = StrReplace (strSoundex, "0", "") intI = 2 While intI < StrLen (strSoundex) strChar = StrSub (strSoundex, intI, 1) strSoundex = StrReplace (strSoundex, strChar : strChar, strChar) intI = intI + 1 EndWhile strSoundex = StrFix (strSoundex, "0", 4 + intMode) Message (strName, strSoundex) Return ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ :Soundex1 ;---------------------------------------------------------- ; Soundex und SoundexEx with udfStrTranslate() ;---------------------------------------------------------- strName = "Ashcraft" ; "A3926". strName = "Spears" ; "S1930". strName = "Superzicke" ; "S1953". strName = "Knight" ; "K8460". strName = "Herman" ; "H9800". strName = "psychology" ; "P3740". strName = "Schmit" ; "S3860". strName = "Kristen" ; "K9368". strName = "Gutierrez" ; "G6950". strName = "Tymczak" ; "T8353". strName = "Dalitz " ; "D7650". intMode = 1 ; 0 = Normal, 1 = Extended Soundex. strTabin = "WHYEAUIOBFPVCGJKQSXZDTLMNR" strTabout0 = "00000000111122222222334556" strTabout1 = "00000000121234435355667889" strSoundex = StrClean (strName, strTabin, "", @FALSE, 2) strSoundex = StrUpper (strSoundex) strSoundex1 = StrSub (strSoundex, 1, 1) strSoundex = udfStrTranslateV4 (strSoundex, strTabout%intMode%, strTabin, "") strSoundex = StrSub (strSoundex, 2, -1) strSoundex = strSoundex1 : strSoundex strSoundex = StrReplace (strSoundex, "0", "") intI = 2 While intI < StrLen (strSoundex) strChar = StrSub (strSoundex, intI, 1) strSoundex = StrReplace (strSoundex, strChar : strChar, strChar) intI = intI + 1 EndWhile strSoundex = StrFix (strSoundex, "0", 4 + intMode) Message (strName, strSoundex) Return ;------------------------------------------------------------------------------------------------------------------------------------------ ;==========================================================================================================================================