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

<?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

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 = &quot;&quot;
	If bIsDocument Then
		bCheckDocuType = Applications(ApplIndex,SBDOCCONVERT)
		bCheckRealType = False
		bRecursive = Applications(ApplIndex,SBDOCRECURSIVE)
		FilterIndex = Index
		sSourceDir = Applications(ApplIndex,SBDOCSOURCE)
	Else
		&apos; Templates
		bCheckDocuType = Applications(ApplIndex,SBTEMPLCONVERT)
		&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
		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()) &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;)
		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 &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


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
		&apos;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
		&apos;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 &gt; 0 Then
		CreateLogDocument(OpenProperties())
		InitializeProgressPage(ImportDialog)
		OpenProperties(0).Name = &quot;Hidden&quot;
		OpenProperties(0).Value = True
		OpenProperties(1).Name = &quot;AsTemplate&quot;
		OpenProperties(1).Value = False
		OpenProperties(2).Name = &quot;MacroExecutionMode&quot;
		OpenProperties(2).Value = com.sun.star.document.MacroExecMode.NEVER_EXECUTE	
		OpenProperties(3).Name = &quot;UpdateDocMode&quot;
		OpenProperties(3).Value = com.sun.star.document.UpdateDocMode.NO_UPDATE
		MaxFileIndex = Ubound(FilesList(),1)
		FileCount = 0
		For i = 0 To MaxFileIndex
			sComment = &quot;&quot;
			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) &amp; &quot;/&quot; &amp; MaxFileIndex + 1 &amp; &quot;  (&quot; &amp; sViewPath &amp; &quot;)&quot;
			oDocument = StarDesktop.LoadComponentFromURL(sFullName, &quot;_blank&quot;, 0, OpenProperties())
			If Not IsNull(oDocument) Then
				bIsPassWordProtected = CheckPassWordProtection(oDocument)
			End If

			If Not IsNull(oDocument) Then
				CheckIfMacroExists(oDocument, sComment)
				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
				&apos; Todo: According to AS there might come a new feature that storeasUrl could possibly rise a UI dialog. 
				&apos; In this case my own UI becomes obsolete
				If ((oUcb.Exists(TargetFile)) and (iGeneralOverwrite &lt;&gt; 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), &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
								CancelTask(False)
								bDoSave = False
							Case 7 	&apos; No
								bDoSave = False
						End Select
					End If
				End If
				If bDoSave Then
					On Local Error Goto NOSAVING
					FileProperties(0).Name = &quot;FilterName&quot;
					FileProperties(0).Value = CurFilterName
					FileProperties(1).Name = &quot;Overwrite&quot;
					FileProperties(1).Value = True
					If bIsPassWordProtected Then
						FileProperties(2).Name = &quot;PassWord&quot;
						FileProperties(2).Value = sCurPassWord
					End If
					&apos; Todo: Make sure that an errorbox pops up when saving fails
					oDocument.StoreAsUrl(TargetFile,FileProperties())
					NOSAVING:
					If Err &lt;&gt; 0 Then
						sCurcouldnotsaveDocument = ReplaceString(scouldnotsaveDocument, ConvertFromUrl(TargetFile), &quot;&lt;1&gt;&quot;)
						sComment = ConcatComment(sComment, sCurCouldnotsaveDocument)
						Resume LETSGO
						LETSGO:
					Else
						FileCount = FileCount + 1
					End If
					oDocument.Dispose()
				End If
			Else
				sCurcouldnotopenDocument = ReplaceString(scouldnotopenDocument, ConvertFromUrl(sFullName), &quot;&lt;1&gt;&quot;)
				sComment = ConcatComment(sComment, sCurCouldnotopenDocument)
				TargetFile = &quot;&quot;
			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) = &quot;&quot; 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 &amp; &quot;/&quot; &amp; sTemplateGroupName
		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)
Dim sBigList() as String
Dim sSmallList() as String
Dim sMimeTypeList()
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
	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 = &quot;Hidden&quot;
		OpenProperties(0).Value = True
		oLogDocument = StarDesktop.LoadComponentFromURL(&quot;private:factory/swriter&quot;, &quot;_blank&quot;, 4, OpenProperties())
		oLogCursor = oLogDocument.Text.CreateTextCursor
		oLogTable =  oLogDocument.CreateInstance(&quot;com.sun.star.text.TextTable&quot;)
		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 &amp; &quot;/Logfile.sxw&quot;
		Do
			bLogIsThere = oUcb.Exists(sLogUrl)
			If bLogIsThere 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 bLogIsThere
		bLogExists = True
		oLogDocument.StoreAsUrl(sLogUrl, NoArgs())
	End If
End Sub



Sub InsertDocNamesToLogDocument(SourceUrl as String, TargetUrl as String, sComment as String)		&apos;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 &lt;&gt; &quot;&quot; Then
				If ((TargetUrl &lt;&gt;&quot;&quot;) AND (i = 1)) Or ((TargetUrl = &quot;&quot;) 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, &quot;&lt;COUNT&gt;&quot;)
		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


&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, sComment as String) as Boolean
Dim ModuleNames() as String
Dim MaxIndex as Integer
Dim oLibraryContainer as Object
Dim bMacroExists as Boolean
	bMacroExists = False
&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;				bMacroExists = True
&apos;				Exit Function
&apos;			End If
&apos;			If oLibrary.ModuleContainer.HasElements Then
&apos;				bMacroExists = True
&apos;				Exit Function
&apos;			End If
&apos;		Next i
&apos;	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 = &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())
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 = &quot;&quot; Then
		sComment = AdditionalComment
	Else
		sComment = sComment &amp; chr(13) + AdditionalComment
	End If				
	ConcatComment = sComment
End Function
</script:module>