I use this to sort alphabetically ... its ugly!! but it works. You will need to understand VBS
'
Call RunFunctions
Sub RunFunctions
Dim va_array2()
if 1=1 then
vs_file = "C:\Users\Adam Law\AppData\Roaming\Filter Forge 3\My Filters\AJLDilateColourToAlpha.ffxml"
vs_filetext = ReadTextFile(vs_file)
'WScript.Echo("File: " & vs_1)
else
vs_file = Wscript.Arguments(0)
vs_filetext = ReadTextFile(vs_file)
'WScript.Echo("File: " & vs_1)
end If
va_array1 =GFMatchArray(vs_filetext, "<[^<]*<[^<]*value\-en[^>]*>", true ,true ,true)
ReDim va_array2(2, UBound(va_array1))
For count=1 To ubound (va_array1)
va_array2(0,count)=count
vs_1="id\='[^']*'"
vs_1=Replace(vs_1,"'", Chr(34))
va_array2(1,count)= GFMatch(va_array1(count), vs_1, true, true, true)
va_array2(2,count)= GFMatch(va_array1(count), "value\-en[^>]*", true, true, true)
Next
vs_1 = GFMatch(vs_filetext, "<ControlsOrder>[\S\s]*<\/ControlsOrder>", true, true, true)
va_array3 = TransposeDim(va_array2)
Call sortarray(va_array3, 2)
va_array3 = TransposeDim(va_array3)
vs_replace= "<ControlsOrder>"+ vbnewline
vs_replace= vs_replace+ "<Automatic value='false'/>" + vbnewline
vs_replace = Replace(vs_replace,"'", Chr(34))
vs_replace= vs_replace+ "
"+ vbnewline
For count=1 To ubound (va_array1)
vs_replace= vs_replace+ "<Item " + va_array3(1,count) + " order=" + Chr(34) +CStr(count)+Chr(34) +"/>" + vbnewline
Next
vs_replace= vs_replace+ "" + vbNewLine
vs_replace= vs_replace+ "</ControlsOrder>"
vs_filetext = Replace(vs_filetext, vs_1, vs_replace)
Call WriteTextFile(vs_file +"",vs_filetext)
If 1=0 Then
I also have XSLT Code ... but you need Altova Community Edition
Set objAltovaXML = CreateObject("AltovaXML.Application")
Set AltovaXMLXSLT2 = objAltovaXML.XSLT2
AltovaXMLXSLT2.InputXMLFileName=vs_1
AltovaXMLXSLT2.XSLFileName ="C:\Data_Server\Onehub\AAA_Data_OneHub\SV2\Data_VDrive\Data_QDrive\Febooti\FilterForge.xsl"
output = AltovaXMLXSLT2.Execute(outputfile) 'outputfile irrelevant
Set AltovaXMLXSLT2 =Nothing
Set objAltovaXML = Nothing
End if
End Sub
Function ReadTextFile(vs_1)
'Make sure that Febooti does not save unicode which is default
if 1=0 then
set adb = CreateObject("ADODB.Stream")
adb.Open
'.Type = adTypeBinary
adb.LoadFromFile vs_1
adb.Type = 2 'adTypeText
adb.Charset = "ascii" '"utf-8"
strText = adb.ReadText(-1) '
adb.Close
adb.Close
end if
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
'WScript.Echo( vs_1 & len(vs_1))
Set objFile = objFSO.OpenTextFile(vs_1, ForReading)
'WScript.Echo( "End")
ReadTextFile = objFile.ReadAll()
'ReadTextFile = objFile.ReadLine
objFile.Close
set objFSO =Nothing
End Function
Sub WriteTextFile(vs_1,vs_2)
Set fso = CreateObject("Scripting.FileSystemObject")
'OpenTextFile Parameters:3.'-Filename4.'-The 2 is for writing... 1 is reading and 8 is appending5.'-The "True" is to create if not already there
Set fl = fso.OpenTextFile(vs_1, 2, True)
fl.Write(vs_2)
fl.Close
Set fl = Nothing
Set fso = Nothing
End SUb
Sub SDeleteFile(vs_2)
'Turn off error handling
On Error Resume Next
'file might not exist
'Create an instance of the FileSystemObject
Dim objFSO
Set objFSO = CreateObject("Scripting.FileSystemObject")
if objfso.fileexists(vs_2) then objFSO.DeleteFile(vs_2)
set objFSO = Nothing
End Sub
Function GFMatch(strString, strPattern, wglobal, wignorecase, wmultiline)
Dim RegEx, arrMatches
Dim colmatches
Dim wmatch
Dim Count
Set RegEx = New RegExp
RegEx.IgnoreCase = wignorecase
RegEx.MultiLine = wmultiline
RegEx.Global = wglobal
RegEx.Pattern = strPattern
Set colmatches = RegEx.Execute(strString)
Count = 0
For Each wmatch In colmatches
Count = Count + 1
If Count = 1 Then GFMatch = wmatch
Next
End Function
Function GFMatchArray(strString, strPattern, wglobal ,wignorecase ,wmultiline)
Dim RegEx, arrMatches
Dim tmatcharray()
Set RegEx = New RegExp
RegEx.IgnoreCase = wignorecase
RegEx.Global = wglobal
RegEx.MultiLine = wmultiline
RegEx.Pattern = strPattern
Set colmatches = RegEx.Execute(strString)
xdim = colmatches.Count
ReDim Preserve tmatcharray(xdim)
Count = 0
For Each wmatch In colmatches
Count = Count + 1
tmatcharray(Count) = wmatch.Value
Next
GFMatchArray = tmatcharray
End Function
Sub sortarray(arrayname, sortcolumn1)
' sortcolumn1 = 0
'Optional wnumeric As String = "numericstrings"
For i = LBound(arrayname, 1) To UBound(arrayname, 1) - 1
For j = LBound(arrayname, 1) To UBound(arrayname, 1) - 1
If wnumeric = "numericstrings" Then
Condition1 = CDbl(arrayname(j, sortcolumn1)) > CDbl(arrayname(j + 1, sortcolumn1))
Else
Condition1 = (arrayname(j, sortcolumn1)) > (arrayname(j + 1, sortcolumn1))
End If
If Condition1 Then
For Y = LBound(arrayname, 2) To UBound(arrayname, 2)
t = arrayname(j, Y)
arrayname(j, Y) = arrayname(j + 1, Y)
arrayname(j + 1, Y) = t
Next
End If
Next
Next
End Sub
Function TransposeDim(v)
' Custom Function to Transpose a 0-based array (v)
Xupper = UBound(v, 2)
Yupper = UBound(v, 1)
ReDim tempArray(Xupper, Yupper)
For X = 0 To Xupper
For Y = 0 To Yupper
tempArray(X, Y) = v(Y, X)
Next
Next
TransposeDim = tempArray
End Function
