Option Explicit Public AbsTemplateFound as Integer Public AbsDocuFound as Integer Public oLogDocument as Object Public oLogTable as Object 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 AddListtoList(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() as new com.sun.star.beans.PropertyValue Dim OpenProperties(0) 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 iOverWrite as Integer Dim bDoSave as Boolean Dim sCurFileExists as String Dim oTaskEnum as Object Dim oTask as Object Dim oModel as Object Dim oTaskController as Object Dim MaxFileIndex as Integer AbsTemplateFound = 0 AbsDocuFound = 0 For i = 0 To ApplCount-1 'templates bIsDocument = False CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName()) ShowCurrentProgress(bIsDocument, CurFound) Next i For i = 0 To ApplCount-1 'documents bIsDocument = True CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName()) ShowCurrentProgress(bIsDocument, CurFound) Next i TotFound = AbsTemplateFound + AbsDocuFound If TotFound > 0 Then bCallCancelMsg = True InitializeProgressPage(ImportDialog) OpenProperties(0).Name = "Hidden" OpenProperties(0).Value = True MaxFileIndex = Ubound(FilesList(),1) For i = 0 To MaxFileIndex bDoSave = True If bCancelTask Then Call CancelTask() End if 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 & ")" If i = 0 Then CreateLogDocument(OpenProperties()) End If oDocument = StarDesktop.LoadComponentFromURL(sFullName, "_blank", 0, OpenProperties()) If bSetFonts Then CheckScripts(oDocument, 1) End If If Not IsNull(oDocument) Then Select Case sExtension Case "sxw", "sxc", "sxi", "sxd", "sxs", "mml" 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 oUcb.CreateFolder(TargetDir) End If If oUcb.Exists(TargetFile) 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 bCallCancelMsg = False Exit For ' Call CancelTask() Case 7 ' No bDoSave = False End Select End If If bDoSave Then InsertDocNamesToLogDocument(i+1, sFullName, TargetFile On Local Error Resume Next ' Note: Files are automatically stored in Default format ' FileProperties(0).Name = "FilterName" ' FileProperties(0).Value = CurFilterName oDocument.StoreToUrl(TargetFile,FileProperties()) oDocument.Dispose() On Local Error Goto 0 End If ' oTaskenum = StarDesktop.Tasks.CreateEnumeration ' While oTaskEnum.HasmoreElements ' oTask = oTaskenum.NextElement ' If oTask.Name <> "" Then ' oTaskController = oTask.Controller ' PrintdbgInfo oTaskController ' If hasUnoInterfaces(oTaskController,"com.sun.star.frame.XModel") then ' oModel = oTaskController.Model ' If Ucase(oModel.Url) = Ucase(sFullName) Then ' oTask.Close ' End If ' End If ' End If ' Wend End If Next i ImportDialog.cbCancel.Label = sCloseButton Msgbox sReady, 64, sTitle bCallCancelMsg = False End If ' oLogDocument.Dispose() ' ImportDialogArea.endExecute ' ImportDialogArea.Dispose End Exit Sub RTError: Msgbox sRTErrorDesc, 16, sRTErrorHeader End Sub Sub AddListtoList(FirstList(), SecList(), ApplIndex as Integer) Dim FirstStart as Integer, FirstEnd as Integer, i as Integer, s as Integer FirstStart = Ubound(FirstList(),1) 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(Index) 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 sMimeTypeList() sMimeTypeList() = ArrayoutofString(BigFilterName,";") If Instr(sMimetypeList(0), "|") <> 0 Then sMimeTypeList() = ArrayoutofString(sMimeTypeList(0),"|") End If GetMimetypeList() = sMimeTypeList() End Function Sub CreateLogDocument(HiddenProperties()) Dim oTableCursor as Object Dim oLogCursor as Object Dim oLogRows as Object Dim sLogUrl as String Dim NoArgs() Dim i as Integer Dim bLogExists as Boolean If ImportDialog.chkLogfile.State = 1 Then i = 2 oLogDocument = StarDesktop.LoadComponentFromURL("private:factory/swriter", "_blank", 0, NoArgs())' HiddenProperties()) ' HiddenProperties()) oLogCursor = oLogDocument.Text.CreateTextCursor oLogTable = oLogDocument.CreateInstance("com.sun.star.text.TextTable") oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True) oLogCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor ' Todo: Strings in Resourcen oLogCursor.SetString(sSourceDocuments) oLogCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor oLogCursor.SetString(sTargetDocuments) sLogUrl = SOWorkPath & "/Logfile.sxw" Do bLogExists = oUcb.Exists(sLogUrl) If bLogExists 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 bLogExists ' Todo Für das Logdokument einen sinnigen Titel festlegen! oLogDocument.StoreToUrl(sLogUrl, NoArgs()) EndIf End Sub Sub InsertDocNamesToLogDocument(iRow as Integer, SourceUrl as String, TargetUrl as String) Dim oLogCursor as Object Dim UrlList(1) as String Dim LocFileName as String Dim LocUrl as String Dim i as Integer If ImportDialog.chkLogfile.State = 1 Then If iRow > 1 Then oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1) End If UrlList(0) = SourceUrl UrlList(1) = TargetUrl For i = 0 To 1 oLogCursor = oLogTable.GetCellbyPosition(i,iRow).createTextCursor LocUrl = UrlList(i) oLogCursor.HyperLinkURL = LocUrl oLogCursor.HyperLinkName = LocUrl oLogCursor.HyperLinkTarget = LocUrl LocFileName = FileNameOutOfPath(LocUrl, "/") oLogTable.GetCellbyPosition(i,iRow).InsertString(oLogCursor, LocFileName,False) Next i oLogDocument.Store() End If End Sub