;------------------------------------------------------------------------------------------------------------------------------------------ #DefineSubRoutine udsArrayMap (__strCallback, __strArrayList, __strArrayListSep) If __strArrayListSep == "" Then __strArrayListSep = @TAB __ = ArrDimension (0) __intParamLow = 1 __intParamHigh = ItemCount (__strArrayList, __strArrayListSep) ; If no items in list then return dim0 array with no element. If __intParamHigh < __intParamLow Then Return ArrDimension (0) For __intParam = __intParamLow To __intParamHigh __arrA%__intParam% = ItemExtract (__intParam, __strArrayList, __strArrayListSep) ; If the extracted array name is an empty string, then treat it as an empty array. If __arrA%__intParam% == "" Then __arrA%__intParam% = "__" __arrA = __arrA%__intParam% ; If the extracted array name points not to an array then return dim0 array with no element. If !ArrInfo (%__arrA%, -1) Then Return ArrDimension (0) ; If there is an array with greater than 1 dimension then return dim0 array with no element. If ArrInfo (%__arrA%, 0) > 1 Then Return ArrDimension (0) Next If __strCallback > "" __arrA = __arrA%__intParamLow% __intElementCount = ArrInfo (%__arrA%, 1) For __intParam = 1 + __intParamLow To __intParamHigh __arrA = __arrA%__intParam% __intElementCount = Min (__intElementCount, ArrInfo (%__arrA%, 1)) Next Drop (_) _ = ArrDimension (__intElementCount) __intNewLow = 0 __intNewHigh = __intElementCount - 1 For __intNew = __intNewLow To __intNewHigh __strParamList = "" For __intParam = __intParamLow To __intParamHigh __arrA = __arrA%__intParam% If VarType (%__arrA% [__intNew]) == 2 ; If string, which may contain comma, then enclose in quotes. __strParamList = ItemInsert (udfStrQuote (%__arrA% [__intNew], "", ""), -1, __strParamList, ",") Else __strParamList = ItemInsert (%__arrA% [__intNew], -1, __strParamList, ",") EndIf Next _ [__intNew] = %__strCallback% (%__strParamList%) Next Else __intElementCount = 0 For __intParam = __intParamLow To __intParamHigh __arrA = __arrA%__intParam% __intElement = ArrInfo (%__arrA%, 1) __intElementCount = Max (__intElementCount, __intElement) __int%__arrA%High = __intElement - 1 Next Drop (_) _ = ArrDimension (__intElementCount, __intParamHigh) __intNewLow = 0 __intNewHigh = __intElementCount - 1 For __intNew = __intNewLow To __intNewHigh For __intParam = __intParamLow To __intParamHigh __arrA = __arrA%__intParam% If __intNew <= __int%__arrA%High If VarType (%__arrA% [__intNew]) _ [__intNew, __intParam - 1] = %__arrA% [__intNew] EndIf EndIf Next Next EndIf DropWild ("__*") Return _ ;------------------------------------------------------------------------------------------------------------------------------------------ ; Sorry, this code looks so ugly because of the "__" prefixes. ; At this time there is no better way known in WinBatch to get rid of "local" variables defined in a user defined subroutine. ;------------------------------------------------------------------------------------------------------------------------------------------ ; This UDS subroutine works in two ways: ; 1. The subroutine "udsArrayMap" calls a user defined function or subroutine given by parameter 'strCallback' ; and calls the callback routine with a parameterlist built from defined array elements, ; which are extracted from one ore more arrays given by parameter 'strArrayList'. ; ; The "udsArrayMap" subroutine returns a dim1 array containing the results of the callback routine. ; If "udsArrayMap" detects an exception to its inner rules, it will return a dim0 array with no element, ; which has to be checked by the caller, for example: "If ArrInfo (arrArray, 0) == 0 Then ...". ; Note: The callback routine will be called as much as the smallest dim1 array contains defined elements. ; ; 2. If parameter 'strCallback' is an empty string, then the one or more dim1 arrays given by parameter 'strArrayList' ; will be combined into a dim2 array. ; The "udsArrayMap" subroutine returns a dim2 array, that has as much number of rows as the largest dim2 array given, ; and the number of 'columns' is defined by the given number of items in the arraylist parameter. ; If arraylist contains an 'empty' item, then an empty column with undefined elements will be inserted. ; ; Detlev Dalitz.20020809.20020821.20090521. ;------------------------------------------------------------------------------------------------------------------------------------------ #EndSubRoutine ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrUp (strItem) Return StrUpper (strItem) #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfCube (intNumber) If IsNumber (intNumber) Then Return intNumber * intNumber * intNumber Return intNumber #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrFind (strItem) iPos = StrIndex (strItem, "o", 1, @FWDSCAN) If iPos Then Return iPos ; Return the first positon found character "o" in strItem. Return "not found" ; Return "not found" string. #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineSubRoutine udsSumIntegerOnly (intNumber) If IsInt (intNumber) Then intSum = intSum + intNumber Return intSum #EndSubRoutine ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfSumIntegerOnly (intNumber) ptrSum = PtrPersistent (Sum, 0) If IsInt (intNumber) Then *ptrSum = *ptrSum + intNumber Return *ptrSum #EndSubRoutine ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfTranslateNumberPT (intNumber, strMale, strFemale) If strMale == strFemale Return "In Portuguese the number " : intNumber : " is called " : @LF : strMale Else Return "In Portuguese the number " : intNumber : " is called" : @LF : "male:" : @TAB : strMale : @LF : "female:" : @TAB : strFemale EndIf #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfStrQuote (strString, strLeft, strRight) If "" == strLeft If "" == strRight strQuoteChars = """'`" strQuotes = StrClean (strString, strQuoteChars, "", @TRUE, 2) If "" == StrClean (strQuoteChars, strQuotes, "", @TRUE, 1) strQuoteChar = '"' strString = StrReplace (strString, strQuoteChar, StrFill (strQuoteChar, 2)) Else strQuotes = StrClean (strQuoteChars, strQuotes, "", @TRUE, 1) strQuoteChar = StrSub (strQuotes, 1, 1) EndIf strLeft = strQuoteChar strRight = strQuoteChar EndIf EndIf Return strLeft : strString : strRight ;------------------------------------------------------------------------------------------------------------------------------------------ ; With strLeft = "" and strRight = "" ; the function chooses a winbatch quote delimiter automagically ; and doubles the quotation char in strString if necessary. ; ; With strLeft = """" and strRight = """" ; the function allows quotation without doubling of quotation char in strString. ; (Note: """" is the same as '"'.) ; ; With strLeft = " (* " and strRight = " *)" ; the function encloses strString in pairs of pascal comments. ; ; With strLeft = " /* " and strRight = " */" ; the function encloses strString in pairs of C comments. ; ; DD.20010722.20020628.20090427. ;------------------------------------------------------------------------------------------------------------------------------------------ #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfIsValidArray (arrArray) If !ArrInfo (arrArray, -1) Then Return @FALSE ; Variable is not an array type. ;If (ArrInfo(arrArray,6)==1) Then If (VarType(arrArray [0])!=256) Then Return (@FALSE) ; Datatype is not an array type. Return @TRUE ;------------------------------------------------------------------------------------------------------------------------------------------ ; This Function "udfIsValidArray" returns a boolean value, ; which indicates if the given array is assumable a valid usable array. ; ; Detlev Dalitz.20020809 ;------------------------------------------------------------------------------------------------------------------------------------------ #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfFileCreateTemp (strPrefix, strExtension) strFilenameTemp = FileCreateTemp (strPrefix) strFilename = strFilenameTemp If strExtension != "" Then strFilename = ItemReplace (strExtension, -1, strFilenameTemp, ".") blnResult = FileRename (strFilenameTemp, strFilename) Return strFilename ;.......................................................................................................................................... ; This UDF "udfFileCreateTemp" creates a 0-byte file with unique name in the user's temporary folder ; (as specified by the "TMP" or "TEMP" environment variable). ; ; The temporary filename will have the form ; "hexnumber{4}.extension{0,3}" resp. "prefix{0,3}hexnumber{4}.extension{0,3}" ; ; The prefix string can be set by parameter strPrefix and will be truncated to 3 chars. ; The file extension string can be set by parameter strExtension. ; If strExtension is empty, then the file extension is set to "tmp". ; ; The WinBatch FileCreateTemp function can create maximal 65535 temporary files ; of the form "hexnumber{4}.tmp" from "1.tmp" to "FFFF.tmp". ; One more attempt will create WB error 1653. ; ; Detlev Dalitz.20090521. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfArrayDumpToItemList (arrArray, strDelimiter) If !ArrInfo (arrArray, -1) Then Return "*ARR_INVALID*" ; No Array, return info string. If ArrInfo (arrArray, 0) != 1 Then Return "*ARR_DIM_ERROR*" ; Array is not a dim-1 array, return info string. intElements = ArrInfo (arrArray, 1) If intElements == 0 Then Return "" intHigh = intElements - 1 intLow = 0 strItemList = "" For intI = intLow To intHigh strItem = "*ARR_ELEM_UNDEF*" If !!VarType (arrArray [intI]) If arrArray [intI] != "" Then strItem = "[" : arrArray [intI] : "]" Else strItem = "*ARR_ELEM_EMPTY*" EndIf strItemList = strItemList : strDelimiter : strItem Next Return StrSub (strItemList, 2, -1) ;.......................................................................................................................................... ; This UDF "udfArrayDumpToItemList" reads a dim-1 array and returns an itemlist of all array cell items. ; ; Return values: ; "*ARR_INVALID*" ... Invalid array resp. this is no array. ; "*ARR_DIM_ERROR*" ... Array is not a dim-1 array. ; "*ARR_ELEM_EMPTY*" ... Array element has defined vartype but is empty. ; "*ARR_ELEM_UNDEF*" ... Array element has undefined VarType. ; ; Example: strItemList = udfArrayDumpToItemList (arrArray, @TAB) ; ; Detlev Dalitz.20090517. ;.......................................................................................................................................... #EndFunction ;------------------------------------------------------------------------------------------------------------------------------------------ ;------------------------------------------------------------------------------------------------------------------------------------------ #DefineFunction udfDisplayResult (strMsgTitle, arrArray) strFilename = udfFileCreateTemp ("WBT", "txt") strWindowNP = "" If udfArrayUnloadToFile (arrArray, strFilename) blnResult = RunZoom ("notepad.exe", strFilename) strWindowNP = WinGetactive () 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 = "" 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 strWindowNP != "" Then If WinExist (strWindowNP) Then WinClose (strWindowNP) blnResult = FileDelete (strFilename) Return #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 ;------------------------------------------------------------------------------------------------------------------------------------------ ; Test. ; Create some dim1 arrays. arrNum = Arrayize ("""0"",'1',2,3,4,5", ",") ; This array has only six elements to show what happens with shorter arrays. arrNum [3] = Int (arrNum [3]) ; Make sure, that this element is an integer. arrNum [4] = Int (arrNum [4]) ; Make sure, that this element is an integer. arrNum [5] = Int (arrNum [5]) ; Make sure, that this element is an integer. arrNumPTMale = Arrayize ("zero,um,dois,três,quatro,cinco,seis,sete,oito,nove", ",") arrNumPTFemale = Arrayize ("zero,uma,duas,três,quatro,cinco,seis,sete,oito,nove", ",") arrNumDE = Arrayize ("null,eins,zwei,drei,vier,fünf,sechs,sieben,acht,neun", ",") arrNumEN = Arrayize ("zero,one,two,three,four,five,six,seven,eight,nine", ",") arrNumStart = Arrayize ("1,1,1,1", ",") arrNumLength = Arrayize ("1,2,3,4", ",") :Test1 ; Call user defined function "udfCube". arrArray = udsArrayMap ("udfCube", "arrNum", "") If udfIsValidArray (arrArray) Pause ("Test1: Callback udfCube (intNumber)", udfArrayDumpToItemList (arrArray, @LF)) EndIf ;--------------; ; A Value ; ; 0 0 ; ; 1 1 ; ; 2 8 ; ; 3 27 ; ; 4 64 ; ; 5 125 ; ;--------------; :Test2 ; Call user defined function "udfStrUp". arrArray = udsArrayMap ("udfStrUp", "arrNumEN", "") If udfIsValidArray (arrArray) Pause ("Test2: Callback udfStrUp (strItem)", udfArrayDumpToItemList (arrArray, @LF)) EndIf ;--------------; ; A Value ; ; 0 ZERO ; ; 1 ONE ; ; 2 TWO ; ; 3 THREE ; ; 4 FOUR ; ; 5 FIVE ; ; 6 SIX ; ; 7 SEVEN ; ; 8 EIGHT ; ; 9 NINE ; ;--------------; :Test3 ; Call internal function "StrSub". arrArray = udsArrayMap ("StrSub", "arrNumEN|arrNumStart|arrNumLength", "|") If udfIsValidArray (arrArray) Pause ("Test3: Callback StrSub (strString, iStart, iLength)", udfArrayDumpToItemList (arrArray, @LF)) EndIf ;--------------; ; A Value ; ; 0 z ; ; 1 on ; ; 2 two ; ; 3 thre ; ;--------------; :Test4 ; Call internal function "StrLen". arrArray = udsArrayMap ("StrLen", "arrNumEN", "") If udfIsValidArray (arrArray) Pause ("Test4: Callback StrLen (strString)", udfArrayDumpToItemList (arrArray, @LF)) EndIf ;---------------; ; A Value ; ; 0 4 ; ; 1 3 ; ; 2 3 ; ; 3 5 ; ; 4 4 ; ; 5 4 ; ; 6 3 ; ; 7 5 ; ; 8 5 ; ; 9 4 ; ;---------------; :Test5 ; Call external function "udfStrFind". arrArray = udsArrayMap ("udfStrFind", "arrNumEN", "") If udfIsValidArray (arrArray) Pause ("Test5: Callback udfStrFind (strItem)", udfArrayDumpToItemList (arrArray, @LF)) EndIf ;-----------------------; ; A Value ; ; zero 4 ; ; one 1 ; ; two 3 ; ; three not found ; ; four 2 ; ; five not found ; ; six not found ; ; seven not found ; ; eight not found ; ; nine not found ; ;-----------------------; :Test6 ; Call external subroutine "udsSumIntegerOnly". intSum = 0 arrArray = udsArrayMap ("udsSumIntegerOnly", "arrNum", "") If udfIsValidArray (arrArray) Pause ("Test6: Callback udsSumIntegerOnly (intNumber)", udfArrayDumpToItemList (arrArray, @LF)) EndIf Pause ("Test6: Callback udsSumIntegerOnly (intNumber)", "IntSum = " : intSum) ;---------------; ; A Value ; ; "0" 0 ; "0" is a string, not an integer! ; '1' 0 ; '1' is a string, not an integer! ; 2 2 ; ; 3 5 ; ; 4 9 ; ; 5 14 ; ;---------------; ; IntSum = 14 ; !!! ;---------------; :Test7 ; Call external function "udfSumIntegerOnly". arrArray = udsArrayMap ("udfSumIntegerOnly", "arrNum", "") If udfIsValidArray (arrArray) Pause ("Test7: Callback udfSumIntegerOnly (intNumber)", udfArrayDumpToItemList (arrArray, @LF)) EndIf Pause ("Test7: Callback udfSumIntegerOnly (intNumber)", "IntSum = " : arrArray [ArrInfo (arrArray, 1) - 1]) ;---------------; ; A Value ; ; "0" 0 ; "0" is a string, not an integer! ; '1' 0 ; '1' is a string, not an integer! ; 2 2 ; ; 3 5 ; ; 4 9 ; ; 5 14 ; ;---------------; ; IntSum = 14 ; !!! ;---------------; :Test8 ; Call external function "udfTranslateNumberPT". arrArray = udsArrayMap ("udfTranslateNumberPT", "arrNum,arrNumPTMale,arrNumPTFemale", ",") If udfIsValidArray (arrArray) Pause ("Test8: Callback udfTranslateNumberPT (intNumber, strMale, strFemale)", udfArrayDumpToItemList (arrArray, @LF)) EndIf ;----------------------------------------------; ; A Value ; ; 0 In Portuguese the number 0 is called ; ; zero ; ; 1 In Portuguese the number 1 is called ; ; male: um ; ; female: uma ; ; 2 In Portuguese the number 2 is called ; ; male: dois ; ; female: duas ; ; 3 In Portuguese the number 3 is called ; ; três ; ; 4 In Portuguese the number 4 is called ; ; quatro ; ; 5 In Portuguese the number 5 is called ; ; cinco ; ;----------------------------------------------; :Test9 ; Map a single dim1 array to one dim2 array. ; Although only one dim1 array is given, a dim2 array will be created. arrArray = udsArrayMap ("", "arrNum", ",") If udfIsValidArray (arrArray) udfDisplayResult ("Test9: Create dim2 array from a single dim1 array", arrArray) EndIf ;-------------; ; A B=0 ; ; 0 0 ; ; 1 1 ; ; 2 2 ; ; 3 3 ; ; 4 4 ; ; 5 5 ; ;-------------; :Test10 ; Map multiple dim1 arrays to one dim2 array. arrArray = udsArrayMap ("", "arrNum,arrNumPTMale,arrNumPTFemale,arrNumEN,arrNumDE", ",") If udfIsValidArray (arrArray) udfDisplayResult ("Test10: Create dim2 array from multiple dim1 arrays", arrArray) EndIf ;-------------------------------------------------; ; A B=0 B=1 B=2 B=3 B=4 ; ; 0 0 zero zero zero null ; ; 1 1 um uma one eins ; ; 2 2 dois duas two zwei ; ; 3 3 três três three drei ; ; 4 4 quatro quatro four vier ; ; 5 5 cinco cinco five fünf ; ; 6 --- seis seis six sechs ; ; 7 --- sete sete seven sieben ; ; 8 --- oito oito eigth acht ; ; 9 --- nove nove nine neun ; ;-------------------------------------------------; :CANCEL Exit