office-gobmx/wizards/source/importwizard/FilesModul.xba

461 lines
16 KiB
Text
Raw Normal View History

2001-04-23 04:46:42 -05:00
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="FilesModul" script:language="StarBasic">Option Explicit
2001-04-23 04:46:42 -05:00
Public AbsTemplateFound as Integer
Public AbsDocuFound as Integer
2001-05-21 09:52:58 -05:00
Public oLogDocument as Object
Public oLogTable as Object
Public bInsertRow as Boolean
2002-07-15 09:42:29 -05:00
Public sLogUrl as String
Public sCurPassWord as String
2001-04-23 04:46:42 -05:00
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
2001-05-21 09:52:58 -05:00
Dim NewList() as String
2001-04-23 04:46:42 -05:00
Dim Index as Integer
Dim sLocExtension as String
2001-05-21 09:52:58 -05:00
Index = Applications(ApplIndex,SBAPPLKEY)
2001-04-23 04:46:42 -05:00
sLocExtension = &quot;&quot;
If bIsDocument Then
2001-05-21 09:52:58 -05:00
bCheckDocuType = Applications(ApplIndex,SBDOCCONVERT)
2001-04-23 04:46:42 -05:00
bCheckRealType = False
2001-05-21 09:52:58 -05:00
bRecursive = Applications(ApplIndex,SBDOCRECURSIVE)
2001-04-23 04:46:42 -05:00
FilterIndex = Index
2001-05-21 09:52:58 -05:00
sSourceDir = Applications(ApplIndex,SBDOCSOURCE)
2001-04-23 04:46:42 -05:00
Else
&apos; Templates
2001-05-21 09:52:58 -05:00
bCheckDocuType = Applications(ApplIndex,SBTEMPLCONVERT)
2001-04-23 04:46:42 -05:00
&apos; In SO the documenttype cannot be derived from the extension name
bCheckRealType = WizardMode = SBXMLMODE
If bCheckRealType Then
&apos; Note: StarOffice-Math-Documents cannot be treated like templates
bCheckRealType = Index &lt;&gt; 3
If bCheckRealType Then
sLocExtension = &quot;vor&quot;
End If
bIsDocument = Not bCheckRealType
End If
2001-05-21 09:52:58 -05:00
bRecursive = Applications(ApplIndex,SBTEMPLRECURSIVE)
2001-04-23 04:46:42 -05:00
FilterIndex = Index + MaxApplCount
2001-05-21 09:52:58 -05:00
sSourceDir = Applications(ApplIndex,SBTEMPLSOURCE)
2001-04-23 04:46:42 -05:00
End If
If bCheckDocuType Then
sFileContent() = GetMimeTypeList(sFilterName(FilterIndex))
NewList() = ReadDirectories(sSourceDir, bRecursive, bCheckRealType, False, sFileContent(), sLocExtension)
2001-05-21 09:52:58 -05:00
If Ubound(NewList()) &gt; -1 Then
AddListtoFilesList(FilesList(), NewList(), ApplIndex)
ImportDialog.LabelRetrieval.Label = sProgressPage_2 &amp; &quot; &quot; &amp; ReplaceString(sProgressPage_5, Str(Ubound(FilesList()) + 1) &amp; &quot; &quot;, &quot;%1&quot;)
2001-05-21 09:52:58 -05:00
End If
2001-04-23 04:46:42 -05:00
End If
2001-05-21 09:52:58 -05:00
ReadApplicationDirectories() = Ubound(NewList(),1) + 1
2001-04-23 04:46:42 -05:00
End Function
Sub ShowCurrentProgress(bIsDocument as Boolean, CurFound as Integer)
If bIsDocument Then
AbsDocuFound = AbsDocuFound + CurFound
ImportDialog.LabelCurDocumentRetrieval.Label = sProgressFound &amp; &quot; &quot; &amp; CStr(AbsDocuFound) &amp; &quot; &quot; &amp; sProgressMoreDocs
Else
AbsTemplateFound = AbsTemplateFound + CurFound
ImportDialog.LabelCurTemplateRetrieval.Label = sProgressFound &amp; &quot; &quot; &amp; CStr(AbsTemplateFound) &amp; &quot; &quot; &amp; sProgressMoreTemplates
End If
End Sub
2001-05-21 09:52:58 -05:00
2001-04-23 04:46:42 -05:00
Sub ConvertAllDocuments(sFilterName())
2002-07-15 09:42:29 -05:00
Dim FileProperties(1) as new com.sun.star.beans.PropertyValue
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
2002-07-15 10:06:25 -05:00
Dim OpenProperties(1) as new com.sun.star.beans.PropertyValue
2001-05-21 09:52:58 -05:00
Dim FilesList(0,2) as String
2001-04-23 04:46:42 -05:00
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
2001-04-23 04:46:42 -05:00
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 oModel as Object
2001-05-21 09:52:58 -05:00
Dim MaxFileIndex as Integer
2002-07-08 07:44:13 -05:00
Dim FileCount as Integer
2002-07-15 09:42:29 -05:00
&apos;Dim sOldExtension as String
Dim bContainsBasicMacro as Boolean
Dim bIsPassWordProtected as Boolean
2001-08-10 03:28:06 -05:00
bConversionIsRunnig = True
2001-04-23 04:46:42 -05:00
AbsTemplateFound = 0
AbsDocuFound = 0
For i = 0 To ApplCount-1
&apos;templates
bIsDocument = False
CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
ShowCurrentProgress(bIsDocument, CurFound)
Next i
For i = 0 To ApplCount-1
&apos;documents
bIsDocument = True
CurFound = ReadApplicationDirectories(i, FilesList(), bIsDocument, sFilterName())
ShowCurrentProgress(bIsDocument, CurFound)
Next i
TotFound = AbsTemplateFound + AbsDocuFound
CreateLogDocument(OpenProperties())
If TotFound &gt; 0 Then
InitializeProgressPage(ImportDialog)
OpenProperties(0).Name = &quot;Hidden&quot;
OpenProperties(0).Value = True
OpenProperties(1).Name = &quot;AsTemplate&quot;
2002-07-15 09:42:29 -05:00
OpenProperties(1).Name = False
MaxFileIndex = Ubound(FilesList(),1)
2002-07-08 07:44:13 -05:00
FileCount = 0
For i = 0 To MaxFileIndex
If bCancelTask Or RetValue = 0 Then
2001-08-10 03:28:06 -05:00
bConversionIsRunnig = False
Exit Sub
End if
2001-08-10 03:28:06 -05:00
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) &amp; &quot;/&quot; &amp; MaxFileIndex + 1 &amp; &quot; (&quot; &amp; sViewPath &amp; &quot;)&quot;
2002-07-15 09:42:29 -05:00
&apos; sOldExtension = GetFileNameExtension(sFullName, &quot;/&quot;)
&apos; Select Case sOldExtension
&apos; Case &quot;vor&quot;, &quot;dot&quot;, &quot;xlt&quot;, &quot;pot&quot;
&apos; OpenProperties(1).Value = False
&apos; Case Else
&apos; OpenProperties(1).Value = False
&apos; End Select
oDocument = StarDesktop.LoadComponentFromURL(sFullName, &quot;_blank&quot;, 0, OpenProperties())
2002-07-15 09:42:29 -05:00
bIsPassWordProtected = CheckPassWordProtection(oDocument)
bContainsBasicMacro = CheckIfMacroExists(oDocument)
If bSetFonts Then
CheckScripts(oDocument, 1)
2001-04-23 04:46:42 -05:00
End If
If Not IsNull(oDocument) Then
Select Case sExtension
Case &quot;sxw&quot;, &quot;sxc&quot;, &quot;sxi&quot;, &quot;sxd&quot;, &quot;sxs&quot;, &quot;sxm&quot;
SourceStemDir = RTrimStr(Applications(ApplIndex,SBDOCSOURCE), &quot;/&quot;)
TargetStemDir = RTrimStr(Applications(ApplIndex,SBDOCTARGET), &quot;/&quot;)
Case Else &apos; Templates and Helper-Applications remain
SourceStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLSOURCE), &quot;/&quot;)
TargetStemDir = RTrimStr(Applications(ApplIndex,SBTEMPLTARGET), &quot;/&quot;)
End Select
TargetFile = ReplaceString(sFullname, TargetStemDir, SourceStemDir)
sFileName = GetFileNameWithoutExtension(TargetFile, &quot;/&quot;)
OldExtension = GetFileNameExtension(TargetFile)
TargetFile = RTrimStr(TargetFile, OldExtension)
TargetFile = TargetFile &amp; sExtension
TargetDir = RTrimStr(TargetFile, sFileName &amp; &quot;.&quot; &amp; sExtension)
If Not oUcb.Exists(TargetDir) Then
CreateFolder(TargetDir)
End If
If oUcb.Exists(TargetFile) Then
sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(TargetFile), &quot;&lt;1&gt;&quot;)
sCurFileExists = ReplaceString(sCurFileExists, chr(13), &quot;&lt;CR&gt;&quot;)
iOverWrite = Msgbox (sCurFileExists, 32 + 3, sTitle)
Select Case iOverWrite
Case 1 &apos; OK
&apos; In the FileProperty-Bean this is already default
bDoSave = True
Case 2 &apos; Abort
2001-08-10 03:28:06 -05:00
CancelTask(False)
bDoSave = False
Case 7 &apos; No
bDoSave = False
End Select
End If
If bDoSave Then
2002-07-15 09:42:29 -05:00
InsertDocNamesToLogDocument(sFullName, TargetFile, bContainsBasicMacro)
2001-10-17 04:47:56 -05:00
On Local Error Resume Next
FileProperties(0).Name = &quot;FilterName&quot;
FileProperties(0).Value = CurFilterName
2002-07-15 09:42:29 -05:00
If bIsPassWordProtected Then
FileProperties(1).Name = &quot;PassWord&quot;
FileProperties(1).Value = sCurPassWord
End If
oDocument.StoreAsUrl(TargetFile,FileProperties())
2002-07-08 07:44:13 -05:00
FileCount = FileCount + 1
oDocument.Dispose()
2001-10-17 04:47:56 -05:00
On Local Error Goto 0
End If
End If
Next i
End If
2002-07-08 07:44:13 -05:00
AddLogStatistics(FileCount)
2002-07-15 09:42:29 -05:00
oLogDocument.Dispose()
If (ImportDialog.chkLogfile.State = 1) And (FileCount &gt; 0) Then
ImportDialog.cmdShowLogFile.Enabled = True
End If
2001-11-06 10:16:14 -06:00
ImportDialog.cmdCancel.Label = sCloseButton
ImportDialog.cmdGoOn.Label = sReady
ImportDialog.cmdGoOn.Enabled = True
2001-08-10 03:28:06 -05:00
bConversionIsRunnig = False
2001-04-23 04:46:42 -05:00
Exit Sub
RTError:
Msgbox sRTErrorDesc, 16, sRTErrorHeader
End Sub
2002-07-15 09:42:29 -05:00
Sub AddListtoFilesList(FirstList(), SecList(), ApplIndex as Integer)
2001-04-23 04:46:42 -05:00
Dim FirstStart as Integer, FirstEnd as Integer, i as Integer, s as Integer
If FirstList(0,0) = &quot;&quot; Then
FirstStart = Ubound(FirstList(),1)
Else
FirstStart = Ubound(FirstList(),1) + 1
End If
2001-05-21 09:52:58 -05:00
FirstEnd = FirstStart + Ubound(SecList(),1)
ReDim Preserve FirstList(FirstEnd,2)
s = 0
2001-04-23 04:46:42 -05:00
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 &amp; &quot;/&quot; &amp; sTemplateGroupName
2001-04-23 04:46:42 -05:00
Case SBXMLMODE
If Index = 3 Then
&apos; Helper Application
GetTargetTemplatePath = SOWorkPath
Else
GetTargetTemplatePath = SOTemplatePath
End If
End Select
End Function
&apos; Retrieves the second value for a next to &apos;SearchString&apos; in
&apos; 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) &lt;&gt; 0 Then
sLocFilterList() = ArrayoutofString(sFiltername(i,0),&quot;|&quot;, 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),&quot;|&quot;, MaxIndex)
GetFilterName = sLocFilterList(a)
sLocExtensionList() = ArrayoutofString(sFilterName(i,2), &quot;|&quot;, 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) &lt;&gt; 0 Then
SearchArrayForPartString() = i
Exit Function
End if
Next
IndexinArray = -1
End Function
Function GetMimeTypeList(BigFiltername as STring)
2001-08-10 09:15:50 -05:00
Dim sBigList() as String
Dim sSmallList() as String
2001-04-23 04:46:42 -05:00
Dim sMimeTypeList()
2001-08-10 09:15:50 -05:00
Dim BigMaxIndex as Integer
Dim n as Integer
sBigList() = ArrayoutofString(BigFilterName,&quot;|&quot;, BigMaxIndex)
For n = 0 To BigMaxIndex
sSmallList() = ArrayoutofString(sBigList(n),&quot;;&quot;)
sMimeTypeList() = AddListToList(sMimeTypeList(), sSmallList())
Next n
2001-04-23 04:46:42 -05:00
GetMimetypeList() = sMimeTypeList()
2001-05-21 09:52:58 -05:00
End Function
Sub CreateLogDocument(HiddenProperties())
2002-07-15 09:42:29 -05:00
Dim OpenProperties(0) as new com.sun.star.beans.PropertyValue
2001-05-21 09:52:58 -05:00
Dim oTableCursor as Object
Dim oLogCursor as Object
Dim oLogRows as Object
Dim NoArgs()
Dim i as Integer
Dim bLogExists as Boolean
If ImportDialog.chkLogfile.State = 1 Then
i = 2
2002-07-15 09:42:29 -05:00
OpenProperties(0).Name = &quot;Hidden&quot;
OpenProperties(0).Value = True
oLogDocument = StarDesktop.LoadComponentFromURL(&quot;private:factory/swriter&quot;, &quot;_blank&quot;, 4, OpenProperties())
2001-05-21 09:52:58 -05:00
oLogCursor = oLogDocument.Text.CreateTextCursor
oLogTable = oLogDocument.CreateInstance(&quot;com.sun.star.text.TextTable&quot;)
2002-07-08 07:44:13 -05:00
oLogTable.RepeatHeadline = true
2001-05-21 09:52:58 -05:00
oLogCursor.Text.InsertTextContent(oLogCursor, oLogTable, True)
2002-07-15 09:42:29 -05:00
oLogCursor = oLogTable.GetCellbyPosition(0,0).createTextCursor()
2001-05-21 09:52:58 -05:00
oLogCursor.SetString(sSourceDocuments)
2002-07-15 09:42:29 -05:00
oLogCursor = oLogTable.GetCellbyPosition(1,0).createTextCursor()
2001-05-21 09:52:58 -05:00
oLogCursor.SetString(sTargetDocuments)
bInsertRow = False
2001-05-21 09:52:58 -05:00
sLogUrl = SOWorkPath &amp; &quot;/Logfile.sxw&quot;
Do
bLogExists = oUcb.Exists(sLogUrl)
If bLogExists Then
If i = 2 Then
sLogUrl = ReplaceString(sLogUrl, &quot;/Logfile_2.sxw&quot;, &quot;/Logfile.sxw&quot;)
Else
sLogUrl = ReplaceString(sLogUrl, &quot;/Logfile_&quot; &amp; cStr(i) &amp; &quot;.sxw&quot;, &quot;/Logfile_&quot; &amp; cStr(i-1) &amp; &quot;.sxw&quot;)
End If
i = i + 1
End If
Loop Until Not bLogExists
oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
2001-05-21 09:52:58 -05:00
EndIf
End Sub
2002-07-15 09:42:29 -05:00
Sub InsertDocNamesToLogDocument(SourceUrl as String, TargetUrl as String, bContainsBasicMacro as Boolean)
Dim oCell as Object
2001-05-21 09:52:58 -05:00
Dim oLogCursor as Object
Dim UrlList(1) as String
Dim LocFileName as String
Dim LocUrl as String
Dim i as Integer
2002-07-15 09:42:29 -05:00
Dim oCommentCursor as Object
2001-05-21 09:52:58 -05:00
If ImportDialog.chkLogfile.State = 1 Then
If bInsertRow Then
2001-05-21 09:52:58 -05:00
oLogTable.Rows.InsertByIndex(oLogTable.Rows.Count,1)
Else
bInsertRow = True
2001-05-21 09:52:58 -05:00
End If
UrlList(0) = SourceUrl
UrlList(1) = TargetUrl
For i = 0 To 1
oCell = oLogTable.GetCellbyPosition(i,oLogTable.Rows.Count-1)
2002-07-15 09:42:29 -05:00
If i = 1 And bContainsBasicMacro Then
oCommentCursor = oCell.createTextCursor()
oCell.insertControlCharacter(oCommentCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oCell.insertString(oCommentCursor, sReeditMacro, false)
End If
2001-05-21 09:52:58 -05:00
LocUrl = UrlList(i)
2002-07-15 09:42:29 -05:00
oLogCursor = oCell.createTextCursor()
oLogCursor.CollapseToStart()
2001-05-21 09:52:58 -05:00
oLogCursor.HyperLinkURL = LocUrl
oLogCursor.HyperLinkName = LocUrl
oLogCursor.HyperLinkTarget = LocUrl
2001-10-17 04:47:56 -05:00
LocFileName = FileNameOutOfPath(LocUrl)
oCell.InsertString(oLogCursor, LocFileName,False)
2001-05-21 09:52:58 -05:00
Next i
oLogDocument.Store()
End If
2002-07-08 07:44:13 -05:00
End Sub
Sub AddLogStatistics(FileCount as Integer)
Dim oCell as Object
Dim oLogCursor as Object
Dim MaxRowIndex as Integer
Dim oTableCursor as Object
If ImportDialog.chkLogfile.State = 1 Then
MaxRowIndex = oLogTable.Rows.Count
sLogSummary = ReplaceString(sLogSummary, FileCount, &quot;&lt;COUNT&gt;&quot;)
oLogTable.Rows.InsertByIndex(MaxRowIndex, 1)
oCell = oLogTable.GetCellbyPosition(0, MaxRowIndex)
oLogCursor = oCell.createTextCursor()
oCell.InsertString(oLogCursor, sLogSummary,False)
2002-07-15 09:42:29 -05:00
oTableCursor = oLogTable.createCursorByCellName(oCell.CellName)
2002-07-08 07:44:13 -05:00
oTableCursor.goRight(1, True)
oTableCursor.mergeRange()
oLogDocument.Store()
End If
2002-07-15 09:42:29 -05:00
End Sub
&apos; This macro has to be reworked out again as it works with deprecated interfaces
&apos; It can be completed as soon as Bug #93295 will be fixed because right now it
&apos; is not possible to access BasicLibraries and DialogLibraries from outside the
&apos; document
Function CheckIfMacroExists(oDocument as Object) as Boolean
Dim ModuleNames() as String
Dim MaxIndex as Integer
Dim oLibraryContainer as Object
&apos; oLibraryContainer = oDocument.LibraryContainer
&apos; If oLibraryContainer.hasElements Then
&apos; ModuleNames = oDocument.LibraryContainer.ElementNames
&apos; MaxIndex = Ubound(ModuleNames())
&apos; For i = 0 To MaxIndex
&apos; oLibrary = oLibraryContainer.getByName(ModuleNames(i))
&apos; If Not IsNull(oLibrary.getDialogContainer) Then
&apos; CheckIf MacroExists = True
&apos; Exit Function
&apos; End If
&apos; If oLibrary.ModuleContainer.HasElements Then
&apos; CheckIfMacroExists() = True
&apos; Exit Function
&apos; End If
&apos; Next i
&apos; End If
CheckIfMacroExists() = False
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 = &quot;PassWord&quot; 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())
2001-05-21 09:52:58 -05:00
End Sub</script:module>