Option Explicit Public Const SBOVERWRITEUNDEFINED as Integer = 0 Public Const SBOVERWRITECANCEL as Integer = 2 Public Const SBOVERWRITEQUERY as Integer = 7 Public Const SBOVERWRITEALWAYS as Integer = 6 Public AbsTemplateFound as Integer Public AbsDocuFound as Integer Public oLogDocument as Object Public oLogTable as Object Public bLogExists as Boolean Public sComment as String Public bInsertRow as Boolean Public sLogUrl as String Public sCurPassWord as String Public FileCount as Integer Function ReadApplicationDirectories(ApplIndex as Integer, FilesList(),bIsDocument as Boolean, sFiltername()) as Integer Dim bCheckDocuType as Boolean Dim FilterIndex as Integer Dim bRecursive as Boolean Dim sSourceDir as String Dim bCheckRealType as Boolean Dim a as Integer Dim sFileContent() as String Dim NewList() as String Dim Index as Integer Dim sLocExtension as String Index = Applications(ApplIndex,SBAPPLKEY) sLocExtension = "" If bIsDocument Then bCheckDocuType = Applications(ApplIndex,SBDOCCONVERT) bCheckRealType = False bRecursive = Applications(ApplIndex,SBDOCRECURSIVE) FilterIndex = Index sSourceDir = Applications(ApplIndex,SBDOCSOURCE) Else ' Templates bCheckDocuType = Applications(ApplIndex,SBTEMPLCONVERT) ' In SO the documenttype cannot be derived from the extension name bCheckRealType = WizardMode = SBXMLMODE If bCheckRealType Then ' Note: StarOffice-Math-Documents cannot be treated like templates bCheckRealType = Index <> 3 If bCheckRealType Then sLocExtension = "vor" End If bIsDocument = Not bCheckRealType End If bRecursive = Applications(ApplIndex,SBTEMPLRECURSIVE) FilterIndex = Index + MaxApplCount sSourceDir = Applications(ApplIndex,SBTEMPLSOURCE) End If If bCheckDocuType Then sFileContent() = GetMimeTypeList(sFilterName(FilterIndex)) NewList() = ReadDirectories(sSourceDir, bRecursive, bCheckRealType, False, sFileContent(), sLocExtension) If Ubound(NewList()) > -1 Then AddListtoFilesList(FilesList(), NewList(), ApplIndex) ImportDialog.LabelRetrieval.Label = sProgressPage_2 & " " & ReplaceString(sProgressPage_5, Str(Ubound(FilesList()) + 1) & " ", "%1") End If End If ReadApplicationDirectories() = Ubound(NewList(),1) + 1 End Function Sub ShowCurrentProgress(bIsDocument as Boolean, CurFound as Integer) If bIsDocument Then AbsDocuFound = AbsDocuFound + CurFound ImportDialog.LabelCurDocumentRetrieval.Label = sProgressFound & " " & CStr(AbsDocuFound) & " " & sProgressMoreDocs Else AbsTemplateFound = AbsTemplateFound + CurFound ImportDialog.LabelCurTemplateRetrieval.Label = sProgressFound & " " & CStr(AbsTemplateFound) & " " & sProgressMoreTemplates End If End Sub Sub ConvertAllDocuments(sFilterName()) Dim FileProperties(2) as new com.sun.star.beans.PropertyValue Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue Dim OpenProperties(3) as new com.sun.star.beans.PropertyValue Dim FilesList(0,2) as String Dim sViewPath as String Dim i as Integer Dim FilterIndex as Integer Dim sFullName as String Dim sFileName as String Dim oDocument as Object Dim sExtension as String Dim OldExtension as String Dim CurFound as Integer Dim TotFound as Integer Dim TargetStemDir as String Dim SourceStemDir as String Dim TargetDir as String Dim TargetFile as String Dim CurFilterName as String Dim ApplIndex as Integer Dim Index as Integer Dim bIsDocument as Boolean Dim iGeneralOverwrite as Integer Dim bDoSave as Boolean Dim sCurFileExists as String Dim MaxFileIndex as Integer Dim bContainsBasicMacro as Boolean Dim bIsPassWordProtected as Boolean Dim iOverwrite as Integer iGeneralOverwrite = SBOVERWRITEUNDEFINED bConversionIsRunnig = True bLogExists = false AbsTemplateFound = 0 AbsDocuFound = 0 For i = 0 To ApplCount-1 'templates If bCancelTask Or RetValue = 0 Then bConversionIsRunnig = False Exit Sub End if bIsDocument = False CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName()) ShowCurrentProgress(bIsDocument, CurFound) Next i For i = 0 To ApplCount-1 'documents If bCancelTask Or RetValue = 0 Then bConversionIsRunnig = False Exit Sub End if bIsDocument = True CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName()) ShowCurrentProgress(bIsDocument, CurFound) Next i TotFound = AbsTemplateFound + AbsDocuFound If TotFound > 0 Then CreateLogDocument(OpenProperties()) InitializeProgressPage(ImportDialog) OpenProperties(0).Name = "Hidden" OpenProperties(0).Value = True OpenProperties(1).Name = "AsTemplate" OpenProperties(1).Value = False OpenProperties(2).Name = "MacroExecutionMode" OpenProperties(2).Value = com.sun.star.document.MacroExecMode.NEVER_EXECUTE OpenProperties(3).Name = "UpdateDocMode" OpenProperties(3).Value = com.sun.star.document.UpdateDocMode.NO_UPDATE MaxFileIndex = Ubound(FilesList(),1) FileCount = 0 For i = 0 To MaxFileIndex sComment = "" If bCancelTask Or RetValue = 0 Then bConversionIsRunnig = False Exit For End if bDoSave = True sFullName = FilesList(i,0) CurFiltername = GetFilterName(FilesList(i,1), sFilterName(), sExtension, FilterIndex) ApplIndex = FilesList(i,2) sViewPath = CutPathView(sFullName, 60) ImportDialog.LabelCurDocument.Label = Str(i+1) & "/" & MaxFileIndex + 1 & " (" & sViewPath & ")" oDocument = StarDesktop.LoadComponentFromURL(sFullName, "_blank", 0, OpenProperties()) If Not IsNull(oDocument) Then bIsPassWordProtected = CheckPassWordProtection(oDocument) End If If Not IsNull(oDocument) Then CheckIfMacroExists(oDocument, sComment) Select Case sExtension Case "sxw", "sxc", "sxi", "sxd", "sxs", "sxm" SourceStemDir = RTrimStr(Applications(ApplIndex,SBDOCSOURCE), "/") TargetStemDir = RTrimStr(Applications(ApplIndex,SBDOCTARGET), "/") Case Else ' Templates and Helper-Applications remain SourceStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLSOURCE), "/") TargetStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLTARGET), "/") End Select TargetFile = ReplaceString(sFullname, TargetStemDir, SourceStemDir) sFileName = GetFileNameWithoutExtension(TargetFile, "/") OldExtension = GetFileNameExtension(TargetFile) TargetFile = RTrimStr(TargetFile, OldExtension) TargetFile = TargetFile & sExtension TargetDir = RTrimStr(TargetFile, sFileName & "." & sExtension) If Not oUcb.Exists(TargetDir) Then CreateFolder(TargetDir) End If ' Todo: According to AS there might come a new feature that storeasUrl could possibly rise a UI dialog. ' In this case my own UI becomes obsolete If ((oUcb.Exists(TargetFile)) and (iGeneralOverwrite <> SBOVERWRITEALWAYS)) Then If (iGeneralOverwrite = SBOVERWRITEUNDEFINED) Then iGeneralOverWrite = Msgbox (sOverwriteallFiles, 32 + 3, sTitle) End If If ((iGeneralOverWrite = SBOVERWRITEQUERY) OR (iGeneralOverwrite = SBOVERWRITECANCEL)) Then sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(TargetFile), "<1>") sCurFileExists = ReplaceString(sCurFileExists, chr(13), "<CR>") iOverWrite = Msgbox (sCurFileExists, 32 + 3, sTitle) Select Case iOverWrite Case 1 ' OK ' In the FileProperty-Bean this is already default bDoSave = True Case 2 ' Abort CancelTask(False) bDoSave = False Case 7 ' No bDoSave = False End Select End If End If If bDoSave Then On Local Error Goto NOSAVING FileProperties(0).Name = "FilterName" FileProperties(0).Value = CurFilterName FileProperties(1).Name = "Overwrite" FileProperties(1).Value = True If bIsPassWordProtected Then FileProperties(2).Name = "PassWord" FileProperties(2).Value = sCurPassWord End If ' Todo: Make sure that an errorbox pops up when saving fails oDocument.StoreAsUrl(TargetFile,FileProperties()) NOSAVING: If Err <> 0 Then sCurcouldnotsaveDocument = ReplaceString(scouldnotsaveDocument, ConvertFromUrl(TargetFile), "<1>") sComment = ConcatComment(sComment, sCurCouldnotsaveDocument) Resume LETSGO LETSGO: Else FileCount = FileCount + 1 End If oDocument.Dispose() End If Else sCurcouldnotopenDocument = ReplaceString(scouldnotopenDocument, ConvertFromUrl(sFullName), "<1>") sComment = ConcatComment(sComment, sCurCouldnotopenDocument) TargetFile = "" End If InsertDocNamesToLogDocument(sFullName, TargetFile, sComment) Next i End If AddLogStatistics() FinalizeDialogButtons() bConversionIsRunnig = False Exit Sub RTError: Msgbox sRTErrorDesc, 16, sRTErrorHeader End Sub Sub AddListtoFilesList(FirstList(), SecList(), ApplIndex as Integer) Dim FirstStart as Integer, FirstEnd as Integer, i as Integer, s as Integer If FirstList(0,0) = "" Then FirstStart = Ubound(FirstList(),1) Else FirstStart = Ubound(FirstList(),1) + 1 End If FirstEnd = FirstStart + Ubound(SecList(),1) ReDim Preserve FirstList(FirstEnd,2) s = 0 For i = FirstStart To FirstEnd FirstList(i,0) = SecList(s,0) FirstList(i,1) = SecList(s,1) FirstList(i,2) = CStr(ApplIndex) s = s + 1 Next i End Sub Function GetTargetTemplatePath(Index as Integer) Select Case WizardMode Case SBMICROSOFTMODE GetTargetTemplatePath() = SOTemplatePath & "/" & sTemplateGroupName Case SBXMLMODE If Index = 3 Then ' Helper Application GetTargetTemplatePath = SOWorkPath Else GetTargetTemplatePath = SOTemplatePath End If End Select End Function ' Retrieves the second value for a next to 'SearchString' in ' a two-dimensional string-Array Function GetFilterName(sMimetypeorExtension as String, sFilterName(), sExtension as string, FilterIndex as Integer) as String Dim i as Integer Dim MaxIndex as Integer Dim sLocFilterlist() as String For i = 0 To Ubound(sFiltername(),1) If Instr(1,sFilterName(i,0),sMimeTypeOrExtension) <> 0 Then sLocFilterList() = ArrayoutofString(sFiltername(i,0),"|", MaxIndex) If MaxIndex = 0 Then sExtension = sFiltername(i,2) GetFilterName = sFilterName(i,1) Else Dim a as Integer Dim sLocExtensionList() as String a = SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList()) sLocFilterList() = ArrayoutofString(sFiltername(i,1),"|", MaxIndex) GetFilterName = sLocFilterList(a) sLocExtensionList() = ArrayoutofString(sFilterName(i,2), "|", MaxIndex) sExtension = sLocExtensionList(a) End If Exit For End If Next FilterIndex = i End Function Function SearchArrayforPartString(SearchString as String, LocList()) as Integer Dim i as integer For i = Lbound(LocList(),1) to Ubound(LocList(),1) If Instr(1,LocList(i), SearchString) <> 0 Then SearchArrayForPartString() = i Exit Function End if Next IndexinArray = -1 End Function Function GetMimeTypeList(BigFiltername as STring) Dim sBigList() as String Dim sSmallList() as String Dim sMimeTypeList() Dim BigMaxIndex as Integer Dim n as Integer sBigList() = ArrayoutofString(BigFilterName,"|", BigMaxIndex) For n = 0 To BigMaxIndex sSmallList() = ArrayoutofString(sBigList(n),";") sMimeTypeList() = AddListToList(sMimeTypeList(), sSmallList()) Next n GetMimetypeList() = sMimeTypeList() End Function Sub CreateLogDocument(HiddenProperties()) Dim OpenProperties(0) as new com.sun.star.beans.PropertyValue Dim oTableCursor as Object Dim oLogCursor as Object Dim oLogRows as Object Dim NoArgs() Dim i as Integer Dim bLogIsThere as Boolean If ImportDialog.chkLogfile.State = 1 Then i = 2 OpenProperties(0).Name = "Hidden" OpenProperties(0).Value = True oLogDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_blank", 4, OpenProperties()) oLogCursor = oLogDocument.Text.CreateTextCursor oLogTable = oLogDocument.CreateInstance("com.sun.star.text.TextTable") oLogTable.RepeatHeadline = true oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True) oLogCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor() oLogCursor.SetString(sSourceDocuments) oLogCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor() oLogCursor.SetString(sTargetDocuments) bInsertRow = False sLogUrl = SOWorkPath & "/Logfile.sxw" Do bLogIsThere = oUcb.Exists(sLogUrl) If bLogIsThere Then If i = 2 Then sLogUrl = ReplaceString(sLogUrl, "/Logfile_2.sxw", "/Logfile.sxw") Else sLogUrl = ReplaceString(sLogUrl, "/Logfile_" & cStr(i) & ".sxw", "/Logfile_" & cStr(i-1) & ".sxw") End If i = i + 1 End If Loop Until Not bLogIsThere bLogExists = True oLogDocument.StoreAsUrl(sLogUrl, NoArgs()) End If End Sub Sub InsertDocNamesToLogDocument(SourceUrl as String, TargetUrl as String, sComment as String) 'bContainsBasicMacro as Boolean Dim oCell as Object Dim oLogCursor as Object Dim UrlList(1) as String Dim LocFileName as String Dim LocUrl as String Dim i as Integer Dim oCommentCursor as Object If bLogExists Then If bInsertRow Then oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1) Else bInsertRow = True End If UrlList(0) = SourceUrl UrlList(1) = TargetUrl For i = 0 To 1 oCell = oLogTable.GetCellbyPosition(i,oLogTable.Rows.Count-1) If sComment <> "" Then If ((TargetUrl <>"") AND (i = 1)) Or ((TargetUrl = "") AND (i = 0)) Then oCommentCursor = oCell.createTextCursor() oCell.insertControlCharacter(oCommentCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False) oCell.insertString(oCommentCursor, sComment, false) End If End If LocUrl = UrlList(i) oLogCursor = oCell.createTextCursor() oLogCursor.CollapseToStart() oLogCursor.HyperLinkURL = LocUrl oLogCursor.HyperLinkName = LocUrl oLogCursor.HyperLinkTarget = LocUrl LocFileName = FileNameOutOfPath(LocUrl) oCell.InsertString(oLogCursor, LocFileName,False) Next i oLogDocument.Store() End If End Sub Sub AddLogStatistics() Dim oCell as Object Dim oLogCursor as Object Dim MaxRowIndex as Integer If bLogExists Then MaxRowIndex = oLogTable.Rows.Count sLogSummary = ReplaceString(sLogSummary, FileCount, "<COUNT>") oLogTable.Rows.InsertByIndex(MaxRowIndex, 1) oCell = oLogTable.GetCellbyPosition(0, MaxRowIndex) oLogCursor = oCell.createTextCursor() oCell.InsertString(oLogCursor, sLogSummary,False) MergeRange(oLogTable, oCell, 1) oLogDocument.Store() oLogDocument.Dispose() bLogExists = False End If End Sub ' This macro has to be reworked out again as it works with deprecated interfaces ' It can be completed as soon as Bug #93295 will be fixed because right now it ' is not possible to access BasicLibraries and DialogLibraries from outside the ' document Function CheckIfMacroExists(oDocument as Object, sComment as String) as Boolean Dim ModuleNames() as String Dim MaxIndex as Integer Dim oLibraryContainer as Object Dim bMacroExists as Boolean bMacroExists = False ' oLibraryContainer = oDocument.LibraryContainer ' If oLibraryContainer.hasElements Then ' ModuleNames = oDocument.LibraryContainer.ElementNames ' MaxIndex = Ubound(ModuleNames()) ' For i = 0 To MaxIndex ' oLibrary = oLibraryContainer.getByName(ModuleNames(i)) ' If Not IsNull(oLibrary.getDialogContainer) Then ' bMacroExists = True ' Exit Function ' End If ' If oLibrary.ModuleContainer.HasElements Then ' bMacroExists = True ' Exit Function ' End If ' Next i ' End If If bMacroExists = True Then ConcatComment(sComment, sReeditMacro) End If CheckIfMacroExists() = bMacroExists End Function Function CheckPassWordProtection(oDocument as Object) Dim bIsPassWordProtected as Boolean Dim i as Integer Dim oArgs() Dim MaxIndex as Integer bIsPassWordProtected = false oArgs() = oDocument.getArgs() MaxIndex = Ubound(oArgs()) For i = 0 To MaxIndex If oArgs(i).Name = "PassWord" Then bIsPassWordProtected = True sCurPassWord = oArgs(i).Value Exit For End If Next i CheckPassWordProtection() = bIsPassWordProtected End Function Sub OpenLogDocument() Dim NoArgs() as New com.sun.star.beans.PropertyValue OpenDocument(sLogUrl, NoArgs()) End Sub Sub MergeRange(oTable as Object, oCell as Object, MergeCount as Integer) Dim oTableCursor as Object oTableCursor = oTable.createCursorByCellName(oCell.CellName) oTableCursor.goRight(MergeCount, True) oTableCursor.mergeRange() End Sub Function ConcatComment(sComment as String, AdditionalComment as String) If sComment = "" Then sComment = AdditionalComment Else sComment = sComment & chr(13) + AdditionalComment End If ConcatComment = sComment End Function