diff options
Diffstat (limited to 'smoketestoo_native/data/scripts/Test_10er.xba')
| -rwxr-xr-x | smoketestoo_native/data/scripts/Test_10er.xba | 907 |
1 files changed, 0 insertions, 907 deletions
diff --git a/smoketestoo_native/data/scripts/Test_10er.xba b/smoketestoo_native/data/scripts/Test_10er.xba deleted file mode 100755 index b475dfe53b42..000000000000 --- a/smoketestoo_native/data/scripts/Test_10er.xba +++ /dev/null @@ -1,907 +0,0 @@ -<?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="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 - sExtensionURL = sWorkPathURL - If not FileExists (sExtensionURL + cExtensionFileName) then - if bShowTable then - sDocURL = gOutPutDoc.URL - CompatibilityMode(true) - nStrPos = InStrRev (sDocURL, "/" ) - CompatibilityMode(false) - if nStrPos then - sDocURL = Left (sDocURL, nStrPos) - sExtensionURL = sDocURL - If not FileExists (sExtensionURL + cExtensionFileName) then - bMakeExtensionTest = false ' test is not possible then - end if - else - bMakeExtensionTest = false ' test is not possible then - end if - - else - bMakeExtensionTest = false ' test is not possible then - end if - - end if - - 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) - 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>
\ No newline at end of file |