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

685 lines
23 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 bLogExists as Boolean
Public sComment as String
Public MaxCollectIndex as Integer
Public bInsertRow as Boolean
2002-07-15 09:42:29 -05:00
Public sLogUrl as String
Public sCurPassWord as String
Public FileCount as Integer
Public XMLTemplateCount as Integer
Public PathCollection(7,3) as String
2002-07-15 09:42:29 -05:00
Function ReadCollectionPaths(FilesList() as String, sFilterName() as String)
2001-04-23 04:46:42 -05:00
Dim FilterIndex as Integer
Dim bRecursive as Boolean
Dim SearchDir as String
Dim i as Integer
Dim n as Integer
2001-04-23 04:46:42 -05:00
Dim a as Integer
Dim s as Integer
2001-04-23 04:46:42 -05:00
Dim sFileContent() as String
Dim NewList(0,1) as String
2001-04-23 04:46:42 -05:00
Dim Index as Integer
Dim CurFileName as String
Dim CurExtension as String
Dim CurFileContent as String
Dim XMLTemplateContentList() as String
Dim bIsTemplatePath as Boolean
Dim MaxIndex as Integer
Dim NewContentList() as String
Dim XMLTemplateContentString as String
Dim ApplIndex as Integer
Dim bAssignFileName as Boolean
oDocInfo = CreateUnoService(&quot;com.sun.star.document.DocumentProperties&quot;)
bInterruptSearch = False
For i = 0 To MaxCollectIndex
SearchDir = PathCollection(i,0)
bRecursive = PathCollection(i,1)
sFileContent() = ArrayoutofString(PathCollection(i,2), &quot;|&quot;)
NewList() = ReadDirectories(SearchDir, bRecursive, False, False, sFileContent(), &quot;&quot;)
If InterruptProcess Then
ReadCollectionPaths() = False
Exit Function
2001-04-23 04:46:42 -05:00
End If
2001-05-21 09:52:58 -05:00
If Ubound(NewList()) &gt; -1 Then
bIsTemplatePath = FieldInList(&quot;vor&quot;, sFileContent)
If bIsTemplatePath Then
XMLTemplateContentString = PathCollection(i,3)
XMLTemplateContentList() = ArrayoutofString(XMLTemplateContentString, &quot;|&quot;)
If Ubound(XMLTemplateContentList()) &gt; -1 Then
MaxIndex = Ubound(NewList())
ReDim Preserve NewList(MaxIndex, 1) as String
ReDim Preserve NewContentList(MaxIndex) as String
a = -1
For n = 0 To MaxIndex
bAssignFileName = True
If InterruptProcess() Then
ReadCollectionPaths() = False
Exit Function
End If
CurFileName = NewList(n,0)
If NewList(n,1) = &quot;vor&quot; Then
CurFileContent = GetRealFileContent(oDocInfo, CurFileName)
NewList(n,1) = CurFileContent
bAssignFileName = FieldInList(CurFileContent, XMLTemplateContentList())
End If
CurExtension = NewList(n,1)
If bAssignFileName Then
If a &lt; n Then
a = a + 1
NewList(a,0) = CurFileName
NewList(a,1) = CurExtension
ApplIndex = GetApplicationIndex(CurFileContent, sFiltername())
NewContentList(a) = ApplIndex
End If
End If
Next n
If a &lt; MaxIndex Then
ReDim Preserve NewList(a, 1) as String
End If
AddListtoFilesList(FilesList(), NewList(), NewContentList())
End If
Else
MaxIndex = Ubound(NewList())
ReDim Preserve NewContentList(MaxIndex) as String
For s = 0 To MaxIndex
CurExtension = NewList(s,1)
NewContentList(s) = GetApplicationIndex(CurExtension, sFiltername())
Next s
AddListtoFilesList(FilesList(), NewList(), NewContentList())
End If
2001-05-21 09:52:58 -05:00
End If
Next i
End Function
Function GetApplicationIndex(CurFileContent as String, sFilterName() as String) as Integer
Dim Index as Integer
Dim i as Integer
Index = GetIndexForPartStringinMultiArray(sFilterName(), CurFileContent, 0)
If Index &gt;= MaxApplCount Then
Index = Index - MaxApplCount
2001-04-23 04:46:42 -05:00
End If
For i = 0 To MaxApplCount - 1
If Applications(i, SBAPPLKEY) = Index Then
GetApplicationIndex() = i
Exit Function
End If
Next i
GetApplicationIndex() = - 1
End Function
Function InterruptProcess() as Boolean
If bCancelTask Or RetValue = 0 Then
bConversionIsRunning = False
InterruptProcess() = True
Exit Function
End if
InterruptProcess() = False
2001-04-23 04:46:42 -05:00
End Function
Sub AddCollectionPath(ApplIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
MaxCollectIndex = MaxCollectIndex + 1
PathCollection(MaxCollectIndex, 0) = Applications(ApplIndex, DocIndex)
PathCollection(MaxCollectIndex, 1) = Applications(ApplIndex, RecursiveIndex)
AddFilterNameToPathItem(ApplIndex, MaxCollectIndex, sFiltername(), DistIndex)
End Sub
Sub AddFilterNameToPathItem(ApplIndex as Integer, CollectIndex as Integer, sFiltername() as String, DistIndex as Integer)
Dim iKey as Integer
Dim CurListString as String
Dim LocExtension as String
Dim LocContentString as String
Dim LocXMLTemplateContent as String
iKey = Applications(ApplIndex, SBAPPLKEY)
CurListString = PathCollection(CollectIndex, 2)
LocExtension = sFilterName(iKey +DistIndex, 0)
If Len(LocExtension) &gt; SBMAXEXTENSIONLENGTH Then &apos; 7 == Length of two extensions like &apos;sda|sdd
LocExtension = &quot;vor&quot;
LocContentString = sFilterName(iKey +DistIndex, 0)
LocContentString = ReplaceString(LocContentString, &quot;|&quot;, &quot;;&quot;)
LocXMLTemplateContent = PathCollection(CollectIndex, 3)
If LocXMLTemplateContent = &quot;&quot; Then
LocXMLTemplateContent = LocContentString
Else
LocXMLTemplateContent = LocXMLTemplateContent &amp; &quot;|&quot; &amp; LocContentString
End If
PathCollection(CollectIndex, 3) = LocXMLTemplateContent
End If
If CurListString = &quot;&quot; Then
PathCollection(CollectIndex, 2) = LocExtension
2001-04-23 04:46:42 -05:00
Else
If Instr(CurListString, LocExtension) = 0 Then
PathCollection(CollectIndex, 2) = CurListString &amp; &quot;|&quot; &amp; LocExtension
End If
End If
2001-04-23 04:46:42 -05:00
End Sub
2001-05-21 09:52:58 -05:00
Sub CheckIfToAddPathToCollection(ApplIndex as Integer, bDoConvertIndex as Integer, DocIndex as Integer, RecursiveIndex as Integer, sFiltername() as String, DistIndex as Integer)
Dim CollectIndex as Integer
Dim bCheckDocuType as Boolean
bCheckDocuType = Applications(ApplIndex, bDoConvertIndex)
If bCheckDocuType Then
CollectIndex = GetIndexInMultiArray(PathCollection(), Applications(ApplIndex,DocIndex), 0)
If (CollectIndex &gt;-1) Then
If Applications(ApplIndex, RecursiveIndex) &lt;&gt; PathCollection(CollectIndex, 1) Then
AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
Else
AddFilterNameToPathItem(ApplIndex, CollectIndex, sFilterName(), DistIndex)
End If
Else
AddCollectionPath(ApplIndex, DocIndex, RecursiveIndex, sFilterName(), DistIndex)
End If
End If
End Sub
Sub CollectPaths(sFiltername() as String)
Dim i as Integer
Dim XMLTemplateContentString as String
MaxCollectIndex = -1
For i = 0 To ApplCount-1
CheckIfToAddPathToCollection(i, SBDOCCONVERT, SBDOCSOURCE, SBDOCRECURSIVE, sFilterName(), 0)
Next i
XMLTemplateCount = 0
XMLTemplateContentString = &quot;&quot;
For i = 0 To ApplCount-1
If WizardMode = SBXMLMODE Then
XMLTemplateCount = XMLTemplateCount + 1
End If
CheckIfToAddPathToCollection(i, SBTEMPLCONVERT, SBTEMPLSOURCE, SBTEMPLRECURSIVE, sFilterName(), MaxApplCount)
Next i
End Sub
Sub ConvertAllDocuments(sFilterName() as String)
2002-09-30 08:54:06 -05:00
Dim FileProperties(1) as new com.sun.star.beans.PropertyValue
Dim PWFileProperties(2) as New com.sun.star.beans.PropertyValue
Dim WriterWebProperties(0) as new com.sun.star.beans.PropertyValue
2002-11-27 08:42:32 -06:00
Dim OpenProperties(4) as new com.sun.star.beans.PropertyValue
Dim oInteractionHandler as Object
Dim InteractionTypes(0) as Long
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
2002-11-27 08:42:32 -06:00
Dim sSourceUrl as String
Dim CurFilename as String
2001-04-23 04:46:42 -05:00
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
2002-11-27 08:42:32 -06:00
Dim sTargetUrl as String
2001-04-23 04:46:42 -05:00
Dim CurFilterName as String
Dim ApplIndex as Integer
Dim Index as Integer
Dim bIsDocument as Boolean
Dim bDoSave as Boolean
Dim sCurFileExists as String
2001-05-21 09:52:58 -05:00
Dim MaxFileIndex as Integer
2002-07-15 09:42:29 -05:00
Dim bContainsBasicMacro as Boolean
Dim bIsPassWordProtected as Boolean
Dim iOverwrite as Integer
bConversionisrunning = True
2002-11-27 08:42:32 -06:00
InteractionTypes(0) = com.sun.star.task.PasswordRequestMode.PASSWORD_REENTER
oInteractionHandler = createUnoService(&quot;com.sun.star.task.InteractionHandler&quot;)
oInteractionHandler.initialize(InteractionTypes())
iGeneralOverwrite = SBOVERWRITEUNDEFINED
bConversionIsRunning = True
bLogExists = false
2001-04-23 04:46:42 -05:00
AbsTemplateFound = 0
AbsDocuFound = 0
CollectPaths(sFiltername())
If Not ReadCollectionPaths(FilesList(), sFilterName()) Then
TotFound = 0
SetProgressDisplay(0)
bConversionisrunning = false
FinalizeDialogButtons()
Exit Sub
End If
TotFound = Ubound(FilesList()) + 1
If FilesList(0,0) = &quot;&quot; Then &apos; Querying the number of fields in a multidimensionl Array is unsecure
TotFound = 0 &apos; because it will return the value 0 (and not -1) even when the Array is empty
SetProgressDisplay(0)
End If
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
2002-11-27 08:42:32 -06:00
OpenProperties(4).Name = &quot;InteractionHandler&quot;
OpenProperties(4).Value = oInteractionHandler
MaxFileIndex = Ubound(FilesList(),1)
2002-07-08 07:44:13 -05:00
FileCount = 0
For i = 0 To MaxFileIndex
sComment = &quot;&quot;
If InterruptProcess() Then
Exit For
End If
2001-08-10 03:28:06 -05:00
bDoSave = True
2002-11-27 08:42:32 -06:00
sSourceUrl = FilesList(i,0)
CurFiltername = GetFilterName(FilesList(i,1), sFilterName(), sExtension, FilterIndex)
ApplIndex = FilesList(i,2)
If ApplIndex &gt; Ubound(Applications) or (ApplIndex &lt; 0) Then
Msgbox &quot;Applicationindex out of bounds:&quot; &amp; sSourcUrl
End If
sViewPath = ConvertFromUrl(sSourceUrl) &apos; CutPathView(sSourceUrl, 70)
ImportDialog.LabelCurDocument.Label = Str(i+1) &amp; &quot;/&quot; &amp; MaxFileIndex + 1 &amp; &quot; (&quot; &amp; sViewPath &amp; &quot;)&quot;
Select Case lcase(sExtension)
2002-11-27 08:42:32 -06:00
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
sTargetUrl = ReplaceString(sSourceUrl, TargetStemDir, SourceStemDir)
CurFilename = GetFileNameWithoutExtension(sTargetUrl, &quot;/&quot;)
OldExtension = GetFileNameExtension(sTargetUrl)
sTargetUrl = RTrimStr(sTargetUrl, OldExtension)
sTargetUrl = sTargetUrl &amp; sExtension
TargetDir = RTrimStr(sTargetUrl, CurFilename &amp; &quot;.&quot; &amp; sExtension)
If (oUcb.Exists(sTargetUrl)) Then
If (iGeneralOverwrite &lt;&gt; SBOVERWRITEALWAYS) Then
If (iGeneralOverwrite = SBOVERWRITEUNDEFINED) Then
2002-11-27 08:42:32 -06:00
ShowOverwriteAllDialog(sTargetUrl, sTitle)
bDoSave = (iGeneralOverwrite = SBOVERWRITEQUERY) Or (iGeneralOverwrite = SBOVERWRITEALWAYS)
Elseif iGeneralOverwrite = SBOVERWRITENEVER Then
bDoSave = False
ElseIf ((iGeneralOverWrite = SBOVERWRITEQUERY) OR (iGeneralOverwrite = SBOVERWRITECANCEL)) Then
&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
sCurFileExists = ReplaceString(sFileExists, ConvertFromUrl(sTargetUrl), &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
2002-11-27 08:42:32 -06:00
End If
If bDoSave Then
If Not oUcb.Exists(TargetDir) Then
bDoSave = CreateFolder(TargetDir)
2002-11-27 08:42:32 -06:00
End If
If bDoSave Then
oDocument = StarDesktop.LoadComponentFromURL(sSourceUrl, &quot;_default&quot;, 0, OpenProperties())
If Not IsNull(oDocument) Then
InsertSourceUrlToLogDocument(sSourceUrl, &quot;&quot;)
bIsPassWordProtected = CheckPassWordProtection(oDocument)
CheckIfMacroExists(oDocument.BasicLibraries, sComment)
On Local Error Goto NOSAVING
&apos; Todo: Due to bug #93651 the handling of the fileProperties has to be handled without Redimensioning
If bIsPassWordProtected Then
PWFileProperties(0).Name = &quot;FilterName&quot;
PWFileProperties(0).Value = CurFilterName
PWFileProperties(1).Name = &quot;Overwrite&quot;
PWFileProperties(1).Value = True
PWFileProperties(2).Name = &quot;Password&quot;
PWFileProperties(2).Value = sCurPassWord
oDocument.StoreAsUrl(sTargetUrl, PWFileProperties())
Else
FileProperties(0).Name = &quot;FilterName&quot;
FileProperties(0).Value = CurFilterName
FileProperties(1).Name = &quot;Overwrite&quot;
FileProperties(1).Value = True
oDocument.StoreAsUrl(sTargetUrl,FileProperties())
End If
&apos; Todo: Make sure that an errorbox pops up when saving fails
NOSAVING:
If Err &lt;&gt; 0 Then
sCurcouldnotsaveDocument = ReplaceString(scouldnotsaveDocument, ConvertFromUrl(sTargetUrl), &quot;&lt;1&gt;&quot;)
sComment = ConcatComment(sComment, sCurCouldnotsaveDocument)
Resume LETSGO
LETSGO:
Else
FileCount = FileCount + 1
End If
oDocument.Dispose()
InsertTargetUrlToLogDocument(sTargetUrl, sComment)
2002-09-30 08:54:06 -05:00
Else
sCurcouldnotopenDocument = ReplaceString(scouldnotopenDocument, ConvertFromUrl(sSourceUrl), &quot;&lt;1&gt;&quot;)
sComment = ConcatComment(sComment, sCurCouldnotopenDocument)
InsertSourceUrlToLogDocument(sSourceUrl, sComment)
2002-07-15 09:42:29 -05:00
End If
End If
End If
Next i
End If
AddLogStatistics()
FinalizeDialogButtons()
bConversionIsRunning = 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(), NewContentList() as String)
Dim sLocExtension as String
Dim FirstStart as Integer
Dim FirstEnd as Integer
Dim i as Integer
Dim 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)
sLocExtension = lcase(FirstList(i,1))
Select Case sLocExtension
Case &quot;sdw&quot;, &quot;sdc&quot;, &quot;sda&quot;, &quot;sdd&quot;, &quot;smf&quot;, &quot;sgl&quot;, &quot;doc&quot;, &quot;xls&quot;, &quot;ppt&quot;
AbsDocuFound = AbsDocuFound + 1
Case else
AbsTemplateFound = AbsTemplateFound + 1
End Select
FirstList(i,2) = CStr(NewContentList(s))
2001-04-23 04:46:42 -05:00
s = s + 1
Next i
SetProgressDisplay(Ubound(FirstList()) + 1)
2001-04-23 04:46:42 -05:00
End Sub
2001-04-23 04:46:42 -05:00
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 b as Integer
2001-04-23 04:46:42 -05:00
Dim sLocExtensionList() as String
b = SearchArrayForPartString(sMimetypeOrExtension, sLocFilterList())
2001-04-23 04:46:42 -05:00
sLocFilterList() = ArrayoutofString(sFiltername(i,1),&quot;|&quot;, MaxIndex)
GetFilterName = sLocFilterList(b)
2001-04-23 04:46:42 -05:00
sLocExtensionList() = ArrayoutofString(sFilterName(i,2), &quot;|&quot;, MaxIndex)
sExtension = sLocExtensionList(b)
2001-04-23 04:46:42 -05:00
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 bLogIsThere as Boolean
2001-05-21 09:52:58 -05:00
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;_default&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
bLogIsThere = oUcb.Exists(sLogUrl)
If bLogIsThere Then
2001-05-21 09:52:58 -05:00
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
2001-05-21 09:52:58 -05:00
End Sub
2002-11-27 08:42:32 -06:00
Sub InsertTargetUrlToLogDocument(sTargetUrl as String, sComment as String)
Dim oCell as Object
If (bLogExists) And (sTargetUrl &lt;&gt; &quot;&quot;) Then
If sTargetUrl &lt;&gt; &quot;&quot; Then
oCell = oLogTable.GetCellbyPosition(1,oLogTable.Rows.Count-1)
&apos; If ((TargetUrl &lt;&gt;&quot;&quot;) AND (i = 1)) Or ((TargetUrl = &quot;&quot;) AND (i = 0)) Then
InsertCommentToLogCell(sComment, oCell)
&apos; End If
InsertHyperLinkToLogCell(sTargetUrl, oCell)
oLogDocument.Store()
End If
End If
End Sub
2002-11-27 08:42:32 -06:00
Sub InsertSourceUrlToLogDocument(SourceUrl as String, sComment) &apos;
Dim oCell as Object
If bLogExists 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
2002-11-27 08:42:32 -06:00
oCell = oLogTable.GetCellbyPosition(0,oLogTable.Rows.Count-1)
InsertCommentToLogCell(sComment, oCell)
InsertHyperLinkToLogCell(SourceUrl, oCell)
2001-05-21 09:52:58 -05:00
oLogDocument.Store()
End If
2002-07-08 07:44:13 -05:00
End Sub
2002-11-27 08:42:32 -06:00
Sub InsertHyperLinkToLogCell(sUrl as String, oCell as Object)
Dim oLogCursor as Object
Dim LocFileName as String
oLogCursor = oCell.createTextCursor()
oLogCursor.CollapseToStart()
oLogCursor.HyperLinkURL = sUrl
oLogCursor.HyperLinkName = sUrl
oLogCursor.HyperLinkTarget = sUrl
LocFileName = FileNameOutOfPath(sUrl)
oCell.InsertString(oLogCursor, LocFileName,False)
End Sub
Sub InsertCommentToLogCell(sComment as string, oCell as Object)
Dim oCommentCursor as Object
If sComment &lt;&gt; &quot;&quot; Then
oCommentCursor = oCell.createTextCursor()
oCell.insertControlCharacter(oCommentCursor, com.sun.star.text.ControlCharacter.PARAGRAPH_BREAK, False)
oCell.insertString(oCommentCursor, sComment, false)
End If
End Sub
Sub AddLogStatistics()
2002-07-08 07:44:13 -05:00
Dim oCell as Object
Dim oLogCursor as Object
Dim MaxRowIndex as Integer
If bLogExists Then
2002-07-08 07:44:13 -05:00
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)
2002-07-08 07:44:13 -05:00
oLogDocument.Store()
oLogDocument.Dispose()
bLogExists = False
2002-07-08 07:44:13 -05:00
End If
2002-07-15 09:42:29 -05:00
End Sub
Function CheckIfMacroExists(oBasicLibraries as Object, sComment as String) as Boolean
2002-07-15 09:42:29 -05:00
Dim ModuleNames() as String
Dim ModuleName as String
Dim MaxLibIndex as Integer
Dim MaxModuleIndex as Integer
Dim bMacroExists as Boolean
Dim n as Integer
Dim m as Integer
Dim LibName as String
Dim sBasicCode as String
Dim oLibrary as Object
bMacroExists = False
bMacroExists = oBasicLibraries.hasElements
If bMacroExists Then
MaxLibIndex = Ubound(oBasicLibraries.ElementNames())
For n = 0 To MaxLibIndex
LibName = oBasicLibraries.ElementNames(n)
oLibrary = oBasicLibraries.getbyName(LibName)
If oLibrary.hasElements() Then
MaxModuleIndex = Ubound(oLibrary.ElementNames())
For m = 0 To MaxModuleIndex
ModuleName = oLibrary.ElementNames(m)
sBasicCode = oLibrary.getbyName(ModuleName)
If sBasicCode &lt;&gt; &quot;&quot; Then
ConcatComment(sComment, sReeditMacro)
CheckIfMacroExists() = True
Exit Function
End If
Next m
End If
Next n
End If
CheckIfMacroExists() = False
2002-07-15 09:42:29 -05:00
End Function
Function CheckPassWordProtection(oDocument as Object)
Dim bIsPassWordProtected as Boolean
Dim i as Integer
Dim oArgs()
Dim MaxIndex as Integer
2002-09-30 08:54:06 -05:00
Dim sblabla as String
2002-07-15 09:42:29 -05:00
bIsPassWordProtected = false
oArgs() = oDocument.getArgs()
MaxIndex = Ubound(oArgs())
For i = 0 To MaxIndex
2002-09-30 08:54:06 -05:00
sblabla = oArgs(i).Name
If oArgs(i).Name = &quot;Password&quot; Then
2002-07-15 09:42:29 -05:00
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>