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 AbsTemplateFound as Integer
Public AbsDocuFound as Integer
Public oLogDocument as Object
Public oLogTable as Object
Public bInsertRow as Boolean

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(0) as new com.sun.star.beans.PropertyValue
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
Dim OpenProperties(1) 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 oModel as Object
Dim MaxFileIndex as Integer
Dim sOldExtension as String
	bConversionIsRunnig = True
	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;
		MaxFileIndex = Ubound(FilesList(),1)
		For i = 0 To MaxFileIndex
			If bCancelTask Or RetValue = 0 Then
				bConversionIsRunnig = False
				Exit Sub
			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;
			
			sOldExtension = GetFileNameExtension(sFullName, &quot;/&quot;)
			Select Case sOldExtension
				Case &quot;vor&quot;, &quot;dot&quot;, &quot;xlt&quot;, &quot;pot&quot;
					OpenProperties(1).Value = False
				Case Else
					OpenProperties(1).Value = False
			End Select
			oDocument = StarDesktop.LoadComponentFromURL(sFullName, &quot;_blank&quot;, 0, OpenProperties())
			If bSetFonts Then
				CheckScripts(oDocument, 1)
			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
							CancelTask(False)
							bDoSave = False
						Case 7 	&apos; No
							bDoSave = False
					End Select
				End If
				If bDoSave Then
					InsertDocNamesToLogDocument(sFullName, TargetFile)
					On Local Error Resume Next
					FileProperties(0).Name = &quot;FilterName&quot;
					FileProperties(0).Value = CurFilterName
					oDocument.StoreAsUrl(TargetFile,FileProperties())
					oDocument.Dispose()
					On Local Error Goto 0
				End If
			End If
		Next i
	End If
	ImportDialog.cmdCancel.Label = sCloseButton
	ImportDialog.cmdGoOn.Label = sReady
	ImportDialog.cmdGoOn.Enabled = True
	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 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(&quot;private:factory/swriter&quot;, &quot;_blank&quot;, 4, NoArgs())&apos; HiddenProperties()) &apos; HiddenProperties())
		oLogCursor = oLogDocument.Text.CreateTextCursor
		oLogTable =  oLogDocument.CreateInstance(&quot;com.sun.star.text.TextTable&quot;)
		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
			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())
	EndIf
End Sub


Sub InsertDocNamesToLogDocument(SourceUrl as String, TargetUrl as String)
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
	If ImportDialog.chkLogfile.State = 1 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)
			oLogCursor = oCell.createTextCursor()
			LocUrl = UrlList(i)
			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</script:module>