Database Search
If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.
TechHome
Sort
- ADO Array Sort
- Array Sort UDFs from Akreutzer
- Array Sort UDFs from Detlev
- Array Sort WIL Extender
- ArraySort Intuitive Sort Explained
- QuickSort
Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.
ArraySort UDFs from Detlev
Keywords: arraysort udf Detlev Dalitz
Question:
I can't find the logic to code something like;having an array with a number and a string as in;
10 name1 12 name2 4 name3 17 name4 etc...how can i code so that my array is sorted by the number decreasing like in?
17 name4 12 name2 10 name1 4 name3etc...
Answer:
Oh lots of code. BubbleSort from programming 101?There are already some arraysorts around Ummm see... on DD's page...
Detlev Dalitz's UDFs
Code Compliments of Detlev Dalitz 8/14/02:
Make sure to test carefully and suggestions welcome. Detlev reports that the following may have some unexpected quirks.
Note that this page needs to be displayed with Explorer 5.0+ or recent versions of Netscape.
ARRAY |
|
|
||||
|
||||
Array Sort Functions |
||||
;======================================================================================================================
; Collection of Array sort algorithms including bonus tools.
; Adapted to WinBatch by Detlev Dalitz.20010720.20020718
;----------------------------------------------------------------------------------------------------------------------
; udfArrPartSort (Array) ; from slow
; udfArrBubbleSort (Array) ; I
; udfArrQuickNRSort (Array) ; I
; udfArrShellSort (Array) ; I
; udfArrQuickRSort (Array) ; I
; udfArrBinSort (Array) ; v
; udfArrItemSort (Array, Delimiter) ; to fast ?
; udfArrDistributionSort (Array, KeyCount) ; special hash sort
;----------------------------------------------------------------------------------------------------------------------
; udfIsItemInArray (Array, item) ; checks if item exists in Array; returns bool
;----------------------------------------------------------------------------------------------------------------------
; udfArrWriteFile (Array, filename) ; unload Array to diskfile; returns filesize
; udfArrReadFile (filename) ; load Array from diskfile; returns new Array
;----------------------------------------------------------------------------------------------------------------------
; udfArrDump (Array, Delimiter) ; for testing dim-1 Array; returns string
;======================================================================================================================
Gosub DefineUDFs
Gosub testsort ; test the sort functions
Gosub testload ; test write to file and read from file
Exit
;======================================================================================================================
:testsort
logo="Demo Array Sort Algorithms"
test1="udfArrPartSort (Array)"
test2="udfArrBubbleSort (Array)"
test3="udfArrQuickNRSort (Array)"
test4="udfArrShellSort (Array)"
test5="udfArrQuickRSort (Array)"
test6="udfArrBinSort (Array)"
test7="udfArrItemSort (Array, Delimiter)"
test8="udfArrDistributionSort (Array, KeyCount)"
testlist=""
For i=1 To 10
If IsDefined(test%i%) Then testlist=StrCat(testlist,test%i%,@tab)
Next
TestCount=ItemCount(testlist,@tab)
asklist=""
While (asklist=="")
asklist=testlist
asklist=AskItemlist(StrCat(logo,": Select one or more functions to test"),asklist,@tab,@unsorted,@extended)
EndWhile
testlist=asklist
Drop(asklist)
testitemsdef=30
testitems=AskLine(logo,"How many items in Array?",testitemsdef)
testitems=Max(testitems,10)
testitemlendef=20
testitemlen=AskLine(logo,"How max length of each item?",testitemlendef)
testitemlen=Max(testitemlen,1)
BoxOpen(StrCat(logo,": Processing"), "Be patient")
BoxText("creating test items ...")
; --- create list of testitems, method A ------------------------------------------------------------------------------
sortstr=""
For i=1 To testitems
item=""
For k=1 To Random(1+testitemlen)
item=StrCat(item,Num2Char(65 + Random(25)))
Next
If ((i mod (testitems/10))==0) Then BoxText(StrCat("creating test item ...",@crlf,testitems,"/",i,@crlf,item))
sortstr = ItemInsert(item,-1,sortstr," ")
Next
;----------------------------------------------------------------------------------------------------------------------
; --- create list of testitems, method B ------------------------------------------------------------------------------
;sortstr=""
;poolstr="ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvw1234567890"
;poollen=StrLen(poolstr)
;For i=1 to testitems
; item=""
; For k=1 to random(1+testitemlen)
; item=StrCat(item,StrSub(poolstr,1+Random(poollen),1))
; Next
; If ((i mod (testitems/10))==0) then Boxtext(StrCat("creating test item ...",@crlf,testitems,"/",i,@crlf,item))
; sortstr = ItemInsert(item,-1,sortstr," ")
;Next
;----------------------------------------------------------------------------------------------------------------------
KeyCount=26
Delimiter=@tab
maxticks=0
testcount=ItemCount(Testlist,@tab)
For i=1 To testcount
item=ItemExtract(i,testlist,@tab)
BoxText(StrCat(item,@crlf,"sorting ..."))
Array = Arrayize(sortstr," ")
start=GetTickCount()
%item%
stop=GetTickCount()
ticks%i%=stop-start
maxticks=Max(ticks%i%,maxticks)
msgstr=StrCat(item,@crlf)
If (testitems<50) Then msgstr=StrCat(msgstr,udfArrDump(Array,@cr),@crlf)
msgstr=StrCat(msgstr,"ticks=",ticks%i%)
Display(10,item,msgstr)
Drop(Array)
Next
BoxShut()
msgstr=""
For i=1 To testcount
item=ItemExtract(i,testlist,@tab)
msgstr=StrCat(msgstr,100*ticks%i%/maxticks,"%%",@tab,ticks%i%,@tab,item,@crlf)
Next
Message(StrCat(logo,": Summary"),msgstr)
Return
;======================================================================================================================
:testload
logo = "Demo Array UnLoad Load Functions"
BoxOpen(StrCat(logo,": Processing"), "Be patient")
BoxText("creating test items ...")
d1 = 20
d2 = 3
d1count = d1-1
d2count = d2-1
A = ArrDimension(d1,d2)
ArrInitialize(A,0)
For d2=0 To d2count
For d1=0 To d1count
item = ""
For k=1 To Random(25)
item = StrCat(item,Num2Char(65 + Random(25)))
Next
A[d1,d2] = item
Next
Next
BoxShut()
TempFile = StrCat(Environment("temp"),"\arrtest.txt")
num = udfArrWriteFile(A,TempFile)
Message(StrCat("Array A ",num," byte written to diskfile ",TempFile),udfArrDump(A,@cr))
B = udfArrReadFile(TempFile)
Message(StrCat("Array B created, read from diskfile ",TempFile),udfArrDump(B,@cr))
RunZoom("notepad",TempFile)
Return
;======================================================================================================================
:DefineUDFs
;======================================================================================================================
If ItemLocate("udfarrpartsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrpartsort
#DefineFunction udfArrPartSort (Array)
If (VarType(Array)<>256) Then Return (Array)
If (ArrInfo(Array,0)>1) Then Return (Array)
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
sorted=@false
While !sorted
sorted=@true
For i=0 To arrmax-1
If (Array[i]>Array[i+1])
A=Array[i]
Array[i]=Array[i+1]
Array[i+1]=A
sorted=@false
EndIf
Next
EndWhile
Return (Array)
#EndFunction
:skip_udfarrpartsort
If ItemLocate("udfarrbubblesort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrbubblesort
#DefineFunction udfArrBubbleSort (Array)
If (VarType(Array)<>256) Then Return (Array)
If (ArrInfo(Array,0)>1) Then Return (Array)
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
For i=0 To arrmax-1
For k=i+1 To arrmax
If (Array[i]>Array[k])
A=Array[i]
Array[i]=Array[k]
Array[k]=A
EndIf
Next
Next
Return (Array)
#EndFunction
:skip_udfarrbubblesort
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrshellsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrshellsort
#DefineFunction udfArrShellSort (Array);
If (VarType(Array)<>256) Then Return (Array)
If (ArrInfo(Array,0)>1) Then Return (Array)
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
start=Floor(Loge(Max(arrmax,2)-1)/Loge(2))
For i=start To 0 By -1
jump=Exp(i*Loge(2))
For k=jump To arrmax
A=Array[k]
z=k-jump
done=!(A<Array[z])
While !done
Array[z+jump]=Array[z]
z=z-jump
If (z>0)
done=!(A<Array[z])
Else
done=@true
EndIf
EndWhile
Array[z+jump]=A
Next
Next
Return (Array)
#EndFunction
:skip_udfarrshellsort
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrquicknrsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrquicknrsort
#DefineFunction udfArrQuickNRSort (Array); non recursive
If (VarType(Array)<>256) Then Return (Array)
If (ArrInfo(Array,0)>1) Then Return (Array)
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
left=ArrDimension(100)
right=ArrDimension(100)
left[1]=0
right[1]=arrmax
sp=1
While (sp>0)
If (left[sp]>=right[sp])
sp=sp-1
Else
i=left[sp]
k=right[sp]
pivot=Array[k]
mid=(i+k)/2
If ((k-i)>5)
If ((Array[mid]<pivot) && (Array[mid]>Array[i])) || ((Array[mid]>pivot) && (Array[mid]<Array[i]))
A=Array[mid]
Array[mid]=Array[k]
Array[k]=A
EndIf
Else
If ((Array[i]<Array[mid]) && (Array[i]>pivot)) || ((Array[i]>Array[mid]) && (Array[i]<pivot))
A=Array[i]
Array[i]=Array[k]
Array[k]=A
EndIf
EndIf
pivot=Array[k]
While (i<k)
While (Array[i]<pivot)
i=i+1
EndWhile
k=k-1
While ((i<k) && (pivot<Array[k]))
k=k-1
EndWhile
If (i<k)
A=Array[i]
Array[i]=Array[k]
Array[k]=A
EndIf
EndWhile
k=right[sp]
A=Array[i]
Array[i]=Array[k]
Array[k]=A
If ((i-left[sp])>=(right[sp]-i))
left[sp+1]=left[sp]
right[sp+1]=i-1
left[sp]=i+1
Else
left[sp+1]=i+1
right[sp+1]=right[sp]
right[sp]=i-1
EndIf
sp=sp+1
EndIf
EndWhile
Drop(left,right)
Return (Array)
#EndFunction
:skip_udfarrquicknrsort
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrquickrsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrquickrsort
#DefineFunction udfArrQuickRSort (Array) ; recursive
If (VarType(Array)<>256) Then Return (Array)
If (ArrInfo(Array,0)>1) Then Return (Array)
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
udfArrQRSort(Array,0,arrmax)
Return (Array)
#EndFunction
:skip_udfarrquickrsort
If ItemLocate("udfarrqrsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrqrsort
#DefineFunction udfArrQRSort (Array, left, right)
; "udfArrQRSort" should be called first only from inner "udfArrQuickRSort" or by itself!
If (left<right)
pivot=Array[(left+right)/2]
i=left
k=right
While (i<=k)
While (Array[i]<pivot)
i=i+1
EndWhile
While (pivot<Array[k])
k=k-1
EndWhile
If (i<=k)
A=Array[i]
Array[i]=Array[k]
Array[k]=A
i=i+1
k=k-1
EndIf
EndWhile
udfArrQRSort(Array,left,k)
udfArrQRSort(Array,i,right)
EndIf
Return (Array)
#EndFunction
:skip_udfarrqrsort
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrbinsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrbinsort
#DefineFunction udfArrBinSort (Array)
If (VarType(Array)<>256) Then Return (Array) ; is Array?
If (ArrInfo(Array,0)>1) Then Return (Array) ; only dimension 1 wanted
If (VarType(Array[0])<>2) Then Return (Array) ; only strings wanted
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
maxlen=0
For i=0 To arrmax
maxlen=Max(maxlen,StrLen(Array[i]))
Next
bb=BinaryAlloc(maxlen*ArrInfo(Array,1))
For i=0 To arrmax
BinaryPokeStr(bb,i*maxlen,Array[i])
Next
BinarySort(bb,maxlen,0,maxlen,0)
For i=0 To arrmax
Array[i]=BinaryPeekStr(bb,i*maxlen,maxlen)
Next
BinaryFree(bb)
Return (Array)
#EndFunction
:skip_udfarrbinsort
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarritemsort
#DefineFunction udfArrItemSort (Array,Delimiter)
If (VarType(Array)<>256) Then Return (Array) ; is Array?
If (ArrInfo(Array,0)>1) Then Return (Array) ; only dimension 1 wanted
If (VarType(Array[0])<>2) Then Return (Array) ; only strings wanted
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
sortstr=""
For i=0 To arrmax
sortstr=ItemInsert(Array[i],-1,sortstr,Delimiter)
Next
sortstr=ItemSort(sortstr,Delimiter)
For i=0 To arrmax
Array[i]=ItemExtract(i+1,sortstr,Delimiter)
Next
Return (Array)
#EndFunction
:skip_udfarritemsort
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrdistributionsort",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrdistributionsort
#DefineFunction udfArrDistributionSort (Array, KeyCount)
If (VarType(Array)<>256) Then Return (Array)
If (ArrInfo(Array,0)>1) Then Return (Array)
arrmax=ArrInfo(Array,1)-1
If (arrmax<0) Then Return (Array)
; how many different keys exist? If fix number is known, then computing is not necessary
If (KeyCount==0)
itemlist=""
For i=0 To arrmax
If (ItemLocate(Array[i],itemlist,@tab)==0) Then itemlist=ItemInsert(Array[i],-1,itemlist,@tab)
Next
KeyCount=ItemCount(itemlist,@tab)
EndIf
BinsArray = ArrDimension(KeyCount)
StartArray = ArrDimension(KeyCount)
SaveArray = ArrDimension(ArrInfo(Array,1))
ArrInitialize(BinsArray,0)
ArrInitialize(StartArray,0)
For i=0 To arrmax
SaveArray[i] = Array[i] ; copy Array to save
BinsIndex = (Max(0,Char2Num(Array[i])-65)) ; hier die entsprechende Abbildungsfunktion anwenden
BinsArray[BinsIndex] = BinsArray[BinsIndex] + 1 ; count the number of each key value
Next
pos=0
For i=1 To (KeyCount-1)
pos = pos + BinsArray[i-1] ; compute the start position of each bin
StartArray[i] = pos
Next
For i=0 To arrmax ; deal the saved Array back to the original
SaveIndex = (Max(0,Char2Num(SaveArray[i])-65)) ; hier die entsprechende Abbildungsfunktion anwenden
StartIndex = StartArray[SaveIndex]
Array[StartIndex] = (Num2Char(SaveIndex+65)) ; hier die entsprechende _inverse_ Abbildungsfunktion anwenden
StartArray[SaveIndex] = StartArray[SaveIndex] + 1
Next
Drop(arrmax,BinsArray,BinsIndex,i,pos,SaveArray,SaveIndex,StartArray,StartIndex)
Return(Array)
; Is this an example for ideal hashing?
; Adopted from Pascal source published by
; James L. Allison, 1703 Neptune Lane, Houston, Texas 77062, Dec 22, 1988.
; "This is a real screamer, but it takes a lot of space,
; and is hard to package for inclusion in a library.
; It requires prior knowledge of how the Array and keys are structured.
; It is only feasible where there are a small number of possible keys.
; In this example, there are only 256 different values.
; It works well, for example, where the key is sex, department or state.
; It would be a disaster if the keys were name or phone number."
#EndFunction
:skip_udfarrdistributionsort
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisiteminarray",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfisiteminarray
#DefineFunction udfIsItemInArray (Array, item)
; this udf needs an ascending sorted Array
If (VarType(Array)<>256) Then Return (Array) ; is Array?
If (ArrInfo(Array,0)>1) Then Return (Array) ; only dimension 1 wanted
elements=ArrInfo(Array,1)
If (elements==0) Then Return (Array)
top=elements
bot=0
pivot=top/2
done=@false
found=@false
While !(done||found)
If (Array[pivot]<item)
bot=pivot
pivot=bot+((top-bot)/2)
done=(bot==pivot)
Else
top=pivot
pivot=top-((top-bot)/2)
done=(top==pivot)
EndIf
found=(Array[pivot]==item)
EndWhile
Return (found)
#EndFunction
:skip_udfisiteminarray
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrreadfile",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrreadfile
#DefineFunction udfArrReadFile (filename)
; Create Array from txtfile
; Example: MyArray = udfFileToArray(myFile)
fsize = FileSize(filename)
If (fsize <> 0)
bbsize = fsize+1
bb = BinaryAlloc (bbsize)
BinaryPokeStr(bb,0,@lf)
BinaryReadEx(bb,1,filename,0,fsize)
; read header, must be 7 lines on top of the file, but read into line 8
headercheck=""
struct=BinaryTagInit(bb,@lf,@cr)
For i=1 To 8
struct=BinaryTagFind(struct)
If (struct=="") Then Break ; something wrong in file
line=BinaryTagExtr(struct,0)
If (ItemExtract(1,line,";")=="ArrInfo")
index=ItemExtract(2,line,";")
ai%index%=ItemExtract(3,line,";")
headercheck=ItemInsert(index,-1,headercheck,",")
EndIf
Next
headercheck=ItemSort(headercheck,",")
If (headercheck=="0,1,2,3,4,5,6")
;declare Array
Array = ArrDimension(ai1,ai2,ai3,ai4,ai5)
;read data
offset=BinaryTagIndex(struct,1)-1
BinaryEodSet(bb,0)
BinaryReadEx(bb,0,filename,offset,fsize)
struct=BinaryTagInit(bb,@lf,@cr)
While @true
struct=BinaryTagFind(struct)
If (struct=="") Then Break ; end of file
line=BinaryTagExtr(struct,0)
If (line=="") Then Break ; end of data
ArrIndex=ItemExtract(1,line,";")
ArrType=ItemExtract(2,line,";")
ArrData=ItemExtract(3,line,";")
Array[%ArrIndex%]=ArrData
EndWhile
EndIf
BinaryFree(bb)
EndIf
If !IsDefined(Array) Then Array=Arrayize(" ","")
Return (Array)
#EndFunction
:skip_udfarrreadfile
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrwritefile",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrwritefile
#DefineFunction udfArrWriteFile (aArray, sFilename)
; Create txtfile from Array
; Example: udfArrToFile(myArray,myFile)
If (VarType(aArray)<>256) Then Return (aArray) ; no Array
If (ArrInfo(aArray,6)==0) Then Return (aArray) ; no elements
ai0="ArrInfo;0;{{0}};number of dimensions in the array"
ai1="ArrInfo;1;{{1}};number of elements in dimension 1"
ai2="ArrInfo;2;{{2}};number of elements in dimension 2"
ai3="ArrInfo;3;{{3}};number of elements in dimension 3"
ai4="ArrInfo;4;{{4}};number of elements in dimension 4"
ai5="ArrInfo;5;{{5}};number of elements in dimension 5"
ai6="ArrInfo;6;{{6}};number of elements in the entire array"
iDims=ArrInfo(aArray,0)
For i=1 To 5
e%i%=Max(ArrInfo(aArray,i)-1,0)
Next
hFW=FileOpen(sFilename,"WRITE")
; write header
For i=0 To 6
FileWrite(hFW,StrReplace(ai%i%,"{{%i%}}",ArrInfo(aArray,i)))
Next
; write data
For d1=0 To e1
For d2=0 To e2
For d3=0 To e3
For d4=0 To e4
For d5=0 To e5
index=""
For i=1 To iDims
index=ItemInsert(d%i%,-1,index,",")
Next
sOut=""
sOut=ItemInsert(index,-1,sOut,";")
sOut=ItemInsert(VarType(aArray[%index%]),-1,sOut,";")
If VarType(aArray[%index%])
sOut = ItemInsert(aArray[%index%],-1,sOut,";")
Else
sOut = ItemInsert("",-1,sOut,";")
EndIf
FileWrite(hFW,sOut)
Next
Next
Next
Next
Next
; close
FileClose(hFW)
Return (FileSize(sFilename))
#EndFunction
:skip_udfarrwritefile
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarrdump",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrdump
#DefineFunction udfArrDump (aArray, sDelimiter)
If (VarType(aArray)<>256) Then Return ("Dump not available. No Array.")
If (ArrInfo(aArray,6)==0) Then Return ("Dump not available. No Elements.")
If (ArrInfo(aArray,0)>1) Then Return ("Dump not available. Array has more than 1 Dimension.")
sItemList = ""
iArrMax = Max(ArrInfo(aArray,1)-1,0)
For i=0 To iArrMax
If VarType(aArray[i])
sItemList = ItemInsert(aArray[i],-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert("",-1,sItemList,sDelimiter)
EndIf
Next
sItemList = StrCat("Elements=",iArrMax+1,@crlf,sItemList)
Return (sItemList)
#EndFunction
:skip_udfarrdump
;======================================================================================================================
Return ; from gosub DefineUDFs
;======================================================================================================================
|
||||
| If you have questions, you are encouraged to use online WinBatch Tech Support Forum at http://forum.winbatch.com | ||||
|
|
|
|
||||
|
||||
udfArrCopy (Array) |
||||
If ItemLocate("udfarrcopy",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarrcopy
#DefineFunction udfArrCopy (aArray)
dims = ArrInfo(aArray,0)
For i=1 To 5
dim%i% = ArrInfo(aArray,i)
Next
aArrayNew = ArrDimension(dim1, dim2, dim3, dim4, dim5)
For i=1 To 5
dim%i% = dim%i% - 1
Next
Gosub %dims%
Return (aArrayNew)
:1
For a=0 To dim1
aArrayNew[a] = aArray[a]
Next
Return
:2
For a=0 To dim1
For b=0 To dim2
aArrayNew[a,b] = aArray[a,b]
Next
Next
Return
:3
For a=0 To dim1
For b=0 To dim2
For c=0 To dim3
aArrayNew[a,b,c] = aArray[a,b,c]
Next
Next
Next
Return
:4
For a=0 To dim1
For b=0 To dim2
For c=0 To dim3
For d=0 To dim4
aArrayNew[a,b,c,d] = aArray[a,b,c,d]
Next
Next
Next
Next
Return
:5
For a=0 To dim1
For b=0 To dim2
For c=0 To dim3
For d=0 To dim4
For e=0 To dim5
aArrayNew[a,b,c,d,e] = aArray[a,b,c,d,e]
Next
Next
Next
Next
Next
Return
; ? published by George Vagenas in Spring 2001 ?
; modified by Detlev Dalitz.20020203
#EndFunction
:skip_udfarrcopy
;--- test ---
myArray1 = ArrDimension(2,4,6,5,3)
myElements1 = ArrInfo(myArray1,6)
ArrInitialize(myArray1,221)
myArray2 = udfArrCopy(myArray1)
myElements2 = ArrInfo(myArray2,6)
Exit
|
||||
| If you have questions, you are encouraged to use online WinBatch Tech Support Forum at http://forum.winbatch.com | ||||
|
|
|
|
||||
|
||||
udfArrItemize (aArray, sDelimiter) |
||||
;----------------------------------------------------------------------------------------------------
; udfArrItemize (aArray, sDelimiter) ; 2002:07:17:20:56:38
; udfArrItemizeEx (aArray, sDelimiter) ; 2002:07:17:20:56:38
;----------------------------------------------------------------------------------------------------
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemize",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarritemize
#DefineFunction udfArrItemize (aArray, sDelimiter)
If (VarType(aArray)<>256) Then Return ("") ; no array
If (ArrInfo(aArray,6)==0) Then Return ("") ; no elements
If (ArrInfo(aArray,0)>1) Then Return ("") ; too much dimensions
sItemList = ""
iArrMax = Max(ArrInfo(aArray,1)-1,0)
For i=0 To iArrMax
If VarType(aArray[i])
sItemList = ItemInsert(aArray[i],-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert("",-1,sItemList,sDelimiter)
EndIf
Next
Return (sItemList)
;----------------------------------------------------------------------------------------------------------------------
; This udf "udfArrItemize" returns an sItemlist with each item separated by sDelimiter character.
;
; Example: myItemList = udfArrayItemize (myArray, @tab)
; Creates an ItemList from Array.
;
; Note:
; This udf supports only 1-dim 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
;----------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarritemize
;----------------------------------------------------------------------------------------------------------------------
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarritemizeex",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfarritemizeex
#DefineFunction udfArrItemizeEx (aArray, sDelimiter)
If (VarType(aArray)<>256) Then Return ("") ; no array
If (ArrInfo(aArray,6)==0) Then Return ("") ; no elements
dims = ArrInfo(aArray,0)
For i=1 To 5
e%i% = Max(ArrInfo(aArray,i)-1,0)
Next
sItemList = ""
For d1=0 To e1
For d2=0 To e2
For d3=0 To e3
For d4=0 To e4
For d5=0 To e5
index=""
For i=1 To dims
index = ItemInsert(d%i%,-1,index,",")
Next
If VarType(aArray[%index%])
sItemList = ItemInsert(aArray[%index%],-1,sItemList,sDelimiter)
Else
sItemList = ItemInsert("",-1,sItemList,sDelimiter)
EndIf
Next
Next
Next
Next
Next
Return (sItemList)
;----------------------------------------------------------------------------------------------------------------------
; This udf "udfArrItemizeEx" returns an sItemlist with each item separated by sDelimiter character.
;
; Example: myItemList = udfArrayItemize (myArray, @tab)
; Creates an ItemList from Array.
;
; Note:
; This udf supports 1-dim to 5-dim 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
;----------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarritemizeex
;----------------------------------------------------------------------------------------------------------------------
; --- test ---
sMsgTitle = "Demo udfArrayItemizeEx (aArray, sDelimiter)"
sFilename = IntControl(1004,0,0,0,0) ; use this file as test input
; count lines
iLineCount = 0
hfr = FileOpen(sFilename,"READ")
While 1
sLine = FileRead(hfr)
If (sLine=="*EOF*") Then Break
iLineCount = iLineCount + 1
EndWhile
FileClose(hfr)
; dim the array
aMyArray = ArrDimension(iLineCount,5) ; 2nd dimension is oversized, may contain not initialized elements
Message (sMsgTitle, StrCat("MyArray contains ",ArrInfo(aMyArray,6)," elements."))
; fill the array with data from this file
iLineCount = 0
hfr = FileOpen(sFilename,"READ")
While 1
sLine = FileRead(hfr)
If (sLine=="*EOF*") Then Break
aMyArray[iLineCount,0] = iLineCount+1 ; line number
aMyArray[iLineCount,1] = sLine ; line content
; aMyArray[iLineCount,2] ; NOT initialized
; aMyArray[iLineCount,3] ; NOT initialized
aMyArray[iLineCount,4] = Random(65535) ; random number
iLineCount = iLineCount + 1
EndWhile
FileClose(hfr)
sMyItemList = udfArrItemizeEx (aMyArray, @tab)
iItemCount = ItemCount(sMyItemList,@tab)
Message (sMsgTitle, StrCat("MyItemList contains ",iItemCount," items."))
IntControl(63,100,100,900,900)
AskItemlist (sMsgTitle, sMyItemList, @tab, @unsorted, @single)
:cancel
Exit
;----------------------------------------------------------------------------------------------------------------------
|
||||
| If you have questions, you are encouraged to use online WinBatch Tech Support Forum at http://forum.winbatch.com | ||||
|
|
|
|
||||
|
||||
udfStrArrayize (sString, bMode) |
||||
;----------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfstrarrayize",IntControl(77,103,0,0,0),@tab) Then Goto skip_udfstrarrayize
#DefineFunction udfStrArrayize (sString, bMode)
If (sString=="") Then Return (ArrDimension(1)) ; 1-dim array with undefined element, must be tested by the caller
bMode = Min(1,Max(0,bMode))
iStrLen = StrLen(sString)
Select bMode
Case 0
aArray = ArrDimension(iStrLen)
For i=1 To iStrLen
aArray[i-1] = StrSub(sString,i,1)
Next
Break
Case 1
aArray = ArrDimension(iStrLen + 1)
aArray[0] = iStrLen
For i=1 To iStrLen
aArray[i] = StrSub(sString,i,1)
Next
Break
EndSelect
Return (aArray)
;----------------------------------------------------------------------------------------------------------------------
; This udf "udfStrArrayize" splits the input sString into it's separate characters
; and returns a 1-dim aArray which contains one character per field element.
;
; If input sString is empty, then this udf returns an 'empty' 1-dim aArray,
; that means, there is one element in the Array, which has it's datatype undefined.
; The caller has to test this error result.
;
; bMode = 0 = creates a zero-based array,
; string length resp. array dimension can be evaluated by WIL function "ArrInfo (array, 1)".
; bMode = 1 = creates a one-based array,
; array element[0] contains the length of the string as an integer number.
;
; Detlev Dalitz.20020516
;----------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfstrarrayize
;----------------------------------------------------------------------------------------------------------------------
; --- test ---
sString = "that's a string" ; sString testcase 1
;sString = "" ; sString testcase 2
;bMode = 0 ; bMode testcase 1 ; zero based array
bMode = 1 ; bMode testcase 2 ; one based array
sMsgTitle = 'Demo udfStrArrayize (sString)'
sMsgText = StrCat('sString = "',sString,'"',@crlf,'aArray =',@crlf)
aArray = udfStrArrayize (sString, bMode)
If VarType(aArray[0]) ; Is the first element defined? (that is Vartype <> 0)
iCount = ArrInfo(aArray,1)-1
For i=0 To iCount
sMsgText = StrCat(sMsgText,'[',i,']',@tab,aArray[i],@crlf)
Next
Message(sMsgTitle,sMsgText)
Else
sMsgText = StrCat(sMsgText,'VarType(aArray[0]) is zero.',@crlf)
sMsgText = StrCat(sMsgText,'Datatype of first element is undefined.',@crlf)
sMsgText = StrCat(sMsgText,'maybe: String is empty, cannot create Array.',@crlf)
Message(sMsgTitle,sMsgText)
EndIf
Exit
;----------------------------------------------------------------------------------------------------------------------
|
||||
| If you have questions, you are encouraged to use online WinBatch Tech Support Forum at http://forum.winbatch.com | ||||
|
|
|
|
||||
|
||||
udfArrAskRow (sTitle, aArray, fSortMode, fSelectMode, bAskMode) |
||||
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfarraskrow",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfarraskrow
#DefineFunction udfArrAskRow (sTitle, aArray, iSortMode, iSelectMode, iAskMode)
iSortMode = Max(@UNSORTED,Min(@SORTED,iSortMode))
iSelectMode = Max(@SINGLE,Min(@EXTENDED,iSelectMode))
iAskMode = Max(0,Min(1,iAskMode))
chDelimItem = @TAB
chDelimRow = "|"
iDimMin = 1
iDimMax = 2
iDim = ArrInfo(aArray,0)
If (iDim > iDimMax) Then Return ("")
If (iDim < iDimMin) Then Return ("")
For i=1 To iDimMax
e%i%=Max(ArrInfo(aArray,i)-1,0)
Next
sAskList = ""
For d1=0 To e1
sRow = ""
For d2=0 To e2
index = ""
For i=1 To iDim
index = ItemInsert(d%i%,-1,index,",")
Next
sRow = ItemInsert(aArray[%index%],-1,sRow,chDelimItem)
Next
sRow = ItemInsert(d1,-1,sRow,chDelimItem) ; add Row number at end of sRow
sAskList = ItemInsert(sRow,-1,sAskList,chDelimRow)
Next
sResultList = ""
sRowList = AskItemlist(sTitle,sAskList,chDelimRow,iSortMode,iSelectMode)
Select iAskMode
Case 0
iCount = ItemCount(sRowList,chDelimRow)
For i=1 To iCount
sRowItem = ItemExtract(i,sRowList,chDelimRow)
sRowNum = ItemExtract(-1,sRowItem,chDelimItem)
sResultList = ItemInsert(sRowNum,-1,sResultList,chDelimRow)
Next
Break
Case 1
sResultList = sRowList
Break
EndSelect
:CANCEL
Return (sResultList)
;------------------------------------------------------------------------------------------------------------------------------------------
; parameters:
; sTitle = Title of the AskItemList box.
; aArray = 1-Dim or 2-Dim Array variable.
; iSortMode = @sorted for an alphabetic list.
; iSortMode = @unsorted to display the list of items as is.
; iSelectMode = @single to limit selection to one item.
; iSelectMode = @multiple to allow selection of more than one item.
; iSelectMode = @extended to allow selection of multiple items by extending the selection with the mouse or shift key.
; iAskMode = 0 to return a list of selected Array sRow index/es delimited by "|"
; iAskMode = 1 to return a list of selected Array sRow/s delimited by "|"
; If aArray dimension is not in the allowed range (1..2) then this udf returns an empty string "".
; The function IntControl (63, p1, p2, p3, p4) can be used to set the display coordinates for AskItemList.
; (IntControl 63 can be useful to cut resp. hide the rightmost Array column item while displaying the AskItemList box.)
;
; Detlev Dalitz.20020521
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udfarraskrow
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
; create 2-iDim test aArray with d1 sRows and d2 columns
iDim1 = 4
iDim2 = 4
aArray = ArrDimension(iDim1,iDim2)
aArray[0,0] = "Mickey"
aArray[0,1] = "Mouse"
aArray[0,2] = 11
aArray[0,3] = "MM"
aArray[1,0] = "Goofy"
aArray[1,1] = "Dog"
aArray[1,2] = 22
aArray[1,3] = "GD"
aArray[2,0] = "Carlo"
aArray[2,1] = "Cat"
aArray[2,2] = 33
aArray[2,3] = "CC"
aArray[3,0] = "Dagobert"
aArray[3,1] = "Duck"
aArray[3,2] = 44
aArray[3,3] = "DD"
; another testcase
; create 1-Dim test Array with iDim1 Rows
;iDim1 = 4
;aArray = ArrDimension(iDim1)
;
;aArray[0] = "Mickey"
;aArray[1] = "Goofy"
;aArray[2] = "Carlo"
;aArray[3] = "Dagobert"
sMsgTitle = "Demo udfArrAskRow (sTitle, aArray, iSortMode, iSelectMode, iAskMode)"
; test 1.0
sTitle = "Test 1.0, select single Array Row (index)"
sRow = udfArrAskRow (sTitle, aArray, @UNSORTED, @SINGLE, 0)
sMsgText = sRow
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 1.1
sTitle = "Test 1.1, select single Array Row"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @SINGLE, 1)
sMsgText = sRowList
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 2.0
sTitle = "Test 2.0, select multiple Array Row/s (index)"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @MULTIPLE, 0)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 2.1
sTitle = "Test 2.1, select multiple Array Row/s"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @MULTIPLE, 1)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 3.0
sTitle = "Test 3.0, select extended Array Row/s (index)"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @EXTENDED, 0)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; test 3.1
sTitle = "Test 3.1, select extended Array Row/s"
sRowList = udfArrAskRow (sTitle, aArray, @UNSORTED, @EXTENDED, 1)
sMsgText = StrReplace(sRowList,"|",@CRLF)
sMsgText = StrCat(sTitle,@CRLF,sMsgText)
Message(sMsgTitle,sMsgText)
; You can do the tests with "iSortMode = @SORTED" too.
:CANCEL
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
|
||||
| If you have questions, you are encouraged to use online WinBatch Tech Support Forum at http://forum.winbatch.com | ||||
|
|
|
|
||||
|
||||
udfFileArrayize (sFilename, iBaseMode) |
||||
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udffilearrayize",IntControl(73,103,0,0,0),@TAB) Then Goto skip_udffilearrayize
#DefineFunction udfFileArrayize (sFilename, iBaseMode)
If (sFilename=="") Then Return (ArrDimension(1))
iFilesize = FileSize(sFilename)
If !iFileSize Then Return (ArrDimension(1))
iBaseMode = Min(1,Max(0,iBaseMode))
iFilesize = iFilesize+iBaseMode
hBB = BinaryAlloc(iFilesize)
If iBaseMode Then BinaryPokeStr(hBB,0,@CR) ; Insert a leading empty line.
BinaryReadEx(hBB,iBaseMode,sFilename,0,-1) ; Read the whole file.
BinaryReplace(hBB,@CRLF,@CR,@TRUE) ; Unify EOL.
BinaryReplace(hBB,@LF,@CR,@TRUE) ; Unify EOL.
iBBEod = BinaryEodGet(hBB)
sString = BinaryPeekStr(hBB,0,iBBEod-(@CR==BinaryPeekStr(hBB,iBBEod-1,1))) ; Ommit trailing @CR.
BinaryFree(hBB)
aArray = Arrayize(sString,@CR)
If iBaseMode Then aArray[0] = ArrInfo(aArray,1)-1 ; If one based array, then poke number of file lines into element[0].
Return (aArray)
;------------------------------------------------------------------------------------------------------------------------------------------
; This function "udfFileArrayize" reads a textfile and returns a 1-dim array.
; Each array element contains one line of the given input file, with EndOfLine characters stripped off.
; The iBaseMode parameter controls the creation of a zero based or a one based Array.
; The array contains n elements (zero based) resp. n+1 elements (one based), with n = Number of File lines.
; After returning from this function the number of file lines read can be retrieved
; by 'LineCount = Array[0]' (one based array) or 'LineCount = ArrInfo(Array,1)' (zero based).
;
; If the specified Filename is empty or the FileSize is zero this function
; returns a 1-dim Array with one undefined element (VarType=0), which has to checked by the caller.
;
; sFilename ..... The File to be read into the array.
; iBaseMode=0 ... Creates a zero based array with n elements.
; iBaseMode=1 ... Creates a one based array with n+1 elements.
;
; Detlev Dalitz.20020808
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
:skip_udffilearrayize
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
MsgTitle = "Demo udfFileArrayize (sFilename, iBaseMode)"
sFilename = IntControl(1004,0,0,0,0) ; We use this script as test input file.
:test1
aFileArray = udfFileArrayize("",0)
If VarType(aFileArray[0]) Then MsgText = "Test1: First element is defined"
Else MsgText = "Test1: First element is not defined"
Message(MsgTitle,MsgText)
:test2
iBaseMode = 0
aFileArray = udfFileArrayize(sFilename,iBaseMode)
iLineCount = ArrInfo(aFileArray,1)
MsgText = StrCat("Test2: Lines read = ",iLineCount)
Message(MsgTitle,MsgText)
:test3
iBaseMode = 1
aFileArray = udfFileArrayize(sFilename,iBaseMode)
LineNo = 22
MsgText = StrCat("Test3: This is Line ",LineNo,@CRLF,aFileArray[LineNo])
Message(MsgTitle,MsgText)
Exit
|
||||
| If you have questions, you are encouraged to use online WinBatch Tech Support Forum at http://forum.winbatch.com | ||||
|
|
|
|
||||
|
||||
udfArrMap (sCallback, sArrayList, sArrayListSep) |
||||
;------------------------------------------------------------------------------------------------------------------------------------------
; udsArrMap (__sCallback, __sArrayList, __sArrayListSep) ; 2002:08:10:17:22:09
; udsIntSum (iNumber) ; 2002:08:10:17:22:09
; udfStrQuote (sStr, sLeft, sRight) ; 2002:08:10:17:22:09
; udfIsValidArray (aArray) ; 2002:08:10:17:22:09
; udfStrUp (sItem) ; 2002:08:10:17:22:09
; udfCube (iNumber) ; 2002:08:10:17:22:09
; udfStrFind (sItem) ; 2002:08:10:17:22:09
; udfTranslatePortugueseNumber (iNumber, sMale, sFemale) ; 2002:08:10:17:22:09
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udsarrmap",IntControl(73,103,0,0,0),@TAB) Then Goto skip_udsarrmap
;
#DefineSubRoutine udsArrMap (__sCallback, __sArrayList, __sArrayListSep)
If (__sArrayListSep=="") Then __sArrayListSep = @TAB
__iParamLow = 1
__iParamHigh = ItemCount(__sArrayList,__sArrayListSep)
; If no items in list then return 1-dim array with one undefined element.
If (__iParamHigh < __iParamLow) Then Return (ArrDimension(1))
For __iParam=__iParamLow To __iParamHigh
__aA%__iParam% = ItemExtract(__iParam,__sArrayList,__sArrayListSep)
__aA = __aA%__iParam%
; If the extracted array name points not to an array then return 1-dim array with one undefined element.
; If there is an array with greater than 1 dimension then return 1-dim array with one undefined element.
If (VarType(%__aA%) <> 256) Then Return (ArrDimension(1))
If (ArrInfo(%__aA%,0) > 1) Then Return (ArrDimension(1))
Next
If (__sCallback > "")
__aA = __aA%__iParamLow%
__iElementCount = ArrInfo(%__aA%,1)
For __iParam=1+__iParamLow To __iParamHigh
__aA = __aA%__iParam%
__iElementCount = Min(__iElementCount,ArrInfo(%__aA%,1))
Next
_ = ArrDimension(__iElementCount)
__iNewLow = 0
__iNewHigh = __iElementCount-1
For __iNew=__iNewLow To __iNewHigh
__sParamList = ""
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
If (VarType(%__aA%[__iNew]) == 2 ) ; If IsString, may contain comma, which has to be enclosed in quotes.
__sParamList = ItemInsert(udfStrQuote(%__aA%[__iNew],"",""),-1,__sParamList,",")
Else
__sParamList = ItemInsert(%__aA%[__iNew],-1,__sParamList,",")
EndIf
Next
_[__iNew] = %__sCallback% (%__sParamList%)
Next
Else
__iElementCount = 0
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
__iElement = ArrInfo(%__aA%,1)
__iElementCount = Max(__iElementCount,__iElement)
__i%__aA%High = __iElement-1
Next
_ = ArrDimension(__iElementCount,__iParamHigh)
__iNewLow = 0
__iNewHigh = __iElementCount-1
For __iNew=__iNewLow To __iNewHigh
For __iParam=__iParamLow To __iParamHigh
__aA = __aA%__iParam%
If (__iNew <= __i%__aA%High)
If VarType(%__aA%[__iNew])
_[__iNew,__iParam-1] = %__aA%[__iNew]
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 "udsArrMap" calls a user defined function or subroutine given by parameter 'sCallback'
; and calls the callback routine with a parameterlist built from defined array elements,
; which are extracted from one ore more arrays given by parameter 'sArrayList'.
;
; The "udsArrMap" subroutine returns a 1-dim array containing the results of the callback routine.
; If "udsArrMap" detects an exception to its inner rules, it will return a 1-dim array with one undefined element,
; which has to be checked by the caller, for example: "If Vartype(aArray)==0 Then ...".
; Note: The callback routine will be called as much as the smallest 1-dim array contains defined elements.
;
; 2. If parameter 'sCallback' is an empty string, then the one or more 1-dim arrays given by parameter 'sArrayList'
; will be combined into a 2-dim array.
; The "udsArrMap" subroutine returns a 2-dim array, that has as much number of rows as the largest 1-dim array given,
; and the number of 'columns' is defined by the given number of 1-dim arrays.
;
; Detlev Dalitz.20020809
;------------------------------------------------------------------------------------------------------------------------------------------
#EndSubRoutine
;
:skip_udsarrmap
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If (ItemLocate("udfstrquote",IntControl(77,103,0,0,0),@TAB)>0) Then Goto skip_udfstrquote
;
#DefineFunction udfStrQuote (sStr, sLeft, sRight)
; If (sStr == "") then return (sStr)
If (sLeft == "")
If (sRight == "")
sQuote = """'`"
sClean = StrClean(sStr,sQuote,"",@FALSE,2)
If ("" == StrClean(sQuote,sClean,"",@FALSE,1))
sQuote = '"'
sStr = StrReplace(sStr,sQuote,StrCat(sQuote,sQuote))
Else
sClean = StrClean(sQuote,sClean,"",@FALSE,1)
sQuote = StrSub(sClean,1,1)
EndIf
sLeft = sQuote
sRight = sQuote
EndIf
EndIf
Return (StrCat(sLeft,sStr,sRight))
;------------------------------------------------------------------------------------------------------------------------------------------
; With sLeft="" and sRight=""
; this udf chooses a winbatch quote delimiter automagically
; and doubles the quotation char in sStr if necessary.
;
; With sLeft="""" and sRight=""""
; this udf allows quotation without doubling of quotation char in sStr.
;
; With sLeft="(* " and sRight=" *)"
; this udf encloses sStr in pairs of Pascal comments.
;
; DD.20010722.20020628
;------------------------------------------------------------------------------------------------------------------------------------------
#EndFunction
;
:skip_udfstrquote
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfisvalidarray",IntControl(73,103,0,0,0),@TAB) Then Goto skip_udfisvalidarray
;
#DefineFunction udfIsValidArray (aArray)
If (VarType(aArray)<>256) Then Return (@FALSE) ; Datatype is not an array type.
If (ArrInfo(aArray,6)==1) Then If (VarType(aArray[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
;
:skip_udfisvalidarray
;------------------------------------------------------------------------------------------------------------------------------------------
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrUp (sItem)
Return (StrUpper(sItem))
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfCube (iNumber)
If IsNumber(iNumber) Then Return (iNumber*iNumber*iNumber)
Return (iNumber)
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfStrFind (sItem)
iPos = StrIndex(sItem,"o",1,@FWDSCAN)
If iPos Then Return (iPos ) ; Return the first positon found character "o" in sItem.
Return ("not found") ; Return "not found" string.
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineSubRoutine udsIntSum (iNumber)
If IsInt(iNumber) Then iIntSum = iIntSum + iNumber
Return (iIntSum)
#EndSubRoutine
;------------------------------------------------------------------------------------------------------------------------------------------
#DefineFunction udfTranslatePortugueseNumber (iNumber, sMale, sFemale)
If (sMale==sFemale)
Return (StrCat("In Portuguese the number ",iNumber," is called ",@CRLF,sMale))
Else
Return (StrCat("In Portuguese the number ",iNumber," is called",@CRLF,"male:",@TAB,sMale,@CRLF,"female:",@TAB,sFemale))
EndIf
#EndFunction
;------------------------------------------------------------------------------------------------------------------------------------------
; --- test ---
; Create some 1-dim arrays.
aNum = Arrayize("""0"",'1',2,3,4,5",",") ; This array has only six elements to show what happens with shorter arrays.
aNum[3] = 3 ; Make sure, that there is an integer the array.
aNum[4] = 4 ; Make sure, that there is an integer the array.
aNum[5] = 5 ; Make sure, that there is an integer the array.
aNumPortugueseMale = Arrayize("zero,um,dois,três,quatro,cinco,seis,sete,oito,nove",",")
aNumPortugueseFemale = Arrayize("zero,uma,duas,três,quatro,cinco,seis,sete,oito,nove",",")
aNumGerman = Arrayize("null,eins,zwei,drei,vier,fünf,sechs,sieben,acht,neun",",")
aNumEnglish = Arrayize("zero,one,two,three,four,five,six,seven,eigth,nine",",")
aNumStart = Arrayize("1,1,1,1",",")
aNumLength = Arrayize("1,2,3,4",",")
:test1
; Callback to the user defined function "udfCube".
aArray = udsArrMap("udfCube","aNum","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test1: Callback udfCube (iNumber)",sString%iRow%)
Next
EndIf
;--------------;
; A Value ;
; 0 0 ;
; 1 1 ;
; 2 8 ;
; 3 27 ;
; 4 64 ;
; 5 125 ;
;--------------;
:test2
; Callback to the user defined function "udfStrUp".
aArray = udsArrMap("udfStrUp","aNumEnglish","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test2: Callback udfStrUp (sItem)",sString%iRow%)
Next
EndIf
;--------------;
; A Value ;
; 0 ZERO ;
; 1 ONE ;
; 2 TWO ;
; 3 THREE ;
; 4 FOUR ;
; 5 FIVE ;
; 6 SIX ;
; 7 SEVEN ;
; 8 EIGHT ;
; 9 NINE ;
;--------------;
:test3
; Callback to the internal function "StrSub".
aArray = udsArrMap("StrSub","aNumEnglish|aNumStart|aNumLength","|")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test3: Callback StrSub (sString, iStart, iLength)",sString%iRow%)
Next
EndIf
;--------------;
; A Value ;
; 0 z ;
; 1 on ;
; 2 two ;
; 3 thre ;
;--------------;
:test4
; Callback to the internal function "StrLen".
aArray = udsArrMap("StrLen","aNumEnglish","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test4: Callback StrLen (sString)",sString%iRow%)
Next
EndIf
;---------------;
; A Value ;
; 0 4 ;
; 1 3 ;
; 2 3 ;
; 3 5 ;
; 4 4 ;
; 5 4 ;
; 6 3 ;
; 7 5 ;
; 8 5 ;
; 9 4 ;
;---------------;
:test5
; Callback to the external function "udfStrFind".
aArray = udsArrMap("udfStrFind","aNumEnglish","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test5: Callback udfStrFind (sItem)",sString%iRow%)
Next
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
; Callback to the external subroutine "udsIntSum".
iIntSum = 0
aArray = udsArrMap("udsIntSum","aNum","")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test6: Callback udsIntSum (iNumber)",sString%iRow%)
Next
EndIf
Pause("Test6: Callback udsIntSum (iNumber)",StrCat("iIntSum = ",iIntSum))
;---------------;
; 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 ;
;---------------;
; iIntSum = 14 ; !!!
;---------------;
:test7
; Callback to the external function "udfTranslatePortugueseNumber".
aArray = udsArrMap("udfTranslatePortugueseNumber","aNum,aNumPortugueseMale,aNumPortugueseFemale",",")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = aArray[iRow]
Pause("Test7: Callback udfTranslatePortugueseNumber (iNumber, sMale, sFemale)",sString%iRow%)
Next
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 ;
;----------------------------------------------;
:test8
; Map a single 1-dim arrays to one 2-dim array.
; Although only one 1-dim array is given, a 2-dim array will be created.
aArray = udsArrMap("","aNum",",")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
iColLow = 0
iColHigh = ArrInfo(aArray,2)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = ""
For iCol=iColLow To iColHigh
If VarType(aArray[iRow,iCol])
sString%iRow% = ItemInsert(aArray[iRow,iCol],-1,sString%iRow%,@TAB)
Else
sString%iRow% = ItemInsert("*N/A*",-1,sString%iRow%,@TAB)
EndIf
Next
Pause("Test8: Create 2-dim Array from a single 1-dim Array",sString%iRow%)
Next
EndIf
;-------------;
; A B=0 ;
; 0 0 ;
; 1 1 ;
; 2 2 ;
; 3 3 ;
; 4 4 ;
; 5 5 ;
;-------------;
:test9
; Map multiple 1-dim arrays to one 2-dim array.
aArray = udsArrMap("","aNum,aNumPortugueseMale,aNumPortugueseFemale,aNumEnglish,aNumGerman",",")
If udfIsValidArray(aArray)
; Dump the array to screen
iRowLow = 0
iRowHigh = ArrInfo(aArray,1)-1
iColLow = 0
iColHigh = ArrInfo(aArray,2)-1
For iRow=iRowLow To iRowHigh
sString%iRow% = ""
For iCol=iColLow To iColHigh
If VarType(aArray[iRow,iCol])
sString%iRow% = ItemInsert(aArray[iRow,iCol],-1,sString%iRow%,@TAB)
Else
sString%iRow% = ItemInsert("*N/A*",-1,sString%iRow%,@TAB)
EndIf
Next
Pause("Test9: Create 2-dim Array from multiple 1-dim Arrays",sString%iRow%)
Next
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
;------------------------------------------------------------------------------------------------------------------------------------------
|
||||
| If you have questions, you are encouraged to use online WinBatch Tech Support Forum at http://forum.winbatch.com | ||||
|
|
DD-Software.WinBatch