Excel VBA to LibreOffice/OpenOffice.org basic converter. The purpose of the scripts below is to convert Excel VBA macroses to OpenOffice/LibreOffice ones. They were tested on OpenOffice.org 3.2, actually, so may be not up-to-date. Tcl 8.6 is required. DISCLAIMER: Some conversions are hardcoded (for example, ADO databases access conversion presumes that connection object is called Module1.conn), so read the sources, esp. vba2oo.tcl! How to use: 0. Save all scripts (convmodule.tcl, convmfix.tcl and vba2oo.tcl) into the same directory. 1. Export modules` sources from Excel (OpenOffice had a bug with exporting modules > 64K). 2. Process exported file with convmodule.tcl: > tclkit.exe convmodule.tcl module1.bas module1_out.bas 3. Process module1_out.bas with convmfix.tcl (you can skip this step): > tclkit.exe convmfix.tcl module1_out.bas module1_out2.bas 4. Import module1_out2.bas into LibreOffice. 5. Add 'Option Compatible' to the top of the module (adds Enum support), remove useless event processing Subs. 6. Add these to global definitions: Public ActiveDialog as Object Public conn as Object 7. Add this before calling dialogs: DialogLibraries.LoadLibrary("Standard") 8. Add these functions into module (if needed): ====== Function CIndex2RGB(idx as Long) as Long Select Case idx Case 0 CIndex2RGB = -1 Case 1 CIndex2RGB = 0 Case 2 CIndex2RGB = 16777215 Case 3 CIndex2RGB = 16711680 Case 4 CIndex2RGB = 65280 Case 5 CIndex2RGB = 255 Case 6 CIndex2RGB = 16776960 Case 7 CIndex2RGB = 16711935 Case 8 CIndex2RGB = 65535 Case 9 CIndex2RGB = 8388608 Case 10 CIndex2RGB = 32768 Case 11 CIndex2RGB = 128 Case 12 CIndex2RGB = 8421376 Case 13 CIndex2RGB = 8388736 Case 14 CIndex2RGB = 32896 Case 15 CIndex2RGB = 12632256 Case 16 CIndex2RGB = 8421504 Case 17 CIndex2RGB = 10066431 Case 18 CIndex2RGB = 10040166 Case 19 CIndex2RGB = 16777164 Case 20 CIndex2RGB = 13434879 Case 21 CIndex2RGB = 6684774 Case 22 CIndex2RGB = 16744576 Case 23 CIndex2RGB = 26316 Case 24 CIndex2RGB = 13421823 Case 25 CIndex2RGB = 128 Case 26 CIndex2RGB = 16711935 Case 27 CIndex2RGB = 16776960 Case 28 CIndex2RGB = 65535 Case 29 CIndex2RGB = 8388736 Case 30 CIndex2RGB = 8388608 Case 31 CIndex2RGB = 32896 Case 32 CIndex2RGB = 255 Case 33 CIndex2RGB = 52479 Case 34 CIndex2RGB = 13434879 Case 35 CIndex2RGB = 13434828 Case 36 CIndex2RGB = 16777113 Case 37 CIndex2RGB = 10079487 Case 38 CIndex2RGB = 16751052 Case 39 CIndex2RGB = 13408767 Case 40 CIndex2RGB = 16764057 Case 41 CIndex2RGB = 3368703 Case 42 CIndex2RGB = 3394764 Case 43 CIndex2RGB = 10079232 Case 44 CIndex2RGB = 16763904 Case 45 CIndex2RGB = 16750848 Case 46 CIndex2RGB = 16737792 Case 47 CIndex2RGB = 6710937 Case 48 CIndex2RGB = 9868950 Case 49 CIndex2RGB = 13158 Case 50 CIndex2RGB = 3381606 Case 51 CIndex2RGB = 13056 Case 52 CIndex2RGB = 3355392 Case 53 CIndex2RGB = 10040064 Case 54 CIndex2RGB = 10040166 Case 55 CIndex2RGB = 3355545 Case 56 CIndex2RGB = 3355443 End Select End Function Function FixType(Value as string) as Variant if IsNumeric(Value) then FixType = CDbl(Value) elseif IsDate(Value) then FixType=CDate(Value) else FixType=Value end if End Function Sub RecSetOpen (RS as Object, SQL as string, S1 as any, S2 as any, S3 as any, S4 as any) Dim Statement As Object Statement = conn.createStatement() Statement.QueryTimeOut = 0 RS = Statement.executeQuery(SQL) RS.first End Sub Function Round(dVal As Variant, Optional iPrecision As Integer) As Double dim iPrec as integer Dim roundStr As String Dim WholeNumberPart As String Dim DecimalPart As String Dim i As Integer Dim RoundUpValue As Double roundStr = CStr(dVal) if isMissing( iPrecision ) then iPrec = 0 else iPrec = iPrecision endif If InStr(1, roundStr, ",") = -1 Then Round = dVal Exit Function End If WholeNumberPart = Mid(roundStr, 1, InStr(1, roundStr, ",") - 1) DecimalPart = Mid(roundStr, (InStr(2, roundStr, ","))) If Len(DecimalPart) > iPrec + 1 Then Select Case Mid(DecimalPart, iPrec + 2, 1) Case "0", "1", "2", "3", "4" DecimalPart = Mid(DecimalPart, 1, iPrec + 1) Case "5", "6", "7", "8", "9" RoundUpValue = 0.1 For i = 1 To iPrec - 1 RoundUpValue = RoundUpValue * 0.1 Next DecimalPart = CStr(cdbl(Mid(DecimalPart, 1, iPrec + 1)) + RoundUpValue) If Mid(DecimalPart, 1, 1) <> "1" Then DecimalPart = Mid(DecimalPart, 1) Else WholeNumberPart = CStr(cDbl(WholeNumberPart) + 1) DecimalPart = "" End If End Select End If Round = cDbl(WholeNumberPart & DecimalPart) End Function Function GetComboIndex (ComboName as string) as long Dim f as Long Dim Combobox as object Combobox = ActiveDialog.getControl(ComboName) GetComboIndex = -1 For f = 0 to ComboBox.ItemCount - 1 If ComboBox.Items(f) = ComboBox.Text Then GetComboIndex = f exit function end if next f end function ====== 9. Also, I suggest to: a. Wrap long-running controls' events with: ActiveDialog.model.enabled = false ... event source ... ActiveDialog.model.enabled = true b. Replace FixType (produced by conversion if it can't recognize value type) with correct getXXX, if possible. c. If you use Arrays to output information to sheet (as you should), then clear your arrays before using them, like this: for f = 1 to 50000 for g = 1 to 4 DataArray(f, g) = "" next g next f Add 'ReDim Preserve DataArray' for EXACT size of sheet area you want to fill before using SetDataArray (doesn't work otherwise in OO 3.2). convmodule.tcl: ====== #convmodule.tcl #Converts exported module. Can use its form. #Helper proc for HIDING quoted strings: proc S {} { global G_CQStrs G_CQStrsIndex set s [lindex $G_CQStrs $G_CQStrsIndex] incr G_CQStrsIndex return $s } proc CR {CC} { if {[string is integer -strict $CC]} { set CNum [scan $CC %d] incr CNum return $CNum } else { #If it's like "something + 2" OR "something - 3": if {[regexp { [-+] \d+$} $CC]} { set Idxs [regexp -inline -indices {( [-+]) (\d+)$} $CC] set ss [lindex $Idxs 1 0] set se [lindex $Idxs 1 1] set ns [lindex $Idxs 2 0] set ne [lindex $Idxs 2 1] set CNum [scan [string index $CC $se][string range $CC $ns $ne] %d] incr CNum if {$CNum == 0} {return [string replace $CC $ss $ne ""]} if {$CNum>0} {set sign "+"} else {set sign "-"} return [string replace $CC $se $ne "$sign [expr {abs($CNum)}]"] } #If it's like "2 + something" if {[regexp {^\d+ \+ } $CC]} { regexp -indices {^\d+ \+ } $CC Idxs set ei [lindex $Idxs 1] set CNum [scan $CC %d] incr CNum if {$CNum == 0} {return [string replace $CC 0 $ei ""]} return [string replace $CC 0 $ei "$CNum + "] } if {[regexp {^\w+$} $CC]} { return "$CC + 1" } return "($CC) + 1" } } #Must convert cell coordinate into OO's: proc C {CC} { if {[string is integer -strict $CC]} { set CNum [scan $CC %d] incr CNum -1 return $CNum } else { #If it's like "something + 2" OR "something - 3": if {[regexp { [-+] \d+$} $CC]} { set Idxs [regexp -inline -indices {( [-+]) (\d+)$} $CC] set ss [lindex $Idxs 1 0] set se [lindex $Idxs 1 1] set ns [lindex $Idxs 2 0] set ne [lindex $Idxs 2 1] set CNum [scan [string index $CC $se][string range $CC $ns $ne] %d] incr CNum -1 if {$CNum == 0} {return [string replace $CC $ss $ne ""]} if {$CNum>0} {set sign "+"} else {set sign "-"} return [string replace $CC $se $ne "$sign [expr {abs($CNum)}]"] } #If it's like "2 + something" if {[regexp {^\d+ \+ } $CC]} { regexp -indices {^\d+ \+ } $CC Idxs set ei [lindex $Idxs 1] set CNum [scan $CC %d] incr CNum -1 if {$CNum == 0} {return [string replace $CC 0 $ei ""]} return [string replace $CC 0 $ei "$CNum + "] } if {[regexp {^\w+$} $CC]} { return "$CC - 1" } return "($CC) - 1" } } #.Rows("7:60001").Delete Shift:=xlUp #.Rows(CStr(psttot - 4) & ":60000").Delete Shift:=xlUp proc RD {args} { set RS [join $args] foreach p [split $RS :] { if {[regexp {CStr\((.+)\)} $p All InBrace]} { #Try to get expression from there: set res [C $InBrace] } else { #Try to scan number from there: regexp {\d+} $p CNumStr set res [scan $CNumStr %d] incr res -1 } lappend reslst $res } #First's correct, convert second (FROM end row number TO number of rows): foreach {f s} $reslst break if {[catch {set s [expr {$s-$f}]}]} { set s "$s - ($f)" } return "$f, $s" } #Convert Row to range address: proc RA {args} { set RS "\"\$A\$\" & [join $args]" set RS [string map {: {:$AMJ$}} $RS] return $RS } #Uppercase string proc U {args} { set Str [join $args] string toupper $Str } #Convert Format (Numbers): #They aren't correct, but close for now. proc CF {Str} { switch -exact $Str { {"#,##0.000"} {return 2} {"#,##0.00$"} {return 4} {"#,##0.00"} {return 4} {"#,##0"} {return 3} {"# ##0.000"} {return 4} default {return $Str} } } proc SW {spec} { set ::G_FixNextWith $spec return "" } proc EW {} { set res "" if {$::G_FixNextWith ne ""} { set res $::G_FixNextWith set ::G_FixNextWith "" } return $res } #Must process list of variables separately here: proc AR {RS} { foreach vp [split $RS ,] { set RN [string trim $vp] AddSubst "$RN\\.Open" "RecSetOpen $RN," } return "" } #This must process ALL possible "DIM" forms: proc CDim {Head Rest} { #1. Hack: substitute [AR] in rest: set Rest [subst -novariables $Rest] set res "" set s 0 while {1} { if {![regexp -start $s -indices -nocase {As .+?(?:,|$)} $Rest All]} break #So, we got one part: set ns [lindex $All 0] set ne [lindex $All 1] set Type [string trim [string range $Rest $ns $ne] ,] set Vars [string trim [string range $Rest $s $ns-1]] #Process Vars now: set vs 0 while {1} { if {![regexp -start $vs -indices {\w+(?:\([^()]+\))?(?:,|$)} $Vars All]} break set nvs [lindex $All 0] set nve [lindex $All 1] set VName [string trim [string range $Vars $nvs $nve] ,] append res "$Head $VName $Type\n" set vs [expr {$nve+1}] } set s [expr {$ne+1}] } string replace $res end end } proc AddSubst {RE REsub} { global G_RE_Substs lappend G_RE_Substs $RE $REsub } proc ConvNum {number} { format %.0f [expr {$number/35.27778}] } proc ConvModuleFile {fname ofname} { global G_RE_Substs G_CQStrs G_CQStrsIndex set fd [open $fname] fconfigure $fd -encoding cp1251 set ofd [open $ofname w] fconfigure $ofd -encoding cp1251 while {[gets $fd nline] >= 0} { set idnt "" regexp {^[ \t]+} $nline idnt set idnt "\n$idnt" set trmline [string trim $nline] if {[string index $trmline 0] eq "'"} { puts $ofd $nline continue } set G_CQStrsIndex 0 set G_CQStrs [regexp -inline -all {"[^\"]*"} $nline] set nline [regsub -all {[\[\]\\]} $nline {\\\0}] set nline [regsub -all {"[^\"]*"} $nline {[S]}] #As strings are hidden now, take out comment: set Comment "" set CSt [string first ' $nline] if {$CSt != -1} { set Comment [string range $nline $CSt end] set nline [string range $nline 0 $CSt-1] } foreach {RE RESub} $G_RE_Substs { set nline [regsub -all -nocase $RE $nline $RESub] } set nline [subst -novariables $nline] append nline [subst -novariables $Comment] #Skip lines that became empty: if {([string trim $nline] eq "") && ($trmline ne "")} continue #Fix identation here: set nline [regsub -all "\n" $nline $idnt] puts $ofd $nline } close $fd close $ofd } proc GetFormData {fname} { set fd [open $fname] fconfigure $fd -encoding utf-8 while {[gets $fd line] >= 0} { if {[regexp {dlg:id=} $line]} { regexp {dlg:id="(\w+)"} $line All Name switch -glob $line { "*dlg:checkbox*" { AddSubst "(.+) = $Name.Value\$" "If ActiveDialog.getControl(\"$Name\").State = 1 Then \\1 = True Else \\1 = False" AddSubst "If $Name.Value Then" "If ActiveDialog.getControl(\"$Name\").State = 1 Then" AddSubst "$Name.Value = False" "ActiveDialog.getControl(\"$Name\").State = 0" AddSubst "$Name.Value = True" "ActiveDialog.getControl(\"$Name\").State = 1" } "*dlg:menulist*" { AddSubst "$Name.AddItem (.+)\$" "ActiveDialog.getControl(\"$Name\").addItem(\\1, ActiveDialog.getControl(\"$Name\").ItemCount)" AddSubst "$Name.Clear" "ActiveDialog.getControl(\"$Name\").removeItems(0, ActiveDialog.getControl(\"$Name\").ItemCount)" #Check: from zero in OO, in Excel ? AddSubst "$Name.ListIndex" "ActiveDialog.getControl(\"$Name\").SelectedItemPos" AddSubst "$Name.Text" "ActiveDialog.getControl(\"$Name\").SelectedItem" } "*dlg:text*" { AddSubst "$Name.Caption = (.+)\$" "ActiveDialog.getControl(\"$Name\").Text = \\1" } "*dlg:radio*" { AddSubst "$Name.Value" "ActiveDialog.getControl(\"$Name\").State" } "*dlg:combobox*" { AddSubst "$Name.AddItem (.+)\$" "ActiveDialog.getControl(\"$Name\").addItem(\\1, ActiveDialog.getControl(\"$Name\").ItemCount)" AddSubst "$Name.Clear" "ActiveDialog.getControl(\"$Name\").removeItems(0, ActiveDialog.getControl(\"$Name\").ItemCount)" #Check: from zero in OO, in Excel ? AddSubst "$Name.ListIndex = (.+)\$" "ActiveDialog.getControl(\"$Name\").text = ActiveDialog.getControl(\"$Name\").getItem(\\1)" AddSubst "$Name.ListIndex" "GetComboIndex(\"$Name\")" AddSubst "$Name.Text" "ActiveDialog.getControl(\"$Name\").Text" } "*dlg:datefield*" { AddSubst "$Name.Value = (.+)\$" "ActiveDialog.getControl(\"$Name\").Date = CdateToIso(\\1)" AddSubst "(.+) = $Name.Value\$" "\\1 = CDateFromIso(ActiveDialog.getControl(\"$Name\").Date)" } } } } close $fd } set ::G_FixNextWith "" set L [llength $argv] if {$L==3} { GetFormData [lindex $argv 1] source VBA2OO.tcl ConvModuleFile [lindex $argv 0] [lindex $argv 2] } else { source VBA2OO.tcl ConvModuleFile [lindex $argv 0] [lindex $argv 1] } ====== VBA2OO.tcl: ====== #What is NOT translatable: #1. Multiple ranges (they are easy to convert by hand). # like: "A1:B2, C4:C6, A16:B18" #2. PageSetup --- deleted on translation, not so important. #3. Creating toolbars --- can be done directly (without code) in OpenOffice. #4. SQL command (INSERT/UPDATE) semantic's wrong --- it's executed # on using ".CommandText" property. #5. "Range(" with two string parametes is not translated: # example: Range(v(G, 3), v(G, 4)).Select #6. FormulaR1C1 is unsupported in OOBasic, so no conversion. #7. "Range.Value = " is unsupported in OOBasic, so no conversion. #8. Defining Enums is supported in OOBasic ONLY with 'Option Compatible'. #============================================================================ #Destroy these lines: AddSubst {^.+\.PageSetup\..+$} {} AddSubst {^.+\.FitToPagesWide.+$} {} AddSubst {^.+\.FitToPagesTall.+$} {} AddSubst {^.+\.PrintArea.+$} {} AddSubst {^.+\.ConnectionTimeout .+$} {} AddSubst {^.+\.CommandTimeout .+$} {} AddSubst {^.*\.Execute.*$} {} AddSubst {Set .+ = New ADODB\.(\w+)$} {} AddSubst {^.+\.ActiveConnection = .+$} {} AddSubst {^.+\.BeginTrans$} {} AddSubst {^.+\.CommitTrans$} {} AddSubst {^.+\.Calculation = .+$} {} AddSubst {^.+\.Calculate$} {} AddSubst {^.+\.LineStyle = .+$} {} #General substs: AddSubst {Application\.UserName} {Environ("USERNAME")} AddSubst {Application\.} {ThisComponent.} AddSubst {CCur\(} {CDbl(} #Formatting: #Borders are next to impossible, who could think!? AddSubst {With (.+)\.Borders\(xlEdgeLeft\)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.LeftBorder\nWith OOtmpobj2\[SW \"\nOOtmpobj1.LeftBorder = OOtmpobj2\"\]" AddSubst {With (.+)\.Borders\(xlEdgeRight\)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.RightBorder\nWith OOtmpobj2\[SW \"\nOOtmpobj1.RightBorder = OOtmpobj2\"\]" AddSubst {With (.+)\.Borders\(xlEdgeTop\)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.TopBorder\nWith OOtmpobj2\[SW \"\nOOtmpobj1.TopBorder = OOtmpobj2\"\]" AddSubst {With (.+)\.Borders\(xlEdgeBottom\)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.BottomBorder\nWith OOtmpobj2\[SW \"\nOOtmpobj1.BottomBorder = OOtmpobj2\"\]" AddSubst {With (.+)\.Borders\(xlInsideHorizontal\)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.TableBorder\nOOtmpobj3 = OOtmpobj2.HorizontalLine\nWith OOtmpobj3\[SW \"\nOOtmpobj2.HorizontalLine = OOtmpobj3\nOOtmpobj1.TableBorder = OOtmpobj2\"\]" AddSubst {With (.+)\.Borders\(xlInsideVertical\)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.TableBorder\nOOtmpobj3 = OOtmpobj2.VerticalLine\nWith OOtmpobj3\[SW \"\nOOtmpobj2.VerticalLine = OOtmpobj3\nOOtmpobj1.TableBorder = OOtmpobj2\"\]" #This works just by sequence: AddSubst {(.+)\.Borders\.(.+)} "OOtmpobj1 = \\1\nOOtmpobj2l = OOtmpobj1.LeftBorder\nOOtmpobj2r = OOtmpobj1.RightBorder\nOOtmpobj2t = OOtmpobj1.TopBorder\nOOtmpobj2b = OOtmpobj1.BottomBorder\nOOtmpobj2l.\\2\nOOtmpobj2r.\\2\nOOtmpobj2t.\\2\nOOtmpobj2b.\\2\nOOtmpobj1.LeftBorder = OOtmpobj2l\nOOtmpobj1.RightBorder = OOtmpobj2r\nOOtmpobj1.TopBorder = OOtmpobj2t\nOOtmpobj1.BottomBorder = OOtmpobj2b" AddSubst {(.+)\.Borders\(xlEdgeLeft\)(.+)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.LeftBorder\nOOtmpobj2\\2\nOOtmpobj1.LeftBorder = OOtmpobj2" AddSubst {(.+)\.Borders\(xlEdgeRight\)(.+)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.LeftBorder\nOOtmpobj2\\2\nOOtmpobj1.RightBorder = OOtmpobj2" AddSubst {(.+)\.Borders\(xlEdgeTop\)(.+)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.LeftBorder\nOOtmpobj2\\2\nOOtmpobj1.TopBorder = OOtmpobj2" AddSubst {(.+)\.Borders\(xlEdgeBottom\)(.+)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.LeftBorder\nOOtmpobj2\\2\nOOtmpobj1.BottomBorder = OOtmpobj2" AddSubst {(.+)\.Borders\(xlInsideVertical\)(.+)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.TableBorder\nOOtmpobj3 = OOtmpobj2.VerticalLine\nOOtmpobj3\\2\nOOtmpobj2.VerticalLine = OOtmpobj3\nOOtmpobj1.TableBorder = OOtmpobj2" AddSubst {(.+)\.Borders\(xlInsideHorizontal\)(.+)} "OOtmpobj1 = \\1\nOOtmpobj2 = OOtmpobj1.TableBorder\nOOtmpobj3 = OOtmpobj2.HorizontalLine\nOOtmpobj3\\2\nOOtmpobj2.HorizontalLine = OOtmpobj3\nOOtmpobj1.TableBorder = OOtmpobj2" AddSubst {End With} {End With[EW]} #Other formatting: AddSubst {\.Font\.Size} {.CharHeight} AddSubst {\.Font\.Bold = True} {.CharWeight = 150} AddSubst {\.Font\.Bold = False} {.CharWeight = 100} AddSubst {\.Font\.Italic = True} {.CharPosture = 2} AddSubst {\.Font\.Italic = False} {.CharPosture = 0} AddSubst {\.RowHeight = (\d+)} {.Rows.Height = \1 * 35.27778} AddSubst {\.MergeCells = (\w+)} {.Merge(\1)} AddSubst {\.Merge$} {.Merge(True)} AddSubst {\.Interior\.ColorIndex = (.+)$} {.CellBackColor = CIndex2RGB(\1)} AddSubst {\.Font\.ColorIndex = (.+)$} {.CharColor = CIndex2RGB(\1)} AddSubst {\.ColorIndex = xlAutomatic} {\.Color = 0} AddSubst {\.Weight = xlThin} {.OuterLineWidth = 20} AddSubst {\.HorizontalAlignment = xlRight} {.HoriJustify = 0} AddSubst {\.HorizontalAlignment = xlLeft} {.HoriJustify = 1} AddSubst {\.HorizontalAlignment = xlCenter} {.HoriJustify = 2} AddSubst {\.HorizontalAlignment = xlJustify} {.HoriJustify = 4} #NumberFormats. Must re-fix them, as result is almost the same: AddSubst {\.NumberFormat = \[S\]} {.NumberFormat = [CF [S]]} #Selection: AddSubst {Selection\.Delete Shift:=xlUp$} {ThisComponent.CurrentController.ActiveSheet.RemoveRange(ThisComponent.getCurrentSelection.RangeAddress, com.sun.star.sheet.CellDeleteMode.UP)} AddSubst {Selection\.Delete Shift:=xlToLeft$} {ThisComponent.CurrentController.ActiveSheet.RemoveRange(ThisComponent.getCurrentSelection.RangeAddress, com.sun.star.sheet.CellDeleteMode.LEFT)} AddSubst {(\S+)\.Select$} {ThisComponent.CurrentController.Select(\1)} #WorkSheets: AddSubst {^Sheets\(\[S\]\)} {ThisComponent.Sheets.getByName([S])} AddSubst {([ \(])Sheets\(\[S\]\)} {\1ThisComponent.Sheets.getByName([S])} AddSubst {^Sheets\((\w+)\)} {ThisComponent.Sheets.getByIndex([C \1])} AddSubst {([ \(])Sheets\((\w+)\)} {\1ThisComponent.Sheets.getByIndex([C \2])} AddSubst {\.Worksheets\(\[S\]\)} {.Sheets.getByName([S])} AddSubst {\.Worksheets\((\w+)\)} {.Sheets.getByIndex([C \1])} #Rows access is tricky: AddSubst {\.Rows\((.+)\)\.Delete Shift:=xl.+$} {.GetRows().RemoveByIndex([RD \1])} #This is quite another thing: AddSubst {\.Rows\((.+?)\)\.} {.getCellRangeByName([RA \1]).} AddSubst {\.Columns\((.+?)\)\.} {.Columns([C \1]).} #Ranges: AddSubst {As Range} {As Object} AddSubst {\.Range\((.+)\)\.Value = (\w+)$} {.Range(\1).setDataArray(\2)} #Deletion first: AddSubst {(.+)\.Range\((.+)\)\.Delete Shift:=xlToLeft} {\1.RemoveRange(\1.Range(\2).RangeAddress, com.sun.star.sheet.CellDeleteMode.LEFT)} AddSubst {(.+)\.Range\((.+)\)\.Delete Shift:=xlUp} {\1.RemoveRange(\1.Range(\2).RangeAddress, com.sun.star.sheet.CellDeleteMode.UP)} #Multiple ranges: AddSubst {Set (.+) = Union\(\1, (.+)\)$} {\1.addRangeAddress(\2.RangeAddress, false)} #ANY range assigment -> multiple range: AddSubst {Set (.+) = (.+\.Range\(.+\))$} "\\1 = ThisComponent.createInstance(\"com.sun.star.sheet.SheetCellRanges\")\n\\1.addRangeAddress(\\2.RangeAddress, false)" #Usual manipulation then: AddSubst { Range\(} { ThisComponent.CurrentController.ActiveSheet.Range(} AddSubst {^Range\(} {ThisComponent.CurrentController.ActiveSheet.Range(} AddSubst {\.Range\(\.?Cells\((.+?), (.+?)\), \.?Cells\((.+?), (.+?)\)\)} {.getCellRangeByPosition([C {\2}], [C {\1}], [C {\4}], [C {\3}])} AddSubst {\.Range\(} {.getCellRangeByName(} #Cell values must be DECREASED by ONE to please OO: AddSubst {([ \(])Cells\.} {\1ThisComponent.CurrentController.ActiveSheet.} AddSubst {([ \(])Cells\)} {\1ThisComponent.CurrentController.ActiveSheet)} AddSubst {([ \(])Cells\(} {\1ThisComponent.CurrentController.ActiveSheet.Cells(} AddSubst {^Cells\(} {ThisComponent.CurrentController.ActiveSheet.Cells(} AddSubst {\.Cells\((.+?), (.+?)\)\.Value} {.getCellByPosition([C {\2}], [C {\1}]).FormulaLocal} AddSubst {\.Cells\((.+?), (.+?)\)\.} {.getCellByPosition([C {\2}], [C {\1}]).} #Misc: AddSubst {.Clear$} {.clearContents(com.sun.star.sheet.CellFlags.VALUE + com.sun.star.sheet.CellFlags.STRING + com.sun.star.sheet.CellFlags.DATETIME + com.sun.star.sheet.CellFlags.ANNOTATION + com.sun.star.sheet.CellFlags.FORMULA + com.sun.star.sheet.CellFlags.HARDATTR + com.sun.star.sheet.CellFlags.STYLES + com.sun.star.sheet.CellFlags.OBJECTS + com.sun.star.sheet.CellFlags.EDITATTR)} AddSubst {.ClearContents$} {.clearContents(com.sun.star.sheet.CellFlags.VALUE + com.sun.star.sheet.CellFlags.STRING +com.sun.star.sheet.CellFlags.DATETIME)} AddSubst {ThisComponent\.ScreenUpdating = False} "ThisComponent.LockControllers\nThisComponent.CurrentController.Frame.ContainerWindow.Enable = False" AddSubst {ThisComponent\.ScreenUpdating = True} "ThisComponent.UnLockControllers\nThisComponent.CurrentController.Frame.ContainerWindow.Enable = True" AddSubst {(\w+)\.Show} "ActiveDialog = CreateUnoDialog(DialogLibraries.Standard.\\1)\n\\1.UserForm_Activate()\nActiveDialog.execute()" AddSubst {Unload Me} {ActiveDialog.EndExecute()} AddSubst {UserForm\w+\.Caption = } {ActiveDialog.Title = } AddSubst {\.StatusBar = (.+)$} {.CurrentController.StatusIndicator.Start(\1,0)} #This also registers subst for recordset: AddSubst {Dim (.+) As ADODB\.Recordset} {Dim \1 As Object[AR {\1}]} AddSubst {As ADODB\.\w+} {As Object} AddSubst {As Currency} {As Double} AddSubst {As WorkSheet} {As Object} AddSubst {As MSComctlLib\.\w+} {As Object} #This fixes frequent error in VBA programs, but can introduce it instead: AddSubst {(Dim|Public|Private) (?!Sub|Function)(.+,.+ As .+)$} {[CDim \1 {\2}]} AddSubst {ActiveWorkbook.Name} {FileNameOutOfPath(ThisComponent.getURL())} AddSubst {ActiveWorkbook.Path} {ConvertFromURL(DirectoryNameoutofPath(ThisComponent.getURL(), "/"))} AddSubst {\.Visible} {.isVisible} #Databases: AddSubst {conn\.Open (.+)$} "DataSource = createUnoService(\"com.sun.star.comp.dba.ODatabaseSource\")\nDataSource.URL = \"sdbc:ado:\" \\& \\1\nconn = DataSource.GetConnection(\"\", \"\")" #Not good, but still acceptable: AddSubst {Module1.conn.ConnectionString = (.+)$} "DataSource = createUnoService(\"com.sun.star.comp.dba.ODatabaseSource\")\nDataSource.URL = \"sdbc:ado:\" \\& \\1\nModule1.conn = DataSource.GetConnection(\"\", \"\")" #Destroyed, as ConnectionString must be set before: AddSubst {.+conn\.Open$} {} AddSubst {conn\.State = adStateClosed} {conn.isClosed()} AddSubst {conn\.State <> adStateClosed} {Not conn.isClosed()} AddSubst {Module1\.conn\.State <> adStateClosed} {Not Module1.conn.isClosed()} AddSubst {\.EOF} {.isAfterLast} AddSubst {\.MoveNext} {.next} #Field values (by name): AddSubst {CDbl\((\w+?)\.Fields\.Item\(\[S\]\)\.Value\)} {\1.Columns.getbyName([U [S]]).Double} AddSubst {CDate\((\w+?)\.Fields\.Item\(\[S\]\)\.Value\)} {\1.Columns.getbyName([U [S]]).Date} AddSubst {CStr\((\w+?)\.Fields\.Item\(\[S\]\)\.Value\)} {\1.Columns.getbyName([U [S]]).String} AddSubst {CInt\((\w+?)\.Fields\.Item\(\[S\]\)\.Value\)} {\1.Columns.getbyName([U [S]]).Int} AddSubst {CLng\((\w+?)\.Fields\.Item\(\[S\]\)\.Value\)} {\1.Columns.getbyName([U [S]]).Int} #Field values (by index): AddSubst {CDbl\((\w+?)\.Fields\.Item\(([^)]+?)\)\.Value\)} {\1.getDouble([CR {\2}])} AddSubst {CDate\((\w+?)\.Fields\.Item\(([^)]+?)\)\.Value\)} {\1.getDate([CR {\2}])} AddSubst {CStr\((\w+?)\.Fields\.Item\(([^)]+?)\)\.Value\)} {\1.getString([CR {\2}])} AddSubst {CLng\((\w+?)\.Fields\.Item\(([^)]+?)\)\.Value\)} {\1.getInt([CR {\2}])} AddSubst {CInt\((\w+?)\.Fields\.Item\(([^)]+?)\)\.Value\)} {\1.getInt([CR {\2}])} #This uses accessory function to shimmer to number or date, if possible: AddSubst {(\w+)\.Fields\.Item\(\[S\]\)\.Value} {FixType(\1.Columns.getbyName([U [S]]).string)} AddSubst {(\w+)\.Fields\.Item\(([^)]+?)\)\.Value} {FixType(\1.getString([CR {\2}]))} #Count of fields: AddSubst {\.Fields\.Count} {.Columns.Count} #Not correct, but can be tolerated (multiline fails): AddSubst {\.CommandText = (.+)$} "Statement = conn.createStatement()\nStatement.QueryTimeOut = 0\nStatement.executeUpdate(\\1)\nStatement.close()" ====== convmfix.tcl: ====== #convmfix.tcl #Tries to fix converted module: #1. Removes useless 'With / End With' #2. Deletes definitions of unused variables. #3. Tries to replace FixType with something sensible. #---------------------------------------------------------------- #AST is a list of nodes with structure: {root {children} {properties}} #B -- binary operator, U -- unary/binary operator, E -- end of expression, #UP --- unary preceeding. E -- end-of-expr. array set G_TokenTypes {+ U - U if E then E else E do E while E set E ^ B \ * B and B or B xor B mod B not UP & B imp B eqv B \ / B \\ B < B > B <= B >= B <> B = B ( ( ) ) , , : E \ with E case E select E do E new U . U dim E as B \ public E const E to B sub E function E on E end E \ error E resume E := B private E for E call E step E \ elseif E each E in E enum E exit E optional U} #Node types: A U B V ( () , P F( F() T array set G_OpPriorities {A 0 ( 0 F( 0 P 0 U 20 () 20 V 20 F() 20 to 1 \ imp 2 eqv 3 xor 4 or 5 and 6 not 7 \ < 8 <= 8 = 8 >= 8 > 8 <> 8 := 8 as 8 \ & 9 + 10 - 10 mod 11 \\ 12 * 13 / 13 ^ 14 . 15} #--------------------------------------------------------- #For it to work, should be no "Operator" eq "Token type" proc GetNodePriority {Node} { upvar AST AST foreach {NodeType OP} [lindex $AST $Node 2] break if {$NodeType eq "B"} { set Probe [string tolower $OP] } else { set Probe $NodeType } return $::G_OpPriorities($Probe) } proc DoUOpOrVConst {} { upvar AST AST ctype ctype Token Token CNode CNode CNodeType CNodeType set nnode [TreeCreateNode AST [list [string index $ctype 0] $Token]] #If after VConst, ReMake CNode into Proc: if {$CNodeType eq "V"} {lset AST $CNode 2 0 P} TreeLinkChild AST $CNode $nnode set CNode $nnode return } proc DoBinOp {} { upvar AST AST Token Token CNode CNode set nnode [TreeCreateNode AST [list B $Token]] set COPPriority [GetNodePriority $nnode] while {1} { set CNodeRoot [lindex $AST $CNode 0] set CRootNodePriority [GetNodePriority $CNodeRoot] if {$COPPriority>$CRootNodePriority} break set CNode $CNodeRoot } TreeInsertNodeAsRoot AST $CNode $nnode set CNode $nnode return } proc Line2AST {line} { global G_TokenTypes set InStrFlag 0 set sidx 0 #Parser flags and vars: set AST [list] set CNode [TreeCreateNode AST [list A A]] while {1} { if {![regexp -indices -start $sidx \ {:=|\<\>|\<=|\>=|[^ ]|[0-9]+?\.?[0-9]*?|\.[0-9]+?|[0-9a-zA-Z_]+?} $line Res]} break set Token [string trim [string range $line {*}$Res]] #Set current index after this token: set sidx [expr {[lindex $Res 1]+1}] if {$Token eq "\""} { #Must output string constant as whole at once: while {1} { set eidx [string first "\"" $line $sidx] if {$eidx==-1} {error "Unterminated string constant"} append Token [string range $line $sidx $eidx] set sidx [expr {$eidx+1}] if {[string index $line $sidx] eq "\""} { append Token "\"" incr sidx } else break } } if {$Token eq "'"} { set nnode [TreeCreateNode AST [list ' [string range $line $sidx-1 end]]] TreeLinkChild AST 0 $nnode break } #Now get token type: set lToken [string tolower $Token] if {[info exists G_TokenTypes($lToken)]} { set ctype $G_TokenTypes($lToken) } else { set ctype V } #Process token here: #Token types: U UP B V ( ) E , #Node types: A U B V ( () , P F( F() T set CNodeType [lindex $AST $CNode 2 0] switch -exact -- $ctype { UP - V { if {$CNodeType in [list () F()]} {error "Misplaced uop/vconst $Token"} DoUOpOrVConst } U { if {$CNodeType in [list V () F()]} { DoBinOp } else { DoUOpOrVConst } } B { if {$CNodeType ni [list V () F()]} {error "Misplaced binop $Token"} DoBinOp } ( { if {$CNodeType in [list () F()]} {error "Misplaced ("} if {$CNodeType eq "V"} { #Remake CNode into function: lset AST $CNode 2 0 F( } else { set nnode [TreeCreateNode AST [list ( (]] TreeLinkChild AST $CNode $nnode set CNode $nnode } } ) { if {$CNodeType in [list U B]} {error "Misplaced )"} while {[lindex $AST $CNode 2 0] ni [list ( F(]} { set CNode [lindex $AST $CNode 0] if {$CNode==-1} { #error "Unmatched )" ; #Relaxed TreeLinkChild AST 0 [TreeCreateNode AST [list T $Token]] set CNode 0 break } } if {$CNode>0} { set CNType [lindex $AST $CNode 2 0] lset AST $CNode 2 0 "$CNType)" } } E { if {$CNodeType eq "B"} { set ctype V DoUOpOrVConst } else { #Just add it to AST root: TreeLinkChild AST 0 [TreeCreateNode AST [list T $Token]] set CNode 0 } } , { if {$CNodeType in [list U B]} {error "Misplaced ,"} while {[lindex $AST $CNode 2 0] ni [list A P ( F(]} { set CNode [lindex $AST $CNode 0] } #If 'A' is reached, turn "," into terminal: if {[lindex $AST $CNode 2 0] eq "A"} { TreeLinkChild AST $CNode [TreeCreateNode AST [list T ,]] } } default { error "Unknown TOKEN type $ctype" } } } if {[lindex $AST $CNode 2 0] in [list U B]} { error "Operator at end of expression" } return $AST } #----- proc TreeCreateNode {treename props} { upvar $treename tree set idx [llength $tree] lappend tree [list -1 [list] $props] return $idx } proc TreeLinkChild {treename parent child} { upvar $treename tree if {$parent>[llength $tree]} {error "Parent $parent > nodes in tree"} if {$child>[llength $tree]} {error "Child $child > nodes in tree"} #Add child node into list of root nodes: set pchildren [lindex $tree $parent 1] if {[lsearch -exact $pchildren $child]!=-1} { error "$child is already child of $parent" } lappend pchildren $child lset tree $parent 1 $pchildren if {[lindex $tree $child 0] != -1} {error "Child $child already has parent"} lset tree $child 0 $parent return } # ->1 -> #A->2 => A-> # ->5 -> + ->5 proc TreeInsertNodeAsRoot {treename node newnode} { upvar $treename tree if {$node>[llength $tree]} {error "Node $node > nodes in tree"} if {$newnode>[llength $tree]} {error "Newnode $newnode > nodes in tree"} if {[llength [lindex $tree $newnode 1]]>0} {error "Newnode $newnode has children"} set NodeRoot [lindex $tree $node 0] if {$NodeRoot == -1} {error "Node $node has no root"} lset tree $newnode 0 $NodeRoot lset tree $node 0 $newnode lset tree $NodeRoot 1 end $newnode lset tree $newnode 1 $node return } proc AST2Line {AST} { set Line "" AST2LineWalkNode 0 return $Line } proc AST2LineWalkNode {nodeidx} { upvar AST AST Line Line foreach {Type Token} [lindex $AST $nodeidx 2] break switch -exact -- $Type { U { append Line $Token if {$Token ni [list . - +]} {append Line " "} AST2LineWalkNode [lindex $AST $nodeidx 1 0] } B { AST2LineWalkNode [lindex $AST $nodeidx 1 0] if {$Token in [list . := :]} { append Line $Token if {$Token eq ":"} {append Line " "} } else { append Line " " $Token " " } AST2LineWalkNode [lindex $AST $nodeidx 1 1] } T { if {$Token in [list , : )]} {set Line [string range $Line 0 end-1]} append Line $Token } ' - V { append Line $Token } F() { append Line $Token "(" set eidx [lindex $AST $nodeidx 1 end] foreach childidx [lindex $AST $nodeidx 1] { AST2LineWalkNode $childidx if {$childidx!=$eidx} { append Line ", " } } append Line ")" } F( { append Line $Token "(" set eidx [lindex $AST $nodeidx 1 end] foreach childidx [lindex $AST $nodeidx 1] { AST2LineWalkNode $childidx if {$childidx!=$eidx} { append Line ", " } } } P { #Don't add "," before comment: append Line $Token " " #Flag not first: set fnf 0 foreach childidx [lindex $AST $nodeidx 1] { if {$fnf } { if {[lindex $AST $childidx 2 0] ne "'"} { append Line "," } append Line " " } else { set fnf 1 } AST2LineWalkNode $childidx } } A { set eidx [lindex $AST $nodeidx 1 end] foreach childidx [lindex $AST $nodeidx 1] { AST2LineWalkNode $childidx if {$childidx!=$eidx} { append Line " " } } } ( { append Line "(" AST2LineWalkNode [lindex $AST $nodeidx 1 0] } () { append Line "(" AST2LineWalkNode [lindex $AST $nodeidx 1 0] append Line ")" } default { error "Unknown node type $Type" } } return } #Must find types of nodes, as much as possible. #Basic types are: Double (Int), String, Date and Unknown. #Types are created by some nodes and moved down and up the tree. proc InferTypesAST {AST} { set NodeTypes [lrepeat [llength $AST] U] InferASTNodeType 0 U return $NodeTypes } #Result type, then argument types: set G_FunTypes(fixtype) [list U S] set G_FunTypes(cstr) [list S U] set G_FunTypes(cdbl) [list N U] set G_FunTypes(cdate) [list D U] set G_FunTypes(cint) [list N U] set G_FunTypes(getdouble) [list N N] set G_FunTypes(getint) [list N N] set G_FunTypes(getstring) [list S N] set G_FunTypes(getdate) [list D N] set G_FunTypes(year) [list N D] set G_FunTypes(month) [list N D] set G_FunTypes(day) [list N D] set G_FunTypes(weekday) [list N D N] set G_FunTypes(round) [list N N N] set G_FunTypes(datediff) [list N S D D] set G_FunTypes(ubound) [list N U] set G_FunTypes(abs) [list N N] #E is error, otherwise it's root type. #If absent in the table, root type is unknown. set G_InferRoot(-,D,D) N set G_InferRoot(-,D,N) D set G_InferRoot(-,N,D) E set G_InferRoot(-,N,N) N set G_InferRoot(+,S,S) S set G_InferRoot(+,N,N) N set G_InferRoot(+,N,D) D set G_InferRoot(+,D,N) D set G_InferRoot(+,D,D) E proc InferASTNodeType {nodeidx RootType} { upvar AST AST NodeTypes NodeTypes global G_VarTypes G_FunTypes G_LocalVarTypes G_InferRoot foreach {CNodeType Token} [lindex $AST $nodeidx 2] break set Token [string tolower $Token] switch -exact $CNodeType { V { #VConst --- accepts type from root, and passes its type up (can #have type if Dim'ed or string/numeric constant). set SelfType U if {[info exists G_VarTypes($Token)]} { set SelfType $G_VarTypes($Token) } elseif {[info exists G_LocalVarTypes($Token)]} { set SelfType $G_LocalVarTypes($Token) } elseif {[string is double -strict $Token]} { set SelfType N } elseif {[string index $Token 0] eq "\""} { set SelfType S } if {$SelfType eq "U"} { lset NodeTypes $nodeidx $RootType return $RootType } if {$RootType eq "U"} { lset NodeTypes $nodeidx $SelfType return $SelfType } if {$SelfType!=$RootType} { error "Conflicting type for node $nodeidx: [lindex $AST $nodeidx]\n\ Root:$RootType\n $SelfType\n" } lset NodeTypes $nodeidx $SelfType return $SelfType } U { #Unary operators: + and - create, pass and return Numeric. #/CHECK/ What if line starts with "+"? if {$Token in [list + -]} { lset NodeTypes $nodeidx N if {$RootType ni [list N U]} { error "Conflicting type for node\ $nodeidx: [lindex $AST $nodeidx]\n\ Root:$RootType\n N\n" } set ChildType [InferASTNodeType [lindex $AST $nodeidx 1 0] N] if {$ChildType ne "N"} { error "Conflicting type for node\ $nodeidx: [lindex $AST $nodeidx]\n\ Child:$ChildType\n N\n" } return N } else { #/CHECK/ IT: InferASTNodeType [lindex $AST $nodeidx 1 0] U lset NodeTypes $nodeidx U return U } } B { # Operators + and - require complex processing. switch -exact $Token { + { foreach {ch1idx ch2idx} [lindex $AST $nodeidx 1] break if {$RootType eq "S"} { #Both children must be strings: set ChildType1 [InferASTNodeType $ch1idx S] set ChildType2 [InferASTNodeType $ch2idx S] set res S } elseif {$RootType eq "N"} { #Both children must be numbers: set ChildType1 [InferASTNodeType $ch1idx N] set ChildType2 [InferASTNodeType $ch2idx N] set res N } else { set ChildType1 [InferASTNodeType $ch1idx U] set ChildType2 [InferASTNodeType $ch2idx U] #Infer children: #If S,U or U,S -> set another=S if {$ChildType1 eq "S" && $ChildType2 eq "U"} { set ChildType2 [InferASTNodeType $ch2idx S] } if {$ChildType1 eq "U" && $ChildType2 eq "S"} { set ChildType1 [InferASTNodeType $ch1idx S] } #If RootType is D, can infer other child: if {$RootType eq "D"} { if {$ChildType1 eq "U" && $ChildType2 eq "D"} { set ChildType1 [InferASTNodeType $ch1idx N] } if {$ChildType1 eq "D" && $ChildType2 eq "U"} { set ChildType2 [InferASTNodeType $ch2idx N] } } #Infer/check RootType: if {($ChildType1 eq "S" && $ChildType2 ne "S") || ($ChildType1 ne "S" && $ChildType2 eq "S")} { error "Conflicting type for node $nodeidx:\ [lindex $AST $nodeidx]\n\ 1:$ChildType1\n 2:$ChildType2\n" } set res U if {[info exists G_InferRoot(+,$ChildType1,$ChildType2)]} { set res $G_InferRoot(+,$ChildType1,$ChildType2) if {$res eq "E"} { error "Conflicting type for node $nodeidx:\ [lindex $AST $nodeidx]\n\ 1:$ChildType1\n 2:$ChildType2\n" } } } #Check if RootType conflicts infered: if {$RootType ne "U" && $res ne "U" && $RootType ne $res} { error "Conflicting type for node $nodeidx:\ [lindex $AST $nodeidx]\n\ RootType:$RootType\n Inf.Root:$res\n" } lset NodeTypes $nodeidx $res return $res } - { if {$RootType eq "S"} { error "Conflicting type for node $nodeidx:\ [lindex $AST $nodeidx]\n\ Root:$RootType\n" } foreach {ch1idx ch2idx} [lindex $AST $nodeidx 1] break #So, if RootType is D, use it to infer: if {$RootType eq "D"} { set ChildType1 [InferASTNodeType $ch1idx D] set ChildType2 [InferASTNodeType $ch2idx N] set res D } else { set ChildType1 [InferASTNodeType $ch1idx U] set ChildType2 [InferASTNodeType $ch2idx U] #In this case: U,D => D,D->N if {$ChildType1 eq "U" && $ChildType2 eq "D"} { set ChildType1 [InferASTNodeType $ch1idx D] } #In this case: N,U => N,N->N if {$ChildType1 eq "N" && $ChildType2 eq "U"} { set ChildType2 [InferASTNodeType $ch2idx N] } #Check/infer root type: if {$ChildType1 eq "S" || $ChildType2 eq "S"} { error "Conflicting type for node $nodeidx:\ [lindex $AST $nodeidx]\n\ 1:$ChildType1\n 2:$ChildType2\n" } set res U if {[info exists G_InferRoot(-,$ChildType1,$ChildType2)]} { set res $G_InferRoot(-,$ChildType1,$ChildType2) if {$res eq "E"} { error "Conflicting type for node $nodeidx:\ [lindex $AST $nodeidx]\n\ 1:$ChildType1\n 2:$ChildType2\n" } } } #Check if RootType conflicts infered: if {$RootType ne "U" && $res ne "U" && $RootType ne $res} { error "Conflicting type for node $nodeidx:\ [lindex $AST $nodeidx]\n\ RootType:$RootType\n Inf.Root:$res\n" } lset NodeTypes $nodeidx $res return $res } ^ - * - \\ - to - and - or - xor - imp - eqv - mod - / { #Root must be U or N: if {$RootType ni [list U N]} { error "Conflicting type for node $nodeidx: [lindex $AST $nodeidx]\n\ Root:$RootType\n N\n" } lset NodeTypes $nodeidx N foreach childidx [lindex $AST $nodeidx 1] { set ChildType [InferASTNodeType $childidx N] if {$ChildType ne "N"} { error "Conflicting type returned: $ChildType" } } return N } & { #Root must be U or S: if {$RootType ni [list U S]} { error "Conflicting type for node $nodeidx: [lindex $AST $nodeidx]\n\ Root:$RootType\n S\n" } lset NodeTypes $nodeidx S foreach childidx [lindex $AST $nodeidx 1] { set ChildType [InferASTNodeType $childidx S] if {$ChildType ne "S"} { error "Conflicting type returned: $ChildType" } } return S } . { #Must transfer type of root to right child, and raise from it: foreach {ch1idx ch2idx} [lindex $AST $nodeidx 1] break InferASTNodeType $ch1idx U set ChildType2 [InferASTNodeType $ch2idx $RootType] if {$RootType ne "U" && $ChildType2 ne "U" \ && $RootType ne $ChildType2} { error "Conflicting type for node $nodeidx: [lindex $AST $nodeidx]\n\ Root:$RootType\n ChildType2:$ChildType2\n" } lset NodeTypes $nodeidx $ChildType2 return $ChildType2 } < - > - <= - >= - <> - = { #Root must be U or N: if {$RootType ni [list U N]} { error "Conflicting type for node $nodeidx: [lindex $AST $nodeidx]\n\ Root:$RootType\n N\n" } lset NodeTypes $nodeidx N #All children must be of the same type: foreach {ch1idx ch2idx} [lindex $AST $nodeidx 1] break set ChildType1 [InferASTNodeType $ch1idx U] #Use infered type right now: set ChildType2 [InferASTNodeType $ch2idx $ChildType1] if {$ChildType1 ne "U" && $ChildType2 ne "U"} { if {$ChildType1 ne $ChildType2} { error "Conflicting type for children of\ node $nodeidx: [lindex $AST $nodeidx]\n\ 1:$ChildType1\n 2:$ChildType2\n" } return N } if {$ChildType1 eq "U" && $ChildType2 eq "U"} {return N} #So, just one of them is "U": if {$ChildType1 eq "U"} { set ChildType1 [InferASTNodeType $ch1idx $ChildType2] } else { set ChildType2 [InferASTNodeType $ch2idx $ChildType1] } if {$ChildType1 ne "U" && $ChildType2 ne "U"} { if {$ChildType1 ne $ChildType2} { error "Conflicting type for children of\ node $nodeidx: [lindex $AST $nodeidx]\n\ 1:$ChildType1\n 2:$ChildType2\n" } } return N } default { #Don't care, just pass inferation down: foreach chidx [lindex $AST $nodeidx 1] { InferASTNodeType $chidx U } return U } } } F() - F( { #Some functions set types of their arguments (use lists of types). #Types DON'T pass thru them, but can be set on it if return type is U. #Examples: Date DateSerial(Int, Int, Int), Variant FixType(Variant) if {[info exists G_FunTypes($Token)]} { set FType [lindex $G_FunTypes($Token) 0] set NumChildren [llength [lindex $AST $nodeidx 1]] set ArgTypes [lrange $G_FunTypes($Token) 1 $NumChildren] if {$FType eq "U"} { lset NodeTypes $nodeidx $RootType } else { lset NodeTypes $nodeidx $FType if {$FType ne "U" && $RootType ne "U" && $FType ne $RootType} { error "Conflicting type for node\ $nodeidx: [lindex $AST $nodeidx]\n\ Root: $RootType\n $FType\n" } } foreach childidx [lindex $AST $nodeidx 1] childtype $ArgTypes { InferASTNodeType $childidx $childtype } return [lindex $NodeTypes $nodeidx] } else { #Accepts and returns root type: lset NodeTypes $nodeidx $RootType foreach childidx [lindex $AST $nodeidx 1] { InferASTNodeType $childidx U } return $RootType } } ( - () { #Just pass types up and down: set ChildType [InferASTNodeType [lindex $AST $nodeidx 1 0] $RootType] if {$ChildType ne "U" && $RootType ne "U" && $ChildType ne $RootType} { error "Conflicting type for node $nodeidx: [lindex $AST $nodeidx]\n\ Root:$RootType\n $ChildType\n" } if {$RootType ne "U"} { set SelfType $RootType } else { set SelfType $ChildType } lset NodeTypes $nodeidx $SelfType return $SelfType } A - P - T { #Root, Terminals and Procs generate unknowns, passing them down. #They are impassable up. lset NodeTypes $nodeidx U foreach childidx [lindex $AST $nodeidx 1] { InferASTNodeType $childidx U } return U } } } #This must return new string with FixType replaced, if possible: proc RemoveFixType {AST NodeTypes} { RemoveFixNode 0 return $AST } proc RemoveFixNode {nodeidx} { upvar AST AST NodeTypes NodeTypes foreach {Type Token} [lindex $AST $nodeidx 2] break if {$Type in [list F() F(] && [string tolower $Token] eq "fixtype" \ && [lindex $NodeTypes $nodeidx] ne "U"} { #So, this FixType can be replaced: set FtRoot [lindex $AST $nodeidx 0] set FtChild [lindex $AST $nodeidx 1 0] set NewFtRootChildren [list] foreach nidx [lindex $AST $FtRoot 1] { if {$nidx == $nodeidx} {set nidx $FtChild} lappend NewFtRootChildren $nidx } lset AST $FtRoot 1 $NewFtRootChildren lset AST $FtChild 0 $FtRoot #"getstring" node index: set getstridx [lindex $AST $FtChild 1 1] set NewType [lindex $NodeTypes $nodeidx] set NewFunc getString switch -exact -- $NewType { N {set NewFunc getDouble} D {set NewFunc getDate} } lset AST $getstridx 2 1 $NewFunc } #Remove unneeded conversions, too: if {$Type in [list F() F(] \ && [string tolower $Token] in [list cdbl cstr cdate]} { set FunType [lindex $::G_FunTypes([string tolower $Token]) 0] set ConvChild [lindex $AST $nodeidx 1 0] if {[lindex $NodeTypes $ConvChild] eq $FunType} { lset AST $nodeidx 2 [list () (] } } foreach chidx [lindex $AST $nodeidx 1] { RemoveFixNode $chidx } return } #---------------------------------------------------------------- proc StartWith {line} { upvar WithsLevel WithsLevel NoWithUseFlag NoWithUseFlag WithsStack WithsStack upvar WithStart WithStart CLines CLines lappend WithsStack $WithStart $CLines $NoWithUseFlag incr WithsLevel set WithStart $line set NoWithUseFlag 1 set CLines "" } proc EndWith {line} { upvar WithsLevel WithsLevel NoWithUseFlag NoWithUseFlag WithsStack WithsStack upvar WithStart WithStart CLines CLines if {!$WithsLevel} {error "Unclosed WITH!"} set CClines $CLines set CNoWithUseFlag $NoWithUseFlag set CWithStart $WithStart lassign [lrange $WithsStack end-2 end] WithStart CLines NoWithUseFlag set WithsStack [lrange $WithsStack 0 end-3] if {$CNoWithUseFlag} { append CLines $CClines } else { append CLines $CWithStart "\n" append CLines $CClines append CLines $line "\n" } incr WithsLevel -1 } proc FixModuleFile {fname ofname} { global G_Cfdata set fd [open $fname] fconfigure $fd -encoding cp1251 set fdata [read $fd] close $fd set G_Cfdata "" set WithsLevel 0 set NoWithUseFlag 1 set CLines "" set WithStart "" set WithsStack [list] foreach nline [split $fdata "\n"] { #Check first, as it can be: "With .Something" if {[regexp {[ \t(]\.} $nline]} {set NoWithUseFlag 0} if {[regexp {^[ \t]*With } $nline]} { StartWith $nline continue } if {[regexp {^[ \t]*End With$} $nline]} { EndWith $nline if {!$WithsLevel} { append G_Cfdata $CLines set CLines "" } continue } #It's usual line here: if {$WithsLevel} { append CLines $nline "\n" } else { append G_Cfdata $nline "\n" } } RemoveUnusedVariables ReplaceFixTypes ReIndentModule set ofd [open $ofname w] fconfigure $ofd -encoding cp1251 puts -nonewline $ofd $G_Cfdata close $ofd } proc ConvTypeName2Type {TypeName} { switch -exact -- $TypeName { Double {set VarType N} Integer {set VarType N} Byte {set VarType N} Long {set VarType N} Boolean {set VarType N} String {set VarType S} Date {set VarType D} default {set VarType U} } return $VarType } proc ReplaceFixTypes {} { global G_Cfdata G_VarTypes G_LocalVarTypes G_FunTypes set State 0 set odata "" set FlagCollectFun 0 set funline "" foreach nline [split $G_Cfdata "\n"] { #Start processing the line: #Try to collect multiline functions: if {$FlagCollectFun \ || [regexp -nocase {^\s*(?:Private )?Function } $nline]} { set State 1 #Get this function name and types here, if possible: append funline " " $nline if {[string index $nline end] eq "_"} { set FlagCollectFun 1 } else { set FlagCollectFun 0 set fargs [list] #So, function ended, process it: #Get its name first: regexp {Function (\w+)} $funline All FName set FName [string tolower $FName] #Basic units are: "VarName as SomeType" set sidx 0 while {1} { if {![regexp -indices -start $sidx \ {(?:\w+) As (\w+)} $funline All VTypeI]} break set sidx [expr {[lindex $All 1]+1}] set VType [string range $funline {*}$VTypeI] lappend fargs [ConvTypeName2Type $VType] } #Not get funtion type: ") as SomeType" regexp -start $sidx {\) As (\w+)} $funline All VType set G_FunTypes($FName) [linsert $fargs 0 [ConvTypeName2Type $VType]] set funline "" } #Anyway: append odata $nline "\n" continue } if {[regexp -nocase {^\s*(?:Private )?Sub } $nline]} { set State 1 append odata $nline "\n" continue } if {[regexp {^\s*End (?:Function|Sub)} $nline]} { unset -nocomplain G_LocalVarTypes set State 0 append odata $nline "\n" continue } #Arrays are defined as functions (can cause subtle bugs if global #array is redefined as local in some sub/function): if {[regexp -nocase {^\s*(?:Dim|Public) (\w+)\(.*\) As (\w+)} \ $nline All VName VType]} { set FName [string tolower $VName] set FType [ConvTypeName2Type $VType] set G_FunTypes($FName) [list $FType N N N N N] append odata $nline "\n" continue } if {[regexp -nocase {^\s*(?:Dim|Public|Private) (\w+)[^()]* As (\w+)} \ $nline All VName VType]} { set VName [string tolower $VName] set VarType [ConvTypeName2Type $VType] if {$VarType ne "U"} { if {$State} { set G_LocalVarTypes($VName) $VarType } else { set G_VarTypes($VName) $VarType } } append odata $nline "\n" continue } if {[regexp -nocase {fixtype\(} $nline]} { set AST [Line2AST $nline] set NodeTypes [InferTypesAST $AST] set AST [RemoveFixType $AST $NodeTypes] set nline [AST2Line $AST] } append odata $nline "\n" } set G_Cfdata $odata } proc RemoveUnusedVariables {} { global G_Cfdata set CLineNum 0 set LinesToRemove [list] #In global definitions: set State 0 #Global and local REs: set GRE "" set LRE "" foreach nline [split $G_Cfdata "\n"] { incr CLineNum #Remove string constants: set nline [regsub -all {"[^\"]*"} $nline {}] #As strings are removed now, take out comment: set CSt [string first ' $nline] if {$CSt != -1} { set nline [string range $nline 0 $CSt-1] } #Start processing the line: if {[regexp -nocase {^\s*(?:Function|Sub) } $nline]} { set State 1 continue } if {[regexp {^\s*End (?:Function|Sub)} $nline]} { #Must mark all lines, clear LocalArray and LRE: foreach {Name Idx} [array get LocalArray] { lappend LinesToRemove $Idx } array unset LocalArray set LRE "" set State 0 continue } if {[regexp -nocase {^\s*(?:Dim|Public) (\w+).* As .+} $nline All VName]} { set VName [string tolower $VName] if {$State} { #Local: set LocalArray($VName) $CLineNum if {$LRE eq ""} { set LRE "\\m$VName\\M" } else { append LRE "|\\m$VName\\M" } } else { #Global: set GlobalArray($VName) $CLineNum if {$GRE eq ""} { set GRE "\\m$VName\\M" } else { append GRE "|\\m$VName\\M" } } continue } if {$GRE ne ""} { foreach VName [regexp -nocase -inline -all $GRE $nline] { unset -nocomplain GlobalArray([string tolower $VName]) } } if {$LRE ne ""} { foreach VName [regexp -nocase -inline -all $LRE $nline] { unset -nocomplain LocalArray([string tolower $VName]) } } } foreach {Name Idx} [array get GlobalArray] { lappend LinesToRemove $Idx } #Sort, then strip lines marked for deletion: set LinesToRemove [lsort -integer $LinesToRemove] set odata "" set CLineNum 0 set CIndex 0 set CLineToRemove [lindex $LinesToRemove $CIndex] foreach nline [split $G_Cfdata "\n"] { incr CLineNum if {$CLineNum == $CLineToRemove} { incr CIndex set CLineToRemove [lindex $LinesToRemove $CIndex] continue } append odata $nline "\n" } #Set result as new data: set G_Cfdata $odata } FixModuleFile [lindex $argv 0] [lindex $argv 1] ====== <>Enter Category Here