921 lines
35 KiB
XML
921 lines
35 KiB
XML
<?xml version="1.0" encoding="UTF-8"?>
|
|
<!--**********************************************************************
|
|
*
|
|
* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
|
|
*
|
|
* Copyright 2000, 2010 Oracle and/or its affiliates.
|
|
*
|
|
* OpenOffice.org - a multi-platform office productivity suite
|
|
*
|
|
* This file is part of OpenOffice.org.
|
|
*
|
|
* OpenOffice.org is free software: you can redistribute it and/or modify
|
|
* it under the terms of the GNU Lesser General Public License version 3
|
|
* only, as published by the Free Software Foundation.
|
|
*
|
|
* OpenOffice.org is distributed in the hope that it will be useful,
|
|
* but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
* GNU Lesser General Public License version 3 for more details
|
|
* (a copy is included in the LICENSE file that accompanied this code).
|
|
*
|
|
* You should have received a copy of the GNU Lesser General Public License
|
|
* version 3 along with OpenOffice.org. If not, see
|
|
* <http://www.openoffice.org/license.html>
|
|
* for a copy of the LGPLv3 License.
|
|
*
|
|
**********************************************************************-->
|
|
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
|
|
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="Test_10er" script:language="StarBasic">REM 10er Test
|
|
|
|
const sSWLogFileName = "swlog.dat", sSCLogFileName = "sclog.dat"
|
|
const sSDLogFileName = "sdlog.dat", sSMathLogFileName = "smalog.dat"
|
|
const sSImDLogFileName = "simlog.dat", sSChartLogFileName = "schlog.dat"
|
|
const sSHptLogFileName = "shptlog.dat", sSMessageLogFileName = "smeslog.dat"
|
|
const sSDrawLogFileName = "sdrwlog.dat", sJavaLogFileName = "javalog.dat"
|
|
const sSDBLogFileName = "dblog.dat", sExtLogFileName = "extlog.dat"
|
|
const sLogFileName = "log.dat"
|
|
const cTempFileName = "ttt"
|
|
|
|
const cMessageSaveOpen8Doc = "Save/Open open Documents (8.0)"
|
|
const cMessageSaveOpenXMLDoc = "Save/Open Document XML (6/7)"
|
|
const cMessageSaveOpen50Doc = "Save/Open Document 5.0"
|
|
const cMessageNewDoc = "New Document"
|
|
const cMessageCloseDoc = "Close Document"
|
|
const cMessageCutObj = "Cut Object"
|
|
const cMessagePasteObj = "Paste Object"
|
|
|
|
Global sWorkPath$
|
|
Global sWorkPathURL$
|
|
Global FileChannel%
|
|
Global MainFileChannel%
|
|
|
|
Sub Main
|
|
call TestAllDocs()
|
|
end Sub
|
|
|
|
Sub DeleteAllSavedFiles()
|
|
Dim sFileName as String
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmHyperText)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter or cFltXML)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc or cFltXML)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress or cFltXML)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw or cFltXML)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmWriter or cFlt50)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmCalc or cFlt50)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmImpress or cFlt50)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
sFileName = sWorkPath+cTempFileName+"."+GetDocEndings(frmDraw or cFlt50)
|
|
If FileExists (sFileName) then
|
|
Kill (sFileName)
|
|
End If
|
|
End Sub
|
|
|
|
Sub DeleteAllLogFiles()
|
|
If FileExists (sWorkPath+sLogFileName) then
|
|
Kill (sWorkPath+sLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSWLogFileName) then
|
|
Kill (sWorkPath+sSWLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSCLogFileName) then
|
|
Kill (sWorkPath+sSCLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSDLogFileName) then
|
|
Kill (sWorkPath+sSDLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSMathLogFileName) then
|
|
Kill (sWorkPath+sSMathLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSImDLogFileName) then
|
|
Kill (sWorkPath+sSImDLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSChartLogFileName) then
|
|
Kill (sWorkPath+sSChartLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSHptLogFileName) then
|
|
Kill (sWorkPath+sSHptLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSMessageLogFileName) then
|
|
Kill (sWorkPath+sSMessageLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSDrawLogFileName) then
|
|
Kill (sWorkPath+sSDrawLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sJavaLogFileName) then
|
|
Kill (sWorkPath+sJavaLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sSDBLogFileName) then
|
|
Kill (sWorkPath+sSDBLogFileName)
|
|
End If
|
|
If FileExists (sWorkPath+sExtLogFileName) then
|
|
Kill (sWorkPath+sExtLogFileName)
|
|
End If
|
|
end Sub
|
|
|
|
Function OpenLogDat (sFileName as String) as Integer
|
|
Dim LocaleFileChannel%
|
|
If FileExists (sWorkPath+sFileName) then
|
|
Kill (sWorkPath+sFileName)
|
|
End If
|
|
LocaleFileChannel% = Freefile
|
|
Open sWorkPath+sFileName For Output As LocaleFileChannel%
|
|
OpenLogDat = LocaleFileChannel%
|
|
end Function
|
|
|
|
Function GetWorkPath as string
|
|
sTemp = "$(userpath)/temp/"
|
|
GetWorkPath = CreateUnoService("com.sun.star.config.SpecialConfigManager").SubstituteVariables(sTemp)
|
|
End Function
|
|
|
|
Function GetWorkURL as string
|
|
sTemp = "$(userurl)/temp/"
|
|
GetWorkURL = CreateUnoService("com.sun.star.config.SpecialConfigManager").SubstituteVariables(sTemp)
|
|
End Function
|
|
|
|
Function GetSystem (sTmpWorkPath as string) as string
|
|
GetSystem = ""
|
|
if InStr (sTmpWorkPath, ":") then
|
|
GetSystem = "windows"
|
|
else
|
|
GetSystem = "unix"
|
|
End If
|
|
end Function
|
|
|
|
Function ConvertPathToWin (sTmpWorkPath as string) as string
|
|
for i%=1 to Len(sTmpWorkPath)
|
|
sTemp = Mid (sTmpWorkPath, i%, 1)
|
|
if sTemp = "/" then
|
|
sTmpWorkPath = Left (sTmpWorkPath, i%-1) + "\" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%)
|
|
else
|
|
if sTemp = "|" then
|
|
sTmpWorkPath = Left (sTmpWorkPath, i%-1) + ":" + Right (sTmpWorkPath, Len(sTmpWorkPath)-i%)
|
|
end If
|
|
end If
|
|
next i%
|
|
ConvertPathToWin = sTmpWorkPath
|
|
end Function
|
|
|
|
Sub TestAllDocs()
|
|
DIM sDocURL as String, sDocPath as String
|
|
DIM nStrPos as Long
|
|
|
|
sWorkPath = GetWorkPath
|
|
sWorkPathURL = GetWorkURL
|
|
|
|
if GetSystem (sWorkPath) = "windows" then
|
|
sWorkPath = ConvertPathToWin (sWorkPath)
|
|
end if
|
|
|
|
'search ExtensionURL
|
|
sDocURL = gOutPutDoc.URL
|
|
CompatibilityMode(true)
|
|
nStrPos = InStrRev (sDocURL, "/" )
|
|
CompatibilityMode(false)
|
|
sExtensionURL = Left (sDocURL, nStrPos)
|
|
|
|
call DeleteAllSavedFiles()
|
|
call DeleteAllLogFiles()
|
|
MainFileChannel = OpenLogDat (sLogFileName)
|
|
call WriteTestSequence (MainFileChannel)
|
|
if bMakeWriterTest then
|
|
call MakeDocTest (frmWriter)
|
|
end if
|
|
if bMakeCalcTest then
|
|
call MakeDocTest (frmCalc)
|
|
end if
|
|
if bMakeImpressTest then
|
|
call MakeDocTest (frmImpress)
|
|
end if
|
|
if bMakeDrawTest then
|
|
call MakeDocTest (frmDraw)
|
|
end if
|
|
if bMakeHTMLTest then
|
|
call MakeDocTest (frmHyperText)
|
|
end if
|
|
if bMakeChartTest then
|
|
call MakeChartTest (frmChart)
|
|
end if
|
|
if bMakeMathTest then
|
|
call MakeNewDoc (frmMath)
|
|
end if
|
|
if bMakeJavaTest then
|
|
call TestJava (frmJava)
|
|
end if
|
|
if bMakeDBTest then
|
|
call Test_DB.TestDB (frmDataBase)
|
|
end if
|
|
if bMakeExtensionTest then
|
|
call Test_Ext.TestExtensions (frmExtension)
|
|
end if
|
|
|
|
Close #MainFileChannel
|
|
end Sub
|
|
|
|
Sub WriteTestSequence (FileChannel as integer)
|
|
Print #FileChannel, "Sequence of testing"
|
|
|
|
if bMakeWriterTest then
|
|
WriteTests ("writer : ", true, FileChannel)
|
|
end if
|
|
if bMakeCalcTest then
|
|
WriteTests ("calc : ", true, FileChannel)
|
|
end if
|
|
if bMakeImpressTest then
|
|
WriteTests ("impress : ", true, FileChannel)
|
|
end if
|
|
if bMakeDrawTest then
|
|
WriteTests ("draw : ", true, FileChannel)
|
|
end if
|
|
if bMakeHTMLTest then
|
|
WriteTests ("HTML : ", true, FileChannel)
|
|
end if
|
|
if bMakeChartTest then
|
|
WriteTests ("chart : ", false, FileChannel)
|
|
end if
|
|
if bMakeMathTest then
|
|
WriteTests ("math : ", false, FileChannel)
|
|
end if
|
|
if bMakeJavaTest then
|
|
WriteTests ("Java : ", false, FileChannel)
|
|
end if
|
|
if bMakeDBTest then
|
|
WriteDBTests ("Database : ", FileChannel)
|
|
end if
|
|
if bMakeExtensionTest then
|
|
WriteExtensionTests ("Extension : ", FileChannel)
|
|
end if
|
|
|
|
Print #FileChannel
|
|
end Sub
|
|
|
|
Sub WriteTests (sText as string, bTestAll as boolean, nFileChannel as integer)
|
|
Dim sWriteStr as string
|
|
|
|
sWriteStr = sText
|
|
sWriteStr = sWriteStr + "new"
|
|
if bTestAll then
|
|
if bMakeCutTest then
|
|
sWriteStr = sWriteStr + ", cut"
|
|
end if
|
|
if bMakePasteTest then
|
|
sWriteStr = sWriteStr + ", paste"
|
|
end if
|
|
if bMakeSaveOpen8Test then
|
|
sWriteStr = sWriteStr + ", save 8.0"
|
|
end if
|
|
if bMakeSaveOpenXMLTest then
|
|
sWriteStr = sWriteStr + ", save XML"
|
|
end if
|
|
if bMakeSaveOpen50Test then
|
|
sWriteStr = sWriteStr + ", save 5.0"
|
|
end if
|
|
if bMakeSaveOpen8Test then
|
|
sWriteStr = sWriteStr + ", open 8.0"
|
|
end if
|
|
if bMakeSaveOpenXMLTest then
|
|
sWriteStr = sWriteStr + ", open XML"
|
|
end if
|
|
if bMakeSaveOpen50Test then
|
|
sWriteStr = sWriteStr + ", open 5.0"
|
|
end if
|
|
end if
|
|
|
|
sWriteStr = sWriteStr + ", close"
|
|
|
|
Print #nFileChannel, sWriteStr
|
|
end Sub
|
|
|
|
Sub WriteDBTests (sText as string, nFileChannel as integer)
|
|
Dim sWriteStr as string
|
|
|
|
sWriteStr = sText
|
|
sWriteStr = sWriteStr + "open / services"
|
|
sWriteStr = sWriteStr + ", insert"
|
|
sWriteStr = sWriteStr + ", delete"
|
|
sWriteStr = sWriteStr + ", seek"
|
|
sWriteStr = sWriteStr + ", close"
|
|
|
|
Print #nFileChannel, sWriteStr
|
|
end Sub
|
|
|
|
Sub WriteExtensionTests (sText as string, nFileChannel as integer)
|
|
Dim sWriteStr as string
|
|
|
|
sWriteStr = sText
|
|
sWriteStr = sWriteStr + "services"
|
|
sWriteStr = sWriteStr + ", install"
|
|
sWriteStr = sWriteStr + ", uninstall"
|
|
|
|
Print #nFileChannel, sWriteStr
|
|
end Sub
|
|
|
|
Sub MakeDocTest (FilterType as Integer)
|
|
Dim oDoc as Object
|
|
Dim sFileNameXML$, sFileName50$, sFileName8$
|
|
Dim bError as Boolean
|
|
Dim nCurrentAction as Integer
|
|
|
|
On Local Error GoTo DOCTESTERROR
|
|
nCurrentAction = cLogfileFailed
|
|
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
|
|
nCurrentAction = cDocNew
|
|
oDoc = LoadDoc ("private:factory/" + GetDocFilter(FilterType or cFltNewDoc))
|
|
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
|
|
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
|
|
SetStatus (FilterType, cDocNew, not IsNull (oDoc))
|
|
if not IsNull (oDoc) then
|
|
nCurrentAction = cDocCut
|
|
call CutAndPaste(FilterType, oDoc)
|
|
' bError = oDoc.CurrentController.frame.close
|
|
nCurrentAction = cDocSaveOpen8
|
|
if bMakeSaveOpen8Test and IsFilterAvailable (FilterType or cFlt8) then
|
|
sFileName8 = sWorkPathURL+cTempFileName+"."+GetDocEndings(FilterType or cFlt8)
|
|
SaveDoc (sFileName8, oDoc, GetDocFilter(FilterType or cFlt8))
|
|
end if
|
|
nCurrentAction = cDocSaveOpenXML
|
|
if bMakeSaveOpenXMLTest and IsFilterAvailable (FilterType or cFltXML) then
|
|
sFileNameXML = sWorkPathURL+cTempFileName+"."+GetDocEndings(FilterType or cFltXML)
|
|
SaveDoc (sFileNameXML, oDoc, GetDocFilter(FilterType or cFltXML))
|
|
end if
|
|
nCurrentAction = cDocSaveOpen50
|
|
if bMakeSaveOpen50Test and IsFilterAvailable (FilterType or cFlt50) then
|
|
sFileName50 = sWorkPathURL+cTempFileName+"."+GetDocEndings(FilterType or cFlt50)
|
|
SaveDoc (sFileName50, oDoc, GetDocFilter(FilterType or cFlt50))
|
|
end if
|
|
' oDoc.dispose
|
|
nCurrentAction = cDocClose
|
|
oDoc.close (true)
|
|
' bError = true ' nur zum ¦bergang, weil bError = oDoc.CurrentController.frame.close nicht geht
|
|
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, FileChannel)
|
|
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, MainFileChannel)
|
|
' SetStatus (FilterType, cDocClose, bError)
|
|
nCurrentAction = cDocSaveOpen8
|
|
if bMakeSaveOpen8Test and IsFilterAvailable (FilterType or cFlt8) then
|
|
oDoc = LoadDoc (sFileName8)
|
|
|
|
' oDoc = Documents.open(sFileName)
|
|
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpen8Doc, FileChannel)
|
|
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpen8Doc, MainFileChannel)
|
|
SetStatus (FilterType, cDocSaveOpen8, not IsNull (oDoc))
|
|
|
|
if not IsNull (oDoc) then
|
|
' oDoc.dispose
|
|
nCurrentAction = cDocClose
|
|
oDoc.close (true)
|
|
end If
|
|
end if
|
|
|
|
nCurrentAction = cDocSaveOpenXML
|
|
if bMakeSaveOpenXMLTest and IsFilterAvailable (FilterType or cFltXML) then
|
|
oDoc = LoadDoc (sFileNameXML)
|
|
|
|
' oDoc = Documents.open(sFileName)
|
|
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpenXMLDoc, FileChannel)
|
|
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpenXMLDoc, MainFileChannel)
|
|
SetStatus (FilterType, cDocSaveOpenXML, not IsNull (oDoc))
|
|
|
|
if not IsNull (oDoc) then
|
|
' oDoc.dispose
|
|
nCurrentAction = cDocClose
|
|
oDoc.close (true)
|
|
end If
|
|
end if
|
|
|
|
nCurrentAction = cDocSaveOpen50
|
|
if bMakeSaveOpen50Test and IsFilterAvailable (FilterType or cFlt50) then
|
|
oDoc = LoadDoc (sFileName50)
|
|
|
|
' oDoc = Documents.open(sFileName)
|
|
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpen50Doc, FileChannel)
|
|
LogState (not IsNull (oDoc),GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageSaveOpen50Doc, MainFileChannel)
|
|
SetStatus (FilterType, cDocSaveOpen50, not IsNull (oDoc))
|
|
|
|
if not IsNull (oDoc) then
|
|
' oDoc.dispose
|
|
nCurrentAction = cDocClose
|
|
oDoc.close (true)
|
|
end If
|
|
end if
|
|
end If
|
|
Print #FileChannel, "---"
|
|
Close #FileChannel%
|
|
Exit Sub ' Without error
|
|
|
|
DOCTESTERROR:
|
|
If (nCurrentAction = cLogfileFailed) then
|
|
SetStatus (FilterType, cDocNew, False)
|
|
Exit Sub
|
|
else
|
|
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), FileChannel)
|
|
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), MainFileChannel)
|
|
SetStatus (FilterType, nCurrentAction, False)
|
|
Close #FileChannel%
|
|
End If
|
|
Exit Sub ' With error
|
|
End Sub
|
|
|
|
Sub MakeNewDoc (FilterType as Integer)
|
|
DIM oDoc as Object
|
|
Dim bError as Boolean
|
|
Dim nCurrentAction as Integer
|
|
On Local Error GoTo DOCTESTERROR2
|
|
nCurrentAction = cLogfileFailed
|
|
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
|
|
nCurrentAction = cDocNew
|
|
' oDoc = Documents.Add(GetDocFilter(FilterType))
|
|
oDoc = LoadDoc ("private:factory/" + GetDocFilter(FilterType or cFltNewDoc))
|
|
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
|
|
LogState (not IsNull (oDoc), GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
|
|
SetStatus (FilterType, cDocNew, not IsNull (oDoc))
|
|
if not IsNull (oDoc) then
|
|
nCurrentAction = cDocClose
|
|
' oDoc.dispose
|
|
oDoc.close (true)
|
|
' bError = true ' nur zum ¦bergang, weil bError = oDoc.CurrentController.frame.close nicht geht
|
|
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, FileChannel)
|
|
' LogState (bError, GetDocFilter(FilterType)+" "+ cMessageCloseDoc, MainFileChannel)
|
|
' SetStatus (FilterType, cDocClose, bError)
|
|
end If
|
|
Print #FileChannel, "---"
|
|
Close #FileChannel%
|
|
Exit Sub ' Without error
|
|
|
|
DOCTESTERROR2:
|
|
If (nCurrentAction = cLogfileFailed) then
|
|
SetStatus (FilterType, cDocNew, False)
|
|
Exit Sub
|
|
else
|
|
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), FileChannel)
|
|
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), MainFileChannel)
|
|
SetStatus (FilterType, nCurrentAction, False)
|
|
Close #FileChannel%
|
|
End If
|
|
Exit Sub ' With error
|
|
End Sub
|
|
|
|
Sub MakeChartTest (FilterType as Integer)
|
|
Dim oCharts as Object
|
|
Dim oDoc as Object
|
|
Dim oRange(0) as New com.sun.star.table.CellRangeAddress
|
|
Dim oRect as New com.sun.star.awt.Rectangle
|
|
const cChartName="TestChart"
|
|
Dim bError as Boolean
|
|
Dim nCurrentAction as Integer
|
|
On Local Error GoTo CHARTTESTERROR
|
|
nCurrentAction = cLogfileFailed
|
|
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
|
|
nCurrentAction = cDocNew
|
|
oDoc = LoadDoc ("private:factory/" + GetDocFilter(frmCalc or cFltNewDoc))
|
|
if not IsNull (oDoc) then
|
|
oCharts = oDoc.sheets(0).Charts
|
|
oCharts.AddNewByName (cChartName, oRect, oRange(), true, true)
|
|
bError=oCharts.HasByName(cChartName)
|
|
LogState (bError, GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
|
|
LogState (bError, GetDocFilter(FilterType or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
|
|
SetStatus (FilterType, cDocNew, bError)
|
|
' oDoc.dispose
|
|
nCurrentAction = cDocClose
|
|
oDoc.close (true)
|
|
else
|
|
LogState (not IsNull (oDoc), GetDocFilter(frmCalc or cFltNewDoc)+" "+ cMessageNewDoc, FileChannel)
|
|
LogState (not IsNull (oDoc), GetDocFilter(frmCalc or cFltNewDoc)+" "+ cMessageNewDoc, MainFileChannel)
|
|
SetStatus (frmCalc, cDocNew, not IsNull (oDoc))
|
|
End if
|
|
Print #FileChannel, "---"
|
|
Close #FileChannel%
|
|
Exit Sub ' Without error
|
|
|
|
CHARTTESTERROR:
|
|
If (nCurrentAction = cLogfileFailed) then
|
|
SetStatus (FilterType, cDocNew, False)
|
|
Exit Sub
|
|
else
|
|
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), FileChannel)
|
|
LogState (False, GetDocFilter(FilterType or cFltNewDoc)+" "+ GetErrorMessage(nCurrentAction), MainFileChannel)
|
|
SetStatus (FilterType, nCurrentAction, False)
|
|
Close #FileChannel%
|
|
End If
|
|
Exit Sub ' With error
|
|
End Sub
|
|
|
|
Sub LogState (bState as Boolean, sText as String, nLocaleFileChannel as integer)
|
|
if bState then
|
|
Print #nLocaleFileChannel, sText+" -> ok"
|
|
else
|
|
Print #nLocaleFileChannel, sText+" -> error"
|
|
end If
|
|
end Sub
|
|
|
|
Function GetDocEndings (DocType as Integer) as String
|
|
Select Case ( DocType )
|
|
case frmWriter or cFlt8
|
|
GetDocEndings = "odt" ' Textdokument
|
|
case frmCalc or cFlt8
|
|
GetDocEndings = "ods" 'Tabellendokument
|
|
case frmImpress or cFlt8
|
|
GetDocEndings = "odp" 'PrÕsentation
|
|
case frmDraw or cFlt8
|
|
GetDocEndings = "odg" 'Zeichen
|
|
case frmHyperText, frmHyperText or cFlt50, frmHyperText or cFltXML
|
|
GetDocEndings = "html" 'Hypertext-Dokument
|
|
case frmWriter or cFlt50
|
|
GetDocEndings = "sdw" ' Textdokument 5.0
|
|
case frmCalc or cFlt50
|
|
GetDocEndings = "sdc" 'Tabellendokument 5.0
|
|
case frmImpress or cFlt50
|
|
GetDocEndings = "sdd" 'PrÕsentation 5.0
|
|
case frmDraw or cFlt50
|
|
GetDocEndings = "sda" 'Zeichen 5.0
|
|
case frmWriter or cFltXML
|
|
GetDocEndings = "sxw" ' Textdokument
|
|
case frmCalc or cFltXML
|
|
GetDocEndings = "sxc" 'Tabellendokument
|
|
case frmImpress or cFltXML
|
|
GetDocEndings = "sxi" 'PrÕsentation
|
|
case frmDraw or cFltXML
|
|
GetDocEndings = "sxd" 'Zeichen
|
|
case else
|
|
GetDocEndings = ""
|
|
end Select
|
|
end Function
|
|
|
|
Function GetDocFilter (DocType as Integer) as String
|
|
Select Case ( DocType )
|
|
case frmWriter or cFlt8
|
|
GetDocFilter = "writer8" ' Textdokument
|
|
case frmCalc or cFlt8
|
|
GetDocFilter = "calc8" 'Tabellendokument
|
|
case frmImpress or cFlt8
|
|
GetDocFilter = "impress8" 'Präsentation
|
|
case frmDraw or cFlt8
|
|
GetDocFilter = "draw8" 'Zeichen
|
|
case frmMath or cFlt8
|
|
GetDocFilter = "math8" 'Formel
|
|
|
|
case frmWriter or cFltXML
|
|
GetDocFilter = "StarOffice XML (Writer)" ' Textdokument
|
|
case frmCalc or cFltXML
|
|
GetDocFilter = "StarOffice XML (Calc)" 'Tabellendokument
|
|
case frmImpress or cFltXML
|
|
GetDocFilter = "StarOffice XML (Impress)" 'Präsentation
|
|
case frmDraw or cFltXML
|
|
GetDocFilter = "StarOffice XML (Draw)" 'Zeichen
|
|
case frmMath or cFltXML
|
|
GetDocFilter = "StarOffice XML (Math)" 'Formel
|
|
|
|
case frmHyperText, frmHyperText or cFlt50, frmHyperText or cFltXML
|
|
GetDocFilter = "HTML" 'Hypertext-Dokument
|
|
case frmWriter or cFlt50
|
|
GetDocFilter = "StarWriter 5.0" ' Textdokument 5.0
|
|
case frmCalc or cFlt50
|
|
GetDocFilter = "StarCalc 5.0" 'Tabellendokument 5.0
|
|
case frmImpress or cFlt50
|
|
GetDocFilter = "StarImpress 5.0" 'Präsentation 5.0
|
|
case frmDraw or cFlt50
|
|
GetDocFilter = "StarDraw 5.0" 'Zeichen 5.0
|
|
case frmMath or cFlt50
|
|
GetDocFilter = "StarMath 5.0" 'Formel 5.0
|
|
|
|
case frmWriter or cFltNewDoc
|
|
GetDocFilter = "swriter" ' Textdokument
|
|
case frmCalc or cFltNewDoc
|
|
GetDocFilter = "scalc" 'Tabellendokument
|
|
case frmMessage or cFltNewDoc
|
|
GetDocFilter = "Message" 'Nachricht
|
|
case frmImpress or cFltNewDoc
|
|
GetDocFilter = "simpress" 'Präsentation
|
|
case frmDraw or cFltNewDoc
|
|
GetDocFilter = "sdraw" 'Zeichen
|
|
case frmMath or cFltNewDoc
|
|
GetDocFilter = "smath" 'Formel
|
|
case frmImage or cFltNewDoc
|
|
GetDocFilter = "simage" 'Bild
|
|
case frmHyperText or cFltNewDoc
|
|
GetDocFilter = "swriter/web" 'Hypertext-Dokument
|
|
case frmChart or cFltNewDoc
|
|
GetDocFilter = "schart" 'Diagramm
|
|
case else
|
|
GetDocFilter = ""
|
|
end Select
|
|
end Function
|
|
|
|
Function GetLogFileName (DocType as Integer) as String
|
|
Select Case ( DocType )
|
|
case frmWriter
|
|
GetLogFileName = sSWLogFileName ' Textdokument
|
|
case frmCalc
|
|
GetLogFileName = sSCLogFileName 'Tabellendokument
|
|
case frmMessage
|
|
GetLogFileName = sSMessageLogFileName 'Nachricht
|
|
case frmImpress
|
|
GetLogFileName = sSDLogFileName 'PrÕsentation
|
|
case frmDraw
|
|
GetLogFileName = sSDrawLogFileName 'Zeichnen
|
|
case frmMath
|
|
GetLogFileName = sSMathLogFileName 'Formel
|
|
case frmImage
|
|
GetLogFileName = sSImDLogFileName 'Bild
|
|
case frmHyperText
|
|
GetLogFileName = sSHptLogFileName 'Hypertext-Dokument
|
|
case frmChart
|
|
GetLogFileName = sSChartLogFileName 'Diagramm
|
|
case frmJava
|
|
GetLogFileName = sJavaLogFileName 'Java
|
|
case frmDataBase
|
|
GetLogFileName = sSDBLogFileName 'Database
|
|
case frmExtension
|
|
GetLogFileName = sExtLogFileName 'Extension
|
|
case else
|
|
GetLogFileName = ""
|
|
end Select
|
|
end Function
|
|
|
|
Function GetErrorMessageOnAction (nAction as Integer) as String
|
|
Select Case ( nAction )
|
|
case cDocNew
|
|
GetErrorMessageOnAction = cMessageNewDoc
|
|
case cDocCut
|
|
GetErrorMessageOnAction = cMessageCutObj
|
|
case cDocPaste
|
|
GetErrorMessageOnAction = cMessagePasteObj
|
|
case cDocSaveOpen8
|
|
GetErrorMessageOnAction = cMessageSaveOpen8Doc
|
|
case cDocSaveOpenXML
|
|
GetErrorMessageOnAction = cMessageSaveOpenXMLDoc
|
|
case cDocSaveOpen50
|
|
GetErrorMessageOnAction = cMessageSaveOpen50Doc
|
|
case cDocClose
|
|
GetErrorMessageOnAction = cMessageCloseDoc
|
|
case else
|
|
GetErrorMessageOnAction = ""
|
|
end Select
|
|
end Function
|
|
|
|
Function IsFilterAvailable (FilterType as Integer) as boolean
|
|
IsFilterAvailable = true
|
|
if ((FilterType = (frmHyperText or cFlt50)) or (FilterType = (frmHyperText or cFltXML))) then
|
|
IsFilterAvailable = false
|
|
end if
|
|
End Function
|
|
|
|
Function TestJava (FilterType as Integer) as boolean
|
|
Dim oObj as Object
|
|
FileChannel% = OpenLogDat (GetLogFileName(FilterType))
|
|
oObj = createUnoService(cUnoJavaLoader)
|
|
LogState (not IsNull (oObj), "Java "+ cMessageNewDoc, FileChannel)
|
|
LogState (not IsNull (oObj), "Java "+ cMessageNewDoc, MainFileChannel)
|
|
SetStatus (FilterType, cDocNew, not IsNull (oObj))
|
|
|
|
Print #FileChannel, "---"
|
|
Close #FileChannel%
|
|
|
|
TestJava = not IsNull (oObj)
|
|
End Function
|
|
|
|
Sub CutAndPaste (DocType as Integer, oDoc as Object)
|
|
Dim sText as String
|
|
Dim oWin as Object
|
|
Dim oText as Object
|
|
Dim oView as Object
|
|
Dim bCutState as boolean, bPasteState as boolean
|
|
Select Case ( DocType )
|
|
case frmWriter
|
|
Dim oCursor as Object
|
|
|
|
sText = "AutomaticText"
|
|
oText = oDoc.GetText
|
|
oCursor = oText.CreateTextCursor
|
|
oText.InsertString(oCursor, sText, true) ' Cursor selektiert den Text
|
|
oView = oDoc.getCurrentController
|
|
oView.Select(oCursor)
|
|
|
|
if bMakeCutTest then
|
|
call CutText (oDoc)
|
|
|
|
if oText.GetString = "" Then
|
|
bCutState = True
|
|
else
|
|
bCutState = False
|
|
end If
|
|
SetStatus (DocType, cDocCut, bCutState)
|
|
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, FileChannel)
|
|
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, MainFileChannel)
|
|
end if
|
|
|
|
if bMakePasteTest and bMakeCutTest then
|
|
call PasteText (oDoc)
|
|
|
|
if oText.GetString = sText Then
|
|
bPasteState = True
|
|
else
|
|
bPasteState = False
|
|
end If
|
|
SetStatus (DocType, cDocPaste, bPasteState)
|
|
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, FileChannel)
|
|
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, MainFileChannel)
|
|
end if
|
|
|
|
case frmCalc
|
|
DIM oCell as Object
|
|
|
|
sText = "AutomaticText"
|
|
oCell = oDoc.Sheets(0).GetCellByPosition(0, 0)
|
|
oCell.String = sText
|
|
oView = oDoc.getCurrentController
|
|
oView.Select(oCell)
|
|
|
|
if bMakeCutTest then
|
|
call CutText (oDoc)
|
|
|
|
if oCell.String = "" Then
|
|
bCutState = True
|
|
else
|
|
bCutState = False
|
|
end If
|
|
SetStatus (DocType, cDocCut, bCutState)
|
|
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, FileChannel)
|
|
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, MainFileChannel)
|
|
end if
|
|
|
|
if bMakePasteTest and bMakeCutTest then
|
|
call PasteText (oDoc)
|
|
|
|
if oCell.String = sText Then
|
|
bPasteState = True
|
|
else
|
|
bPasteState = False
|
|
end If
|
|
SetStatus (DocType, cDocPaste, bPasteState)
|
|
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, FileChannel)
|
|
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, MainFileChannel)
|
|
end if
|
|
case frmMessage
|
|
case frmImpress, frmDraw
|
|
Dim oPage as Object
|
|
Dim oRect as Object
|
|
Dim xSize as Object
|
|
Dim xPoint as Object
|
|
Dim bObjState as Boolean
|
|
|
|
xSize = CreateUnoStruct ("com.sun.star.awt.Size")
|
|
xPoint = CreateUnoStruct ("com.sun.star.awt.Point")
|
|
xSize.Width = 2000
|
|
xSize.Height = 2000
|
|
xPoint.x = 10000
|
|
xPoint.y = 10000
|
|
oPage = oDoc.DrawPages(0)
|
|
|
|
if DocType = frmImpress Then
|
|
oPage.Layout = 20 ' set page layot to none
|
|
end If
|
|
|
|
oRect = oDoc.CreateInstance("com.sun.star.drawing.RectangleShape")
|
|
oRect.Size = xSize
|
|
oRect.Position = xPoint
|
|
oPage.add(oRect)
|
|
|
|
oView = oDoc.getCurrentController
|
|
oView.Select(oRect)
|
|
|
|
' Prüft ob überhaupt ein Object angelegt wurde
|
|
if oPage.count = 1 Then
|
|
bObjState = True
|
|
else
|
|
bObjState = False
|
|
end If
|
|
|
|
if bMakeCutTest then
|
|
call CutText (oDoc)
|
|
|
|
if (oPage.count = 0) and bObjState Then
|
|
bCutState = True
|
|
else
|
|
bCutState = False
|
|
end If
|
|
SetStatus (DocType, cDocCut, bCutState)
|
|
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, FileChannel)
|
|
LogState (bCutState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessageCutObj, MainFileChannel)
|
|
end if
|
|
|
|
wait (1000) 'wait after cut
|
|
|
|
if bMakePasteTest and bMakeCutTest then
|
|
call PasteText (oDoc)
|
|
|
|
if (oPage.count = 1) and bObjState Then
|
|
bPasteState = True
|
|
else
|
|
bPasteState = False
|
|
end If
|
|
SetStatus (DocType, cDocPaste, bPasteState)
|
|
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, FileChannel)
|
|
LogState (bPasteState, GetDocFilter(DocType or cFltNewDoc)+" "+ cMessagePasteObj, MainFileChannel)
|
|
end if
|
|
case frmMath
|
|
case frmImage
|
|
case frmHyperText
|
|
case frmChart
|
|
end Select
|
|
end Sub
|
|
|
|
Sub LoadLibrary( LibName as String )
|
|
|
|
dim args(1)
|
|
dim arg as new com.sun.star.beans.PropertyValue
|
|
arg.Name = "LibraryName"
|
|
arg.Value = LibName
|
|
args(0) = arg
|
|
|
|
dim url as new com.sun.star.util.URL
|
|
dim trans as object
|
|
trans = createUnoService("com.sun.star.util.URLTransformer" )
|
|
url.Complete = "slot:6517"
|
|
trans.parsestrict( url )
|
|
|
|
dim disp as object
|
|
disp = StarDesktop.currentFrame.queryDispatch( url, "", 0 )
|
|
disp.dispatch( url, args() )
|
|
|
|
End Sub
|
|
|
|
Sub LoadDoc (DocName as String) as Object
|
|
dim trans as object
|
|
trans = createUnoService("com.sun.star.util.URLTransformer" )
|
|
url = createUnoStruct("com.sun.star.util.URL" )
|
|
url.Complete = DocName
|
|
if Left(DocName, 5 ) <> "file:" then
|
|
trans.parsestrict( url )
|
|
endif
|
|
|
|
Dim aPropArray(0) as Object
|
|
aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue")
|
|
aPropArray(0).Name = "OpenFlags"
|
|
aPropArray(0).Value = "S"
|
|
|
|
dim doc as object
|
|
dim noargs()
|
|
doc = StarDesktop.loadComponentFromURL( url.Complete, "_blank", 0, aPropArray() ) ' XModel
|
|
LoadDoc = doc
|
|
End Sub
|
|
|
|
Sub SaveDoc (DocName as String, oDoc as Object, sFilterName as string )
|
|
dim trans as object
|
|
trans = createUnoService("com.sun.star.util.URLTransformer" )
|
|
url = createUnoStruct("com.sun.star.util.URL" )
|
|
url.Complete = DocName
|
|
if Left(DocName, 5 ) <> "file:" then
|
|
trans.parsestrict( url )
|
|
endif
|
|
|
|
if not (sFilterName = "") then
|
|
Dim aPropArray(0) as Object
|
|
aPropArray(0) = CreateUnoStruct("com.sun.star.beans.PropertyValue")
|
|
aPropArray(0).Name = "FilterName"
|
|
aPropArray(0).Value = sFilterName
|
|
|
|
oDoc.storeAsURL( url.Complete, aPropArray() )
|
|
else
|
|
MessageBox "Filtername is unknown!"
|
|
end if
|
|
end Sub
|
|
</script:module>
|