;========================================================================================================================================== ; Compatibility Test ; between two user defined functions which behave antinomic: ; ; udfArrayFromList (strItemlist, strDelimiter) ; old name: udfStrArrayizeEx ; udfArrayToList (arrArray, strDelimiter) ; old name: udfArrayItemizeEx ; ; Both functions behave inverse to each other. ; ; Detlev Dalitz.20090520.20100122. ;========================================================================================================================================== GoSub DEFINE_FUNCTIONS strMsgTitle = "Demo: udfArrayFromList (strList, strDelimiter) / udfArrayToList (arrArray, strDelimiter)" :Test1 strList1 = "" strDelimiter = "" arrArray = udfArrayFromList (strList1, strDelimiter) strList2 = udfArrayToList (arrArray, strDelimiter) ; strList2 ==> "" GoSub DisplayResult :Test2 strList1 = "Teststring" strDelimiter = "" arrArray = udfArrayFromList (strList1, strDelimiter) strList2 = udfArrayToList (arrArray, strDelimiter) ; strList2 ==> "Teststring" GoSub DisplayResult :Test3 strList1 = "one two three four" strDelimiter = " " arrArray = udfArrayFromList (strList1, strDelimiter) strList2 = udfArrayToList (arrArray, strDelimiter) ; strList2 ==> "one two three four" GoSub DisplayResult :Test4 strList1 = "1|apple@2|pear@3|banana" strDelimiter = "@|" arrArray = udfArrayFromList (strList1, strDelimiter) strList2 = udfArrayToList (arrArray, strDelimiter) ; strList2 ==> "1|apple@2|pear@3|banana" GoSub DisplayResult :Test5 strList1 = "1|apple@2|pear@3|banana@" ; Trailing dim1 delimiter causes 'trailing' empty array cells. strDelimiter = "@|" arrArray = udfArrayFromList (strList1, strDelimiter) strList2 = udfArrayToList (arrArray, strDelimiter) ; strList2 ==> "1|apple@2|pear@3|banana@|" GoSub DisplayResult :Test6 strList1 = "o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o@o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o" strDelimiter = "@|/=+" arrArray = udfArrayFromList (strList1, strDelimiter) strList2 = udfArrayToList (arrArray, strDelimiter) ; strList2 ==> "o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o@o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o|o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o/o+o=o+o=o+o" GoSub DisplayResult Exit ;========================================================================================================================================== ; GoSub's ;------------------------------------------------------------------------------------------------------------------------------------------ :DisplayResult strMsgTitle = "Demo: udfArrayFromList (strList, strDelimiter)" strFilename = ShortCutDir ("Local Settings", 0, 1) : "Temp\Demo.udfArrayFromList.txt" hdlWndId = "" If udfArrayUnloadToFile (arrArray, strFilename) hdlWndId = WinItemProcId (RunShell (strFilename, "", "", @ZOOMED, @GETPROCID), 0, 0) blnResult = FileDelete (strFilename) EndIf intDims = ArrInfo (arrArray, 0) ; Number of dimensions in the array. intElements = ArrInfo (arrArray, 6) ; Number of elements in the entire array. strMsgText = "strList1 = " : strList1 : @LF strMsgText = strMsgText : "strList2 = " : strList2 : @LF strMsgText = strMsgText : "strDelimiter = " : strDelimiter : @LF strMsgText = strMsgText : "intDims = " : intDims : @LF strMsgText = strMsgText : "intElements = " : intElements : @LF IntControl (63, 300, 300, 700, 700) ; Sets coordinates for AskFileText, AskItemList and AskTextBox windows. IntControl (28, 1, 0, 0, 0) ; Selects system font used in list boxes. p1=1=fixed pitch font. AskItemlist (strMsgTitle, strMsgText, @LF, @UNSORTED, @SINGLE) :CANCEL If hdlWndId != "" Then If WinExist (hdlWndId) Then WinClose (hdlWndId) Return ; from GoSub DisplayResult. ;------------------------------------------------------------------------------------------------------------------------------------------ ;========================================================================================================================================== ;========================================================================================================================================== :DEFINE_FUNCTIONS ;========================================================================================================================================== ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayFromList (strList, strDelimiter) If strList == "" Then Return ArrDimension (0) ; Return dim0 array with no element. If strDelimiter == "" strDelim = Num2Char (7) ; Surrogate char. intSizeBB = StrLen (strList) << 1 hdlBB = BinaryAlloc (intSizeBB) BinaryPokeStrW (hdlBB, 0, strList) BinaryReplace (hdlBB, "", strDelim, @TRUE) arrArray = Arrayize (BinaryPeekStr (hdlBB, 0, intSizeBB - 1), strDelim) hdlBB = BinaryFree (hdlBB) Return arrArray ; Return dim1 array with each element containing one char. EndIf arrD = ArrDimension (6) ArrInitialize (arrD, "") arrE = ArrDimension (6) ArrInitialize (arrE, 0) arrE [0] = Min (5, StrLen (strDelimiter)) arrD [1] = StrSub (strDelimiter, 1, 1) arrE [1] = ItemCount (strList, arrD [1]) strItem = ItemExtract (1, strList, arrD [1]) For intI = 2 To arrE [0] arrD [intI] = StrSub (strDelimiter, intI, 1) arrE [IntI] = ItemCount (strItem, arrD [intI]) strItem = ItemExtract (1, strItem, arrD [intI]) Next arrArray = ArrDimension (arrE[1], arrE[2], arrE[3], arrE[4], arrE[5]) Switch arrE [0] Case 1 For intD1 = 1 To arrE [1] arrArray [intD1 - 1] = ItemExtract (intD1, strList, arrD [1]) Next Break Case 2 For intD1 = 1 To arrE [1] strItem1 = ItemExtract (intD1, strList, arrD [1]) For intD2 = 1 To arrE [2] arrArray [intD1 - 1, intD2 - 1] = ItemExtract (intD2, strItem1, arrD [2]) Next Next Break Case 3 For intD1 = 1 To arrE [1] strItem1 = ItemExtract (intD1, strList, arrD [1]) For intD2 = 1 To arrE [2] strItem2 = ItemExtract (intD2, strItem1, arrD [2]) For intD3 = 1 To arrE [3] arrArray [intD1 - 1, intD2 - 1, intD3 - 1] = ItemExtract (intD3, strItem2, arrD [3]) Next Next Next Break Case 4 For intD1 = 1 To arrE [1] strItem1 = ItemExtract (intD1, strList, arrD [1]) For intD2 = 1 To arrE [2] strItem2 = ItemExtract (intD2, strItem1, arrD [2]) For intD3 = 1 To arrE [3] strItem3 = ItemExtract (intD3, strItem2, arrD [3]) For intD4 = 1 To arrE [4] arrArray [intD1 - 1, intD2 - 1, intD3 - 1, intD4 - 1] = ItemExtract (intD4, strItem3, arrD [4]) Next Next Next Next Break Case 5 For intD1 = 1 To arrE [1] strItem1 = ItemExtract (intD1, strList, arrD [1]) For intD2 = 1 To arrE [2] strItem2 = ItemExtract (intD2, strItem1, arrD [2]) For intD3 = 1 To arrE [3] strItem3 = ItemExtract (intD3, strItem2, arrD [3]) For intD4 = 1 To arrE [4] strItem4 = ItemExtract (intD4, strItem3, arrD [4]) For intD5 = 1 To arrE [5] arrArray [intD1 - 1, intD2 - 1, intD3 - 1, intD4 - 1, intD5 - 1] = ItemExtract (intD5, strItem4, arrD [5]) Next Next Next Next Next Break EndSwitch Return arrArray ;.......................................................................................................................................... ; This UDF "udfArrayFromList" returns a dim-1 .. dim-5 array, whose array elements are filled ; by iterative separating the given input string into chunks of substrings. ; ; The input string is a serialized string list representation of a dim-1 .. dim-5 array. ; The elements are delimited by 1 .. 5 delimiter chars accordingly to their array dimension. ; ; If the given strList is empty, then the function returns a dim0 array with no element. ; ; If the given strDelimiter is empty, then the function returns a dim1 array with each element ; filled with one char of the given strList which is splitted into separate chars. ; ; Syntax: ; arr:Array = udfArrayFromList (str:String, str:Delimiter) ; ; Detlev Dalitz.20030225.20090520.20100122. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;---------------------------------------------------------------------------------------------------------------------- #DefineFunction udfArrayToList (arrArray, strDelimiter) If !ArrInfo (arrArray, -1) Then Return "" ; No array. If !ArrInfo (arrArray, 6) Then Return "" ; No elements. arrE = ArrDimension (6) arrE [0] = ArrInfo (arrArray, 0) For intI = 1 To 5 arrE [intI] = Max (0, ArrInfo (arrArray, intI) - 1) Next arrD = ArrDimension (6) ArrInitialize (arrD, "") intLen = Min (arrE [0], StrLen (strDelimiter)) For intI = 1 To intLen arrD [intI] = StrSub (strDelimiter, intI, 1) Next Switch arrE [0] Case 1 strItemList1 = "" For intD1 = 0 To arrE [1] If !!VarType (arrArray [intD1]) strItemList1 = strItemList1 : arrD [1] : arrArray [intD1] Else strItemList1 = strItemList1 : arrD [1] EndIf Next If arrD [1] != "" Then strItemList1 = StrSub (strItemList1, 2, -1) Break Case 2 strItemList1 = "" For intD1 = 0 To arrE [1] strItemList2 = "" For intD2 = 0 To arrE [2] If !!VarType (arrArray [intD1, intD2]) strItemList2 = strItemList2 : arrD [2] : arrArray [intD1, intD2] Else strItemList2 = strItemList2 : arrD [2] EndIf Next If arrD [2] != "" Then strItemList2 = StrSub (strItemList2, 2, -1) strItemList1 = strItemList1 : arrD [1] : strItemList2 Next If arrD [1] != "" Then strItemList1 = StrSub (strItemList1, 2, -1) Break Case 3 strItemList1 = "" For intD1 = 0 To arrE [1] strItemList2 = "" For intD2 = 0 To arrE [2] strItemList3 = "" For intD3 = 0 To arrE [3] If !!VarType (arrArray [intD1, intD2, intD3]) strItemList3 = strItemList3 : arrD [3] : arrArray [intD1, intD2, intD3] Else strItemList3 = strItemList3 : arrD [3] EndIf Next If arrD [3] != "" Then strItemList3 = StrSub (strItemList3, 2, -1) strItemList2 = strItemList2 : arrD [2] : strItemList3 Next If arrD [2] != "" Then strItemList2 = StrSub (strItemList2, 2, -1) strItemList1 = strItemList1 : arrD [1] : strItemList2 Next If arrD [1] != "" Then strItemList1 = StrSub (strItemList1, 2, -1) Break Case 4 strItemList1 = "" For intD1 = 0 To arrE [1] strItemList2 = "" For intD2 = 0 To arrE [2] strItemList3 = "" For intD3 = 0 To arrE [3] strItemList4 = "" For intD4 = 0 To arrE [4] If !!VarType (arrArray [intD1, intD2, intD3, intD4]) strItemList4 = strItemList4 : arrD [4] : arrArray [intD1, intD2, intD3, intD4] Else strItemList4 = strItemList4 : arrD [4] EndIf Next If arrD [4] != "" Then strItemList4 = StrSub (strItemList4, 2, -1) strItemList3 = strItemList3 : arrD [3] : strItemList4 Next If arrD [3] != "" Then strItemList3 = StrSub (strItemList3, 2, -1) strItemList2 = strItemList2 : arrD [2] : strItemList3 Next If arrD [2] != "" Then strItemList2 = StrSub (strItemList2, 2, -1) strItemList1 = strItemList1 : arrD [1] : strItemList2 Next If arrD [1] != "" Then strItemList1 = StrSub (strItemList1, 2, -1) Break Case 5 strItemList1 = "" For intD1 = 0 To arrE [1] strItemList2 = "" For intD2 = 0 To arrE [2] strItemList3 = "" For intD3 = 0 To arrE [3] strItemList4 = "" For intD4 = 0 To arrE [4] strItemList5 = "" For intD5 = 0 To arrE [5] If !!VarType (arrArray [intD1, intD2, intD3, intD4, intD5]) strItemList5 = strItemList5 : arrD [5] : arrArray [intD1, intD2, intD3, intD4, intD5] Else strItemList5 = strItemList5 : arrD [5] EndIf Next If arrD [5] != "" Then strItemList5 = StrSub (strItemList5, 2, -1) strItemList4 = strItemList4 : arrD [4] : strItemList5 Next If arrD [4] != "" Then strItemList4 = StrSub (strItemList4, 2, -1) strItemList3 = strItemList3 : arrD [3] : strItemList4 Next If arrD [3] != "" Then strItemList3 = StrSub (strItemList3, 2, -1) strItemList2 = strItemList2 : arrD [2] : strItemList3 Next If arrD [2] != "" Then strItemList2 = StrSub (strItemList2, 2, -1) strItemList1 = strItemList1 : arrD [1] : strItemList2 Next If arrD [1] != "" Then strItemList1 = StrSub (strItemList1, 2, -1) Break EndSwitch Return strItemList1 ;---------------------------------------------------------------------------------------------------------------------- ; This UDF "udfArrayToList" converts a given array into a serialized itemlist ; with each item separated by the delimiter character accordingly to the current dimension. ; ; Example: strMyItemList = udfArrayToList (arrMyArray, @TAB) ; Creates an itemlist from array. ; ; Note: ; This UDF supports dim-1 to dim-5 array. ; An array element which is not initialized has a Vartype=0 (undefined). ; Therefore an empty item will be appended to target itemlist. ; ; Detlev Dalitz.20020718.20090519.20100122. ;---------------------------------------------------------------------------------------------------------------------- #EndFunction ;---------------------------------------------------------------------------------------------------------------------- ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayUnloadToFile (arrArray, strFilename) If !ArrInfo (arrArray, -1) Then Return 0 ; No array. If !ArrInfo (arrArray, 6) Then Return 0 ; No elements. strArrInfo0 = "ArrInfo;0;{0};Number of dimensions in the array." strArrInfo1 = "ArrInfo;1;{1};Number of elements in dimension 1." strArrInfo2 = "ArrInfo;2;{2};Number of elements in dimension 2." strArrInfo3 = "ArrInfo;3;{3};Number of elements in dimension 3." strArrInfo4 = "ArrInfo;4;{4};Number of elements in dimension 4." strArrInfo5 = "ArrInfo;5;{5};Number of elements in dimension 5." strArrInfo6 = "ArrInfo;6;{6};Number of elements in the entire array." intDims = ArrInfo (arrArray, 0) strIndexFill = StrFill (",0", 2 * (5 - intDims)) For intD = 1 To 5 intE%intD% = Max (ArrInfo (arrArray, intD) - 1, 0) Next hdlFW = FileOpen (strFilename, "WRITE") strBOM = "" ; BOM (EF BB BF) for Unicode UTF-8. FileWrite (hdlFW, strBOM : '<?xml version="1.0" encoding="utf-8" standalone="yes"?>') ; XML declaration line with leading BOM (EF BB BF). FileWrite (hdlFW, "<ARRAY>") ; Open node "ARRAY". FileWrite (hdlFW, "<ARRINFO><![CDATA[") ; Open node "ARRINFO". ; Write data. For intI = 0 To 6 FileWrite (hdlFW, StrReplace (strArrInfo%intI%, "{%intI%}", ArrInfo (arrArray, intI))) Next FileWrite (hdlFW, "]]></ARRINFO>") ; Close node "ARRINFO". FileWrite (hdlFW, "<ARRDATA><![CDATA[") ; Open node "ARRDATA". ; Write data. For intD1 = 0 To intE1 For intD2 = 0 To intE2 For intD3 = 0 To intE3 For intD4 = 0 To intE4 For intD5 = 0 To intE5 strIdx = "" For intD = 1 To intDims strIdx = ItemInsert (intD%intD%, -1, strIdx, ",") Next intVarType = VarType (arrArray [%strIdx%]) intArrIndex = strIdx : strIndexFill If intVarType strOut = ChrStringToUnicode ("" : arrArray [%strIdx%]) intPrevCodePage = ChrSetCodepage (65001) FileWrite (hdlFW, intArrIndex : ";" : intVarType : ";" : strOut) ChrSetCodepage (intPrevCodePage) Else FileWrite (hdlFW, intArrIndex : ";" : intVarType : ";") EndIf Next Next Next Next Next FileWrite (hdlFW, "]]></ARRDATA>") ; Close node "ARRDATA". FileWrite (hdlFW, "</ARRAY>") ; Close node "ARRAY". hdlFW = FileClose (hdlFW) Return FileSizeEx (strFilename) ;.......................................................................................................................................... ; This function "udfArrayUnloadToFile" creates a specific array definition textfile (xml) from array, ; which can be used to load data back into an array by function "udfArrayLoadFromFile". ; ; Detlev Dalitz.20010731.20020828.20030222.20090528.20100122.20100125. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;========================================================================================================================================== Return ; from GoSub DEFINE_FUNCTIONS ;==========================================================================================================================================