Database Search
If you can't find the information using the categories below, post a question over in our WinBatch Tech Support Forum.
TechHome
Examples from Users
Can't find the information you are looking for here? Then leave a message over on our WinBatch Tech Support Forum.
Laffdb Sort
Sorts an array or ItemList on multiple keys with options for:
- reporting or deleting duplicate keys
- force hyphens and apostrophes to sort with other symbols
- convert results between lists and arrays
- make sorting consistent with lists sorted using Itemsort. Requires the LAFFDB extender.
goto udfLASort
;------------------------------------------------------------------------------------------
Sorts an array or ItemList on multiple keys with options for reporting/deleting
duplicate keys and converting between lists and arrays. Requires the LAFFDB extender.
Syntax:
udfLASort(Recs, fSep, rSep, Keys, Flags)
Parameters:
(s/a)Recs: an array or item list
(s)fSep: field delimiter
(s)rSep: record delimiter
(s)Keys: CSV list of keys (column numbers) to sort on in
least to most important order.
(i)Flags: Or-able flags to modify the default behaviour. cf
Notes
Returns:
(s/a) a null string if there was an error or a variable
return value. cf Notes.
Keywords:
sorting ANSI convert array list lists arrays table vector symbols sort index key
records
Notes:
Version 1.0 developed and tested with WB2003J.
While udfLASort can be used to sort vector arrays and simple lists it
is meant for the sorting of records in a table array or a list of lists.
fSep & rSep:
Must be specified, for arrays or simple lists they should be the same
value. If an array is to be returned as a list these designate the
field and record separators.
Sorting, Keys, and Duplicate Records:
Multiple column sorting and reporting or deleting duplicate Keys is
not supported.
For a multiple column sort Keys might look like this "1,-3,7". Which
would be interpreted as do an ascending sort on the first column, then
a descending sort on the third, and finally an ascending sort on the
seventh. Least signifacant to most significant where grouping of
previous sorts is maintained.
OR-able Options:
1 - treat apostrophes and hyphens as symbols.
2 - check for duplicate keys, case sensitive.
4 - check for duplicate keys, case insensitive.
8 - delete duplicate keys.
16 - lexical sort, same as ItemSort.**
32 - pass in an array get a list, pass in a list get an array.
**While still faster than QuickSorting an array or list this option
takes ~3 times longer than the default sort but only impacts string
values.
Return Type Depends on Recs and Flags:
ItemList and Convert returns an array.
ItemList and any of the duplicate flags set returns the sorted list with a
Num2Char(1) appended duplicate "report". Either "nn records deleted"
or "Duplicate key list - N1^N2^N3..." where "^" is the fSep delimiter.
If no duplicates were found only the sorted list is returned.
Array and any of the duplicate flags set returns just the report or
@TRUE if no duplicates were found.
;------------------------------------------------------------------------------------------
:udfLASort
#definefunction udfLASort(Recs, fSep, rSep, Keys, Flags)
IntControl(73, 2, 0, 0, 0) ; GoSub WBERRORHANDLER
; Do some quick checking here.
if fSep=='' || rSep=='' then return '' ; Caller beware!.
AddExtender("laffd34i.dll")
esc = num2char(27)
IsArray = @false
if vartype(Recs)==256 then IsArray = @true
if IsArray
if arrinfo(Recs, 3) then return '' ; Vector or table arrays only.
RecCnt = arrinfo(Recs, 1)-1 ; Zero based rows.
FldCnt = arrinfo(Recs, 2) ; One based columns.
else
RecCnt = itemcount(Recs, rSep)-1
FldCnt = itemcount(itemextract(1, Recs, rSep), fSep)
endif
KeyCnt = itemcount(Keys, ' ')
Symbols = @false
Dups = @false
DupsNC = @false
DupDel = @false
AnsiSrt = @false
Convert = @false
; Deal with the Flags. NB! Defaults are set for fastest performance.
if (Flags&1)==1 then Symbols = @true ; Treats apostrophes and hyphens as symbols.
if (Flags&2)==2 && KeyCnt==1 then Dups = 1 ; Check for duplicate keys, case sensitive.
if (Flags&4)==4 && KeyCnt==1 then Dups = 2 ; Check for duplicate keys, case insensitive.
if (Flags&8)==8 && KeyCnt==1 then DupDel = @true ; Delete duplicate keys.
if (Flags&16)==16 then AnsiSrt = @true ; Slower, but returns same results as ItemSort.
if (Flags&32)==32 then Convert = @true ; Pass an array get a list, pass a list get an array.
if Convert && !IsArray then Ary = arrdimension(RecCnt+1, FldCnt, 0, 0, 0)
; dbOpen(filename - ignored,
; bCreateOK - ignored,
; model - memory based,
; numcols - FldCnt+1 needed for ANSI sort,
; format - delimited,
; field delimiter - fSep,
; optionstring - null allows max length for strings)
Db = dbopen('', 0, 1, FldCnt+1, 0, fSep, '')
; Comma delimited, one based column numbers least to most important sort order.
; A negative number indicates a descending sort for that column.
Keys = strreplace(Keys, ' ', '')
Ascends = ''
for k = 1 to KeyCnt
n = itemextract(k, Keys, ',')
if !isint(n) then return ''
if n<0 then Ascends = iteminsert(0, -1, Ascends, ',')
else Ascends = iteminsert(1, -1, Ascends, ',')
next
Keys = strreplace(Keys, '-', '')
; Bind columns to variables.
for Fld = 1 to FldCnt+1
Err = dbbindcol(Db, Fld, strcat('Col', Fld))
if Err!=1 then return ''
next
if IsArray
for Row = 0 to RecCnt
for Fld = 1 to FldCnt
Col%Fld% = Recs[Row, Fld-1]
if Symbols && itemlocate(Fld, Keys, ',') then Col%Fld% = strreplace(strreplace(Col%Fld%, "'", strcat(esc, '&')), '-', strcat(esc, ','))
next
Err = dbSetEntireRecord(Db, 0, 2|4) ; Add new record.
if Err!=Row then return ''
next
else
for Row = 0 to RecCnt
Rec = itemextract(Row+1, Recs, rSep)
for Fld = 1 to FldCnt
Col%Fld% = ItemExtract(Fld, Rec, fSep) ; Load record data into bound variables.
if Symbols && itemlocate(Fld, Keys, ',') then Col%Fld% = strreplace(strreplace(Col%Fld%, "'", strcat(esc, '&')), '-', strcat(esc, ','))
next
Err = dbSetEntireRecord(Db, 0, 2|4) ; Add new record.
if Err!=Row then return '' ; Caller beware!.
next
endif
; Sorta had to get here sooner or later.
Lkp = FldCnt+1
for Srt = 1 to KeyCnt
Key = itemextract(Srt, Keys, ',')
Ascend = itemextract(Srt, Ascends, ',')
; Hack to fix LAFFDB sorting of mixed case strings.
if dbgetcolumntype(Db, %Key%)=='S' && AnsiSrt
List = ''
for Row = 0 to RecCnt
f00 = dbGetRecordField(Db, Row, %Key%, 2)
List = iteminsert(dbGetRecordField(Db, Row, %Key%, 2), -1, List, @tab)
next
List = itemsort(List, @tab)
ls = ''
recno = 0
for k = 1 to RecCnt+1
itm = itemextract(k, List, @tab)
if itm!=ls then strt = -1
else strt = recno
recno = dbFindRecord(Db, strt, 2|8, %Key%, itm, 1)
f00 = dbgetlasterror()
err = dbSetRecordField(Db, recno, Lkp, 2, k)
ls = itm
next
err = dbsort(DB, %Lkp%, Ascend)
else
err = dbsort(DB, %Key%, Ascend)
endif
if Err!=1 then return ''
next
KeyList = ''
DupList = ''
DupRows = 0
if Convert then IsArray = !IsArray
if IsArray
if Convert then Recs = Ary
for Row = 0 to RecCnt
Err = dbgetentirerecord(Db, Row, 2) ; Variable record number.
if Err!=1 then return ''
for Fld = 1 to FldCnt
if Symbols && itemlocate(Fld, Keys, ',') then Col%Fld% = strreplace(strreplace(Col%Fld%, strcat(esc, '&'), "'"), strcat(esc, ','), '-')
if Dups && Fld==Keys ; Dups is only supported for single sort keys.
if Dups==1 then Tag = itemlocate(Col%Fld%, KeyList, fSep)
else Tag = itemlocate(strlower(Col%Fld%), KeyList, fSep)
if Tag
DupList = iteminsert(Row, -1, DupList, fSep)
if DupDel
DupRows = DupRows+1
break
endif
else ; Unique field.
if Dups==1 then KeyList = iteminsert(Col%Fld%, -1, KeyList, fSep)
else KeyList = iteminsert(strlower(Col%Fld%), -1, KeyList, fSep)
endif
endif
Recs[Row-DupRows, Fld-1] = Col%Fld%
next ; Fld
next ; Row
if DupRows && DupDel ; Cleanup for deleted records.
Offset = Row-DupRows
for Row = Offset to RecCnt
for Fld = 1 to FldCnt
Recs[Row, Fld-1] = ''
next
next
endif
else ; !IsArray
Recs = ''
for Row = 0 to RecCnt
Err = dbgetentirerecord(Db, Row, 2) ; Variable record number.
if Err!=1 then return ''
Rec = ''
DupRows = @false
for Fld = 1 to FldCnt
if Symbols && itemlocate(Fld, Keys, ',') then Col%Fld% = strreplace(strreplace(Col%Fld%, strcat(esc, '&'), "'"), strcat(esc, ','), '-')
if Dups && Fld==Keys
if Dups==1 then Tag = itemlocate(Col%Fld%, KeyList, fSep)
else Tag = itemlocate(strlower(Col%Fld%), KeyList, fSep)
if Tag
DupList = iteminsert(Row+1, -1, DupList, fSep)
if DupDel
DupRows = @true
break
endif
else
if Dups==1 then KeyList = iteminsert(Col%Fld%, -1, KeyList, fSep)
else KeyList = iteminsert(strlower(Col%Fld%), -1, KeyList, fSep)
endif
endif
Rec = iteminsert(Col%Fld%, -1, Rec, fSep)
next ; Fld
if !DupRows then Recs = iteminsert(Rec, -1, Recs, rSep)
next ; Row
endif
if IsArray && Convert then return Ary
if DupDel && DupList!='' then DupList = strcat(itemcount(DupList, fSep), ' records deleted.')
if (Dups || DupsNC) && DupList!='' then DupList = Strcat('Duplicate key list - ', DupList)
if IsArray
if DupList!='' then return DupList
else return 1
else
if DupList!='' then return strcat(Recs, num2char(1), DupList)
else return Recs
endif
:WBERRORHANDLER
wError = LastError()
wErrStr = IntControl(34,wError,0,0,0)
wErrLine = wberrorhandlerline
wErrOffset = wberrorhandleroffset
wErrAssign = wberrorhandlerassignment
wErrMsg = strCat(`wError = `, wError, @CRLF, `wErrStr = `, wErrStr, @CRLF, `wErrLine = `, wErrLine, @CRLF, `wErrAssign = `, wErrAssign)
pause(`Error in udfLASort`, wErrMsg)
exit
#endfunction ;udfLASort
;------------------------------------------------------------------------------------------
:Test
keyStr = "bcd %@tab%ab %@tab%abcd %@tab%ab.cd %@tab%ab(cd %@tab%ab&cd %@tab%ab-cde %@tab%ab,cd %@tab%ab'cde "
; Fastest. No special handling.
Flags = 0
Keys = udfLASort(keyStr, @tab, @tab, 1, Flags)
Msg = 'Why bother ItemSort is faster?'
pause(Msg, strCat(`keyStr%@tab%= `, keyStr, @CRLF, `Keys%@tab%= `, Keys))
Flags = 1 ;
Keys = udfLASort(keyStr, @tab, @tab, 1, Flags)
pause('Hyphens and apostrophes are treated as symbols.', strCat(`keyStr%@tab%= `, keyStr, @CRLF, `Keys%@tab%= `, Keys))
keyStr = "BCD %@tab%AB %@tab%ABCD %@tab%AB-cd %@tab%ab.cd %@tab%abcd %@tab%AB&cd %@tab%ab-cd %@tab%ab-CD "
Item = itemsort(keyStr, @tab)
Flags = 0
f00 = udfLASort(keyStr, @tab, @tab, 1, Flags)
Keys = itemextract(1, f00, num2char(1))
pause('LAFFDB mixed case sorting is inconsistent.', strCat(`keyStr%@tab%= `, keyStr, @CRLF, `Item%@tab%= `, Item, @CRLF, `Keys%@tab%= `, Keys))
Flags = 16
Keys = udfLASort(keyStr, @tab, @tab, 1, Flags)
pause('Force a lexical sort.', strCat(`keyStr%@tab%= `, keyStr, @CRLF, `Item%@tab%= `, Item, @CRLF, `Keys%@tab%= `, Keys))
keyStr = "BCD %@tab%AB %@tab%ABCD %@tab%ab.cd %@tab%abcd %@tab%AB&cd %@tab%ab-cd %@tab%ab-CD "
Recs = ''
Cnts = itemcount(keyStr, @tab)
Ary = arrdimension(Cnts, 2, 0, 0, 0)
for Cnt = 1 to Cnts
Key = itemextract(Cnt, keyStr, @tab)
Rec = strcat(Key, @tab, `Data for %Key%`)
Recs = iteminsert(Rec, -1, Recs, @lf)
Ary[Cnt-1, 0] = Key
Ary[Cnt-1, 1] = `Data for %Key%`
next
; DupsNC|AnsiSrt
Flags = 4|16
f00 = udfLASort(Recs, @tab, @lf, 1, Flags)
Recs = itemextract(1, f00, num2char(1))
Dups = itemextract(2, f00, num2char(1))
;DupsNC|DupDel|AnsiSrt|Convert
Flags = 4|8|16|32
f00 = udfLASort(Ary, @tab, @lf, 1, Flags)
Arr2Lst = itemextract(1, f00, num2char(1))
Dups2 = itemextract(2, f00, num2char(1))
pause(`Array returned as List, duplicate keys removed.`, strCat(`Recs = `, @CRLF, Recs, @CRLF, `Dups = `, @CRLF, Dups, @CRLF, @CRLF, `Arr2Lst = `, @CRLF, Arr2Lst, @CRLF, `Dups = `, @CRLF, Dups2, @CRLF))
exit
Article ID: W16338
File Created: 2005:02:18:12:19:54
Last Updated: 2005:02:18:12:19:54