diff options
| author | Joerg Sievers <jsi@openoffice.org> | 2008-06-13 09:27:15 +0000 |
|---|---|---|
| committer | Joerg Sievers <jsi@openoffice.org> | 2008-06-13 09:27:15 +0000 |
| commit | bdef648517d49f37b1ac4f55d018ea068ef11714 (patch) | |
| tree | f54cd89dab39479cf072acbeb5e3fd2269dea6cb /testautomation/global/tools | |
| parent | 7169efb6cbeb8fa675cd67db426f4289bd2d8240 (diff) | |
Creating clean testautomation modul with changed structure which will be included into the CWS process.
Diffstat (limited to 'testautomation/global/tools')
36 files changed, 16697 insertions, 0 deletions
diff --git a/testautomation/global/tools/closeoffice.bas b/testautomation/global/tools/closeoffice.bas new file mode 100644 index 000000000000..43b0f5e5c147 --- /dev/null +++ b/testautomation/global/tools/closeoffice.bas @@ -0,0 +1,58 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: closeoffice.bas,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Exit the [Star|Open][Office|Suite][.org] nicely +'* +'\************************************************************************************* + +sub main + try + printlog ResetApplication + FileExit "SynchronMode", TRUE + kontext + if active.exists(5) then + active.no 'discard changes + endif + catch + endcatch + wait (gOOoShutdownTimeOut * 1000) +end sub + +sub LoadIncludeFiles + use "global\system\includes\declare.inc" + use "global\system\includes\gvariabl.inc" + call getUseFiles() +end sub + diff --git a/testautomation/global/tools/compressstatus.bas b/testautomation/global/tools/compressstatus.bas new file mode 100755 index 000000000000..a4166e8f9c7f --- /dev/null +++ b/testautomation/global/tools/compressstatus.bas @@ -0,0 +1,194 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: compressstatus.bas,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Compress local written status files for submission +'* +'\*********************************************************************** + +sub main + 'just run, ... + if (gMahler AND (gMahlerLocal<>"")) then + ' just a dummy call to get gDatabasePath set; DON'T call hStatusOut !!! + hStatusIn("writer", "compressstatus.bas") + call compressStatus + else + warnLog "There is nothing to be done - exiting" + endif +end sub + +'------------------------------------------------------------------------- + +sub compressStatus + dim sDestination as string + dim sList(1000) as string + dim i as integer + dim iReturn as integer + dim sJar as string + + sDestination = convertPath(gDatabasePath+"database/" + "mahlerlocal/") + ' create directory beside mahlerlocal +' sJar = convertPath(gDatabasePath+"database/" + convertDateToDatabase(now())) + sJar = convertPath(gDatabasePath+"database/" + convertDateToDatabase(now()) + "-"+removeCharacter(convertTimeToDatabase(now()),asc(":"))) + mkdir sJar + ' create jar file with same name as directory, beside mahlerlocal + try + iReturn = Shell("jar",0,"cMf " + sJar + ".jar" + " -C " + sDestination + " .",TRUE) ' wait until finished + printlog "jar cMf " + sJar + ".jar" + " -C " + sDestination + " ." + catch + printlog "No program 'jar' available" + try + iReturn = Shell("zip",0,"-Djr " + sJar + ".jar" + " " + sDestination,TRUE) ' wait until finished + printlog "zip -Djr " + sJar + ".jar" + " " + sDestination + catch + printlog "No program 'zip' available" + iReturn = fZip(sDestination, sJar +".jar") + endcatch + endcatch + if (iReturn <> 0) then + printlog iReturn + endif + if (iReturn = 0) then + printlog "Filename to submit:" + printlog sJar + ".jar" + ' copy files from mahlerlocal to backupdirectory with same name as jar file + getFileList(sDestination, "*.*", sList()) + for i = 1 to listCount(sList()) + try + filecopy(sList(i), sJar+gPathSigne) + catch + if (1=i) then warnlog "#ixxxxxx# destination file name needs to get named." + filecopy(sList(i), sJar+gPathSigne+DateiExtract(sList(i))) + endcatch + ' delete file in mahlerlocal + kill(sList(i)) + if fileexists(sList(i)) then + warnlog "file couldn't get deleted! remove manually:" + printlog sList(i) + endif + next i + endif +end sub + +'------------------------------------------------------------------------- + +function fZip(sDirectory as string, sZipFileName as string) as integer +'/// Zips the files in the first level of a directory into a file +'///+ The zip file hasn't to exists +'///+ Input: absolut directory path to zip +'///+ Absolut path and filename of zip file + dim oUCB + dim oUCB2 + dim oID + dim oRootContent + dim oInfo + dim oNewStreamContent + dim oFile + dim oArg + Dim aArgs(1) + Dim oProps(0) as new com.sun.star.beans.PropertyValue + Dim oCommand as new com.sun.star.ucb.Command + dim lsFile(500) as string + dim i as integer + dim aArray + dim sString + + fZip = 1 + if fileExists(sZipFileName) then + warnlog "Can't create zip file, because it already exists: '" + sZipFileName + "'" + exit function + endif + if NOT fileExists(sDirectory) then + warnlog "Directory to zip doesn't exist: '" + sDirectory + "'" + exit function + else + aArgs(0) = "Local" + aArgs(1) = "Office" + oUCB = CreateUnoService( "com.sun.star.ucb.UniversalContentBroker" ) + oUCB.initialize( aArgs() ) + printlog "Zip file name: '" + convertToURL(sZipFileName) + "'" + aArray = split(convertToURL(sZipFileName), "/") + sString = join(aArray, "%2F") + printlog "Zip file name: '" + sString + "'" + oID = oUCB.createContentIdentifier( "vnd.sun.star.zip://" + sString ) + oRootContent = oUCB.queryContent( oID ) + oInfo = createUnoStruct( "com.sun.star.ucb.ContentInfo" ) + oInfo.Type = "application/vnd.sun.star.zip-stream" + oInfo.Attributes = 0 + + ' get all files in a directory + getFileNameListLocal (sDirectory+"/","*.txt",lsFile()) + printlog "Going to zip Directory: '" + sDirectory + "'" + for i = 1 to listCount(lsFile()) + printlog "Going to add: " + i + ": '" + lsFile(i) + "'" + oNewStreamContent = oRootContent.createNewContent( oInfo ) + oProps(0).Name = "Title" + oProps(0).Handle = -1 + oProps(0).Value = lsFile(i) ' Filename of one content file in zip + oCommand.Name = "setPropertyValues" + oCommand.Handle = -1 + oCommand.Argument = oProps() + oNewStreamContent.execute( oCommand, 0, Null ) + oUcb2 = createUnoService("com.sun.star.ucb.SimpleFileAccess") + oFile = oUcb2.OpenFileRead(ConvertToURL(sDirectory + "/" + lsFile(i))) + oArg = createUnoStruct( "com.sun.star.ucb.InsertCommandArgument" ) + oArg.Data = oFile + oArg.ReplaceExisting = false + oCommand.Name = "insert" + oCommand.Handle = -1 + oCommand.Argument = oArg + oNewStreamContent.execute( oCommand, 0, Null ) + next i + + REM commit that package file + oCommand.Name = "flush" + oCommand.Handle = -1 + oCommand.Argument = 0 + + oRootContent.execute( oCommand, 0, Null ) + fZip = 0 + endif +end function + +'------------------------------------------------------------------------- + +sub LoadIncludeFiles + use "global\system\includes\master.inc" + use "global\system\includes\gvariabl.inc" + gApplication = "WRITER" + call GetUseFiles +end sub + +'------------------------------------------------------------------------- + diff --git a/testautomation/global/tools/declare.bas b/testautomation/global/tools/declare.bas new file mode 100755 index 000000000000..cea62bc481f6 --- /dev/null +++ b/testautomation/global/tools/declare.bas @@ -0,0 +1,90 @@ +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: declare.bas,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : To get Help ID's from the office +'* +'\************************************************************************************* +sub main + Ich_Moechte_Help_IDs_haben +' Ich_Moechte_Die_Position_Und_Groesse_Eines_Dialoges_Haben ( ChaosDokument ) + +' ! set the proper Kontext for teh Application in the subroutine ! +' Ich_Moechte_Die_Mausposition_Herausbekommen +end sub + + +sub Ich_Moechte_Help_IDs_haben +'/// Get Id's ///' + DisplayHid true +end sub + +sub Ich_Moechte_Die_Position_Und_Groesse_Eines_Dialoges_Haben ( window ) +'/// Get Size an Position from dialogs ///' + Dim i + Dim Px : Dim Py : Dim Sx : Dim Sy + + for i = 1 to 20 + Px = window.GetPosX + Py = window.GetPosY + Sx = window.GetSizeX + Sy = window.GetSizeY + print "x: " + Px + " y: " + Py + " x-: " + Sx + " y-: " + Sy + next i +end sub + +sub Ich_Moechte_Die_Mausposition_Herausbekommen +'/// Get Mouse Position ///' + ' Writer + ' Kontext "DocumentWriter" + ' DocumentWriter.DisplayPercent + + ' Calc + ' Kontext "DocumentCalc" + ' DocumentCalc.DisplayPercent + + ' Draw + ' Kontext "DocumentDraw" + ' DocumentDraw.DisplayPercent + + ' Chart + ' Kontext "DocumentChart" + ' DocumentChart.DisplayPercent +end sub + +sub LoadIncludeFiles + use "global\system\includes\declare.inc" + use "global\system\includes\gvariabl.inc" + Call GetUseFiles() +end sub + diff --git a/testautomation/global/tools/getnames.bas b/testautomation/global/tools/getnames.bas new file mode 100755 index 000000000000..2152b78cc43f --- /dev/null +++ b/testautomation/global/tools/getnames.bas @@ -0,0 +1,160 @@ +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: getnames.bas,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : Creates lists of language dependent filters and OLE objects +'* +'************************************************************************ +'* +' #1 GetOLEObjectNames 'Gets the language dependent OLE object names (UI) +' #0 LoadIncludeFiles +'* +'\*********************************************************************** +sub main + + if ( gPlatgroup = "unx" ) then + warnlog( "Please use a Win32 version to get ALL OLE strings" ) + warnlog( "The <Further Objects> might not be retrieved correctly") + endif + + call GetOLEObjectNames ' create the OLE-object-list + +end sub + +'------------------------------------------------------------------------- + +testcase GetOLEObjectNames + + '///Create a list of default OLE objects for the current Office-release + + dim sOLENames (20) as string + sOLENames( 0 ) = "0" + dim sPath as string + dim sFile as string + + sPath = convertpath( gOfficePath & "user\work" ) + sFile = convertpath( sPath & "\ole_" + iSprache + ".txt" ) + + dim sOLEItem as string + + printlog( "sPath = " & sPath ) + printlog( "sFile = " & sFile ) + + '///<ul><li>Get the list for Writer and Calc application</li> + ' open a new document + gApplication = "WRITER" + call hNewDocument() + + ' open dialog "Insert->Object->OLE Object" + InsertObjectOLEObject + + ' read the entries. Note that the order of the entries is significant, + ' the short names (sc, sw ...) are english only while the OLE names + ' can be of any language + Kontext "OLEObjektEinfuegen" + sOLEItem = "CALC=" + Objekttyp.GetItemText(1) ' calc + call ListAppend ( sOLENames (), sOLEItem ) + + sOLEItem = "CHART=" + Objekttyp.GetItemText(2) ' chart + call ListAppend ( sOLENames (), sOLEItem ) + + sOLEItem = "DRAW=" + Objekttyp.GetItemText(3) ' draw + call ListAppend ( sOLENames (), sOLEItem ) + + sOLEItem = "IMPRESS=" + Objekttyp.GetItemText(4) ' impress + call ListAppend ( sOLENames (), sOLEItem ) + + sOLEItem = "MATH=" + Objekttyp.GetItemText(5) ' math + call ListAppend ( sOLENames (), sOLEItem ) + + OLEObjektEinfuegen.Cancel() + call hCloseDocument() + + ' open calc document + gApplication = "CALC" + call hNewDocument() + + ' open dialog "Insert->Object->OLE Object" + InsertObjectOLEObject + + ' read the entries + Kontext "OLEObjektEinfuegen" + sOLEItem = "WRITER=" + Objekttyp.GetItemText(5) ' writer + call ListAppend ( sOLENames (), sOLEItem ) + + sOLEItem = "OTHER=" + Objekttyp.GetItemText(6) ' other + call ListAppend ( sOLENames (), sOLEItem ) + + OLEObjektEinfuegen.Cancel() + call hCloseDocument() + + ' check if the output directory exists + if ( app.dir( sPath ) = "" ) then + + printlog( "Directory does not exist, trying to create it." ) + mkdir( sPath ) + + endif + + '///<li>write the file to ...global/input/olenames/<app-name></li></ul> + if ( app.dir( sPath ) <> "" ) then + + printlog( "Write list to file" ) + call ListWrite ( sOLENames(), sFile, "utf8" ) + + else + + warnlog( "Failed to write filterlist, the targetdirectory does not exist" ) + + endif + + ' Warn that the file has been written. + warnlog ( "*** NOTE: Manual action required ***" ) + printlog( "Please check " + sFile + " ( UTF8 encoded )!" ) + printlog( "The file containing the newly created OLE-name-lists has to be " ) + printlog( "checked into cvs manually. Its location is: " ) + printlog( gTesttoolPath & "\global\input\olenames\" & gProductName & "\ole_{language-code}.txt" ) + +endcase + +'------------------------------------------------------------------------- + +sub LoadIncludeFiles + use "global\system\includes\master.inc" + use "global\system\includes\gvariabl.inc" + gApplication = "WRITER" + call GetUseFiles +end sub + +'------------------------------------------------------------------------- + diff --git a/testautomation/global/tools/includes/optional/t_basic.inc b/testautomation/global/tools/includes/optional/t_basic.inc new file mode 100644 index 000000000000..cb3db9e9b180 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_basic.inc @@ -0,0 +1,118 @@ +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_basic.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : helge.delfs@sun.com +'* +'* short description : Check basic functions in testtool +'* +'*************************************************************************** +' #1 CheckCommand_Join() as boolean ' Checks the function Join +' #1 CheckCommand_Split() as boolean ' Check the function Split +'\************************************************************************** + + +function CheckCommand_Join() as boolean + Dim BlaBla(10) As String, Test As String + Dim i As Integer + +'/// Syntax: /// +'/// Join(list[, delimiter]) /// +'/// list (Required) /// +'/// One-dimensional array containing substrings to be joined. /// + +'/// delimiter (Optional) /// +'/// String character used to separate the substrings in the /// +'/// returned string. If omitted, the space character (" ") /// +'/// is used. If delimiter is a zero-length string (""), all /// +'/// items in the list are concatenated with no delimiters. /// +'/// Checks this function and returns 'True' if it worked /// + + For i = 0 To 10 + BlaBla(i) = "This is Number" & i + Next i + + Test = Join(BlaBla(), "|") + if Test <> "This is Number0|This is Number1|This is Number2|This is Number3|This is Number4|This is Number5|This is Number6|This is Number7|This is Number8|This is Number9|This is Number10" then + CheckCommand_Join = False + else + CheckCommand_Join = True + endif + +end function + + + +function CheckCommand_Split() as boolean + '/// Syntax: /// + '/// Split(expression[, delimiter[, count]]) /// + '/// expression (Required) /// + '/// String expression containing substrings and delimiters. If /// + '/// expression is a zero-length string, Split returns an empty /// + '/// array, that is, an array with no elements and no data. /// + + '/// delimiter (Optional) /// + '/// String character used to identify substring limits. If omit- /// + '/// ted, the space character (" ") is assumed to be the delimi- /// + '/// ter. If delimiter is a zero-length string, a single-element /// + '/// array containing the entire expression string is returned. /// + + '/// count (Optional) /// + '/// Number of substrings to be returned; -1 indicates that all /// + '/// substrings are returned. /// + + '/// Checks this function and returns 'True' if it worked /// + + Dim BlaBla(10) As String, Test As String + Dim i As Integer, CheckTest() as string + + For i = 0 To 10 + BlaBla(i) = "This is Number" & i + Next i + + Test = Join(BlaBla(), "|") + if Test <> "This is Number0|This is Number1|This is Number2|This is Number3|This is Number4|This is Number5|This is Number6|This is Number7|This is Number8|This is Number9|This is Number10" then + CheckCommand_Split = False + else + CheckTest = Split(Test,"|") + if Ubound(CheckTest) <> 10 then + CheckCommand_Split = False + else + CheckTest = Split(Test,"|",5) + if Ubound(CheckTest) <> 4 then + CheckCommand_Split = False + else + CheckCommand_Split = True + endif + endif + endif + +end function diff --git a/testautomation/global/tools/includes/optional/t_ctrl_1.inc b/testautomation/global/tools/includes/optional/t_ctrl_1.inc new file mode 100644 index 000000000000..57ab5456e8f1 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_ctrl_1.inc @@ -0,0 +1,961 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_ctrl_1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : marc.neumann@sun.com +'* +'* short description : +'* +'******************************************************************* +'* +' #1 hChangeControlSettings +'* +'\****************************************************************** + +function hChangeControlSettings ( sType as String, lsProps( ) ) as Boolean + + if bAsianLan = TRUE then + printlog " ******************************************* " + printlog " *** running on asian office version *** " + printlog " ******************************************* " + else + printlog " ******************************************* " + printlog " *** running on non-asian office version *** " + printlog " ******************************************* " + endif + + Kontext "TabGeneralControl" + if TabGeneralControl.Exists = FALSE then + Kontext "TB_MacroControls" + printlog " activate properties for '" + sType + "'" + Properties.Click + Kontext "TabGeneralControl" + Sleep (1) + end if + + printlog "- change global settings" + NameText.SetText "tt_" + sType + "_tt" + ListAppend ( lsProps(), NameText.GetText ) + + if Enabled.GetSelIndex = 1 then + Enabled.Select 2 + else + Enabled.Select 1 + end if + + ListAppend ( lsProps(), Enabled.GetSelText ) + + if sType <> "dialog" then + if Printable.GetSelIndex = 1 then + Printable.Select 2 + else + Printable.Select 1 + end if + ListAppend ( lsProps(), Printable.GetSelText ) + else + ListAppend ( lsProps(), "not testable" ) ' dummy entry + end if + +' PageStep.More 2 +' ListAppend ( lsProps(), PageStep.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + Order.More 2 + Height.Less 3 + ListAppend ( lsProps(), Order.GetText ) ' have to be checked after another control is changed ( it depends on the number of controls ) + ListAppend ( lsProps(), Height.GetText ) + Width.More 4 + ListAppend ( lsProps(), Width.GetText ) +' PositionX.More 3 +' ListAppend ( lsProps(), PositionX.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' PositionY.Less 2 +' ListAppend ( lsProps(), PositionY.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + Information.SetText "tt info" + ListAppend ( lsProps(), Information.GetText ) + Help.SetText "tt help" + ListAppend ( lsProps(), Help.GetText ) + HelpURL.SetText "www.mopo.de" + ListAppend ( lsProps(), HelpURL.GetText ) + + printlog "- change special settings for '" + sType + "'" +'##### CommandButton ##### + if instr ( lcase ( sType ), "commandbutton" ) then +' SetControlType CTBrowseBox +' Label.TypeKeys "tt_label_tt" +' ListAppend ( lsProps(), Label.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + TabStop.Select 3 + ListAppend ( lsProps(), TabStop.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 5 ) + else + Font.Select ( 5 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 17 + ListAppend ( lsProps(), Background.GetSelText ) +' ButtonType.Select 3 +' ListAppend ( lsProps(), ButtonType.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' if State.GetSelIndex = 1 then +' State.Select 2 +' else +' State.Select 1 +' end if +' ListAppend ( lsProps(), State.GetSelText ) + + ListAppend ( lsProps(), "not testable" ) ' dummy entry + if DefaultButton.GetSelIndex = 1 then + DefaultButton.Select 2 + else + DefaultButton.Select 2 + end if + + ListAppend ( lsProps(), DefaultButton.GetSelText ) + GraphicsButton.Click + + Kontext "GrafikEinfuegenDlg" + Dateiname.SetText ( ConvertPath ( gTesttoolPath + "global\input\graf_inp\baer.tif" ) ) + DateiTyp.Select 1 ' set the filter to 'all formats' + Oeffnen.Click + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), Graphics.GetText ) + GraphicsAlignment.Select 4 + ListAppend ( lsProps(), GraphicsAlignment.GetSelText ) + end if + +'##### ImageControl ##### + if instr ( lcase ( sType ), "imagecontrol" ) then + Background.Select 14 + ListAppend ( lsProps(), Background.GetSelText ) + GraphicsButton.Click + + Kontext "GrafikEinfuegenDlg" + Dateiname.SetText ( ConvertPath ( gTesttoolPath + "global\input\graf_inp\baer.tif" ) ) + DateiTyp.Select 1 ' set the filter to 'all formats' + Oeffnen.Click + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), Graphics.GetText ) +' if Scale.GetSelIndex = 1 then +' Scale.Select 2 +' else +' Scale.Select 1 +' end if +' ListAppend ( lsProps(), Scale.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + end if + +'##### CheckBox ##### + if instr ( lcase ( sType ), "checkbox" ) then +' SetControlType CTBrowseBox +' Label.TypeKeys "tt_label_tt" +' ListAppend ( lsProps(), Label.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + TabStop.Select 3 + ListAppend ( lsProps(), TabStop.GetSelText ) + +' if State.GetSelIndex = 1 then +' State.Select 2 +' else +' State.Select 1 +' end if +' ListAppend ( lsProps(), State.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + +' if TriState.GetSelIndex = 1 then +' TriState.Select 2 +' else +' TriState.Select 1 +' end if +' ListAppend ( lsProps(), TriState.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + end if + +'##### OptionButton ##### + if instr ( lcase ( sType ), "optionbutton" ) then +' SetControlType CTBrowseBox +' Label.TypeKeys "tt_label_tt" +' ListAppend ( lsProps(), Label.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + TabStop.Select 3 + ListAppend ( lsProps(), TabStop.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 5 ) + else + Font.Select ( 5 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + +' if State.GetSelIndex = 1 then +' State.Select 2 +' else +' State.Select 1 +' end if +' ListAppend ( lsProps(), State.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + end if + +'##### Label ##### + if instr ( lcase ( sType ), "label" ) then +' SetControlType CTBrowseBox +' Label.TypeKeys "tt_label_tt" +' ListAppend ( lsProps(), Label.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + TabStop.Select 3 + ListAppend ( lsProps(), TabStop.GetSelText ) + + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 5 ) + else + Font.Select ( 5 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + + Align.Select 4 + ListAppend ( lsProps(), Align.GetSelText ) + Background.Select 20 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 3 + ListAppend ( lsProps(), Border.GetSelText ) + + if MultiLine.GetSelIndex = 1 then + MultiLine.Select 2 + else + MultiLine.Select 1 + end if + + ListAppend ( lsProps(), MultiLine.GetSelText ) + end if + +'##### TextField ##### + if instr ( lcase ( sType ), "textfield" ) then +' SetControlType CTBrowseBox +' TextText.TypeKeys "tt_text_tt" +' ListAppend ( lsProps(), TextText.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + MaxTextLen.More 5 + ListAppend ( lsProps(), MaxTextLen.GetText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 3 + ListAppend ( lsProps(), TabStop.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 5 ) + else + Font.Select ( 5 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Align.Select 1 + ListAppend ( lsProps(), Align.GetSelText ) + Background.Select 20 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 3 + ListAppend ( lsProps(), Border.GetSelText ) + + if MultiLine.GetSelIndex = 1 then + MultiLine.Select 2 + else + MultiLine.Select 1 + end if + + ListAppend ( lsProps(), MultiLine.GetSelText ) + + if ManualLineBreak.GetSelIndex = 1 then + ManualLineBreak.Select 2 + else + ManualLineBreak.Select 1 + end if + + ListAppend ( lsProps(), ManualLineBreak.GetSelText ) + + if HorizontalScroll.GetSelIndex = 1 then + HorizontalScroll.Select 2 + else + HorizontalScroll.Select 1 + end if + + ListAppend ( lsProps(), HorizontalScroll.GetSelText ) + + if VerticalScroll.GetSelIndex = 1 then + VerticalScroll.Select 2 + else + VerticalScroll.Select 1 + end if + + ListAppend ( lsProps(), VerticalScroll.GetSelText ) + Password.SetText "t" + ListAppend ( lsProps(), Password.GetText ) + + end if + +'##### Listbox ##### + if instr ( lcase ( sType ), "listbox" ) then + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 3 + ListAppend ( lsProps(), TabStop.GetSelText ) +' SetControlType CTBrowseBox +' ListEntries.TypeKeys "tt_text_tt" +' ListAppend ( lsProps(), ListEntries.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 5 ) + else + Font.Select ( 5 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + + if DropDown.GetSelIndex = 1 then + DropDown.Select 2 + else + DropDown.Select 1 + end if + + ListAppend ( lsProps(), DropDown.GetSelText ) + LineCount.Less 1 + ListAppend ( lsProps(), LineCount.GetText ) + + if MultiSelection.GetSelIndex = 1 then + MultiSelection.Select 2 + else + MultiSelection.Select 1 + end if + + ListAppend ( lsProps(), MultiSelection.GetSelText ) + end if + +'##### Combobox ##### + if instr ( lcase ( sType ), "combobox" ) then + + TextText.SetText "tt_text_tt" + ListAppend ( lsProps(), TextText.GetText ) + MaxTextLen.More 2 + ListAppend ( lsProps(), MaxTextLen.GetText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 3 + ListAppend ( lsProps(), TabStop.GetSelText ) +' SetControlType CTBrowseBox +' ListEntries.TypeKeys "tt_text_tt" +' ListAppend ( lsProps(), ListEntries.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 5 ) + else + Font.Select ( 5 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + + if DropDown.GetSelIndex = 1 then + DropDown.Select 2 + else + DropDown.Select 1 + end if + + ListAppend ( lsProps(), DropDown.GetSelText ) + + if AutoComplete.GetSelIndex = 1 then + AutoComplete.Select 2 + else + AutoComplete.Select 1 + end if + + ListAppend ( lsProps(), AutoComplete.GetSelText ) + LineCount.More 5 + ListAppend ( lsProps(), LineCount.GetText ) + Border.Select 2 ' sometimes the line count is not saved correctly, when it was changed as last property + Border.Select 1 ' as work-around : change another property and then set it to the last entry + + end if + +'##### Scrollbar ##### + if instr ( lcase ( sType ), "scrollbar" ) then + +' ScrollValue.More 5 +' ListAppend ( lsProps(), ScrollValue.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' ScrollValueMax.Less 5 +' ListAppend ( lsProps(), ScrollValueMax.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' LineIncrement.More 1 +' ListAppend ( lsProps(), LineIncrement.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' BlockIncrement.Less 1 +' ListAppend ( lsProps(), BlockIncrement.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' VisibleSize.Less 2 +' ListAppend ( lsProps(), VisibleSize.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' if Orientation.GetSelIndex = 1 then +' Orientation.Select 2 +' else +' Orientation.Select 1 +' end if +' ListAppend ( lsProps(), Orientation.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + Border.Select 2 + ListAppend ( lsProps(), Border.GetSelText ) + end if + +'##### FrameControl ##### + if instr ( lcase ( sType ), "framecontrol" ) then +' SetControlType CTBrowseBox +' Label.TypeKeys "tt_label_tt" +' ListAppend ( lsProps(), Label.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + + end if + +'##### progressBar ##### + if instr ( lcase ( sType ), "progressbar" ) then + +' ScrollValue.More 5 +' ListAppend ( lsProps(), ScrollValue.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' ScrollValueMax.Less 5 +' ListAppend ( lsProps(), ScrollValueMax.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' LineIncrement.More 1 +' ListAppend ( lsProps(), LineIncrement.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' BlockIncrement.Less 1 +' ListAppend ( lsProps(), BlockIncrement.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' VisibleSize.Less 2 +' ListAppend ( lsProps(), VisibleSize.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' if Orientation.GetSelIndex = 1 then +' Orientation.Select 2 +' else +' Orientation.Select 1 +' end if +' ListAppend ( lsProps(), Orientation.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + Background.Select 4 + ListAppend ( lsProps(), Background.GetSelText ) + end if + +'##### FixedLine ##### + if instr ( lcase ( sType ), "fixedline" ) then +' SetControlType CTBrowseBox +' Label.TypeKeys "tt_label_tt" +' ListAppend ( lsProps(), Label.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry +' if Orientation.GetSelIndex = 1 then +' Orientation.Select 2 +' else +' Orientation.Select 1 +' end if +' ListAppend ( lsProps(), Orientation.GetSelText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + end if + + +'##### DateField ##### + if instr ( lcase ( sType ), "datefield" ) then + if StrictFormat.GetSelIndex = 1 then + StrictFormat.Select 2 + else + StrictFormat.Select 1 + end if + ListAppend ( lsProps(), StrictFormat.GetSelText ) + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 2 + ListAppend ( lsProps(), TabStop.GetSelText ) + DateField.More 3 + ListAppend ( lsProps(), DateField.GetText ) + DateMin.More 3 + ListAppend ( lsProps(), DateMin.GetText ) + DateMax.Less 3 + ListAppend ( lsProps(), DateMax.GetText ) + DateFormat.Select 7 + ListAppend ( lsProps(), DateFormat.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + if DropDown.GetSelIndex = 1 then + DropDown.Select 2 + else + DropDown.Select 1 + end if + ListAppend ( lsProps(), DropDown.GetSelText ) + if Spin.GetSelIndex = 1 then + Spin.Select 2 + else + Spin.Select 1 + end if + ListAppend ( lsProps(), Spin.GetSelText ) + end if + +'##### TimeField ##### + if instr ( lcase ( sType ), "timefield" ) then + + if StrictFormat.GetSelIndex = 1 then + StrictFormat.Select 2 + else + StrictFormat.Select 1 + end if + + ListAppend ( lsProps(), StrictFormat.GetSelText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 1 + ListAppend ( lsProps(), TabStop.GetSelText ) + TimeField.Less 3 + ListAppend ( lsProps(), TimeField.GetText ) + TimeMin.More 2 + ListAppend ( lsProps(), TimeMin.GetText ) + TimeMax.Less 3 + ListAppend ( lsProps(), TimeMax.GetText ) + TimeFormat.Select 3 + ListAppend ( lsProps(), TimeFormat.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + + if Spin.GetSelIndex = 1 then + Spin.Select 2 + else + Spin.Select 1 + end if + + ListAppend ( lsProps(), Spin.GetSelText ) + end if + +'##### NumericField ##### + if instr ( lcase ( sType ), "numericfield" ) then + + if StrictFormat.GetSelIndex = 1 then + StrictFormat.Select 2 + else + StrictFormat.Select 1 + end if + + ListAppend ( lsProps(), StrictFormat.GetSelText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 1 + ListAppend ( lsProps(), TabStop.GetSelText ) + Value.Less 3 + ListAppend ( lsProps(), Value.GetText ) + ValueMin.Less 2 + ListAppend ( lsProps(), ValueMin.GetText ) + ValueMax.Less 3 + ListAppend ( lsProps(), ValueMax.GetText ) + ValueStep.More 5 + ListAppend ( lsProps(), ValueStep.GetText ) + Accuray.More 3 + ListAppend ( lsProps(), Accuray.GetText ) + + if ThousandSeperator.GetSelIndex = 1 then + ThousandSeperator.Select 2 + else + ThousandSeperator.Select 1 + end if + + ListAppend ( lsProps(), ThousandSeperator.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + if Spin.GetSelIndex = 1 then + Spin.Select 2 + else + Spin.Select 1 + end if + ListAppend ( lsProps(), Spin.GetSelText ) + end if + + +'##### CurrencyField ##### + if instr ( lcase ( sType ), "currencyfield" ) then + + if StrictFormat.GetSelIndex = 1 then + StrictFormat.Select 2 + else + StrictFormat.Select 1 + end if + + ListAppend ( lsProps(), StrictFormat.GetSelText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 1 + ListAppend ( lsProps(), TabStop.GetSelText ) + Value.Less 3 + ListAppend ( lsProps(), Value.GetText ) + ValueMin.Less 2 + ListAppend ( lsProps(), ValueMin.GetText ) + ValueMax.Less 3 + ListAppend ( lsProps(), ValueMax.GetText ) + ValueStep.More 5 + ListAppend ( lsProps(), ValueStep.GetText ) + Accuray.More 2 + ListAppend ( lsProps(), Accuray.GetText ) + + if ThousandSeperator.GetSelIndex = 1 then + ThousandSeperator.Select 2 + else + ThousandSeperator.Select 1 + end if + + ListAppend ( lsProps(), ThousandSeperator.GetSelText ) + CurrencySymbol.SetText "#" + ListAppend ( lsProps(), CurrencySymbol.GetText ) + + if CurrSymPosition.GetSelIndex = 1 then + CurrSymPosition.Select 2 + else + CurrSymPosition.Select 1 + end if + + ListAppend ( lsProps(), CurrSymPosition.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + + if Spin.GetSelIndex = 1 then + Spin.Select 2 + else + Spin.Select 1 + end if + + ListAppend ( lsProps(), Spin.GetSelText ) + end if + +'##### FormattedField ##### + if instr ( lcase ( sType ), "formattedfield" ) then + MaxTextLen.More 4 + ListAppend ( lsProps(), MaxTextLen.GetText ) + + if StrictFormat.GetSelIndex = 1 then + StrictFormat.Select 2 + else + StrictFormat.Select 1 + end if + + ListAppend ( lsProps(), StrictFormat.GetSelText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 1 + ListAppend ( lsProps(), TabStop.GetSelText ) +' Effective.SetText "2" +' ListAppend ( lsProps(), Effective.GetText ) + ListAppend ( lsProps(), "not testable" ) ' dummy entry + EffectiveMin.SetText "1" + ListAppend ( lsProps(), EffectiveMin.GetText ) + EffectiveMax.SetText "1" + ListAppend ( lsProps(), EffectiveMax.GetText ) + FormatkeyButton.Click + + Kontext "ZahlenFormat" + Kategorie.Select 3 + Kategorieformat.Select ( Kategorieformat.GetItemCount ) + ZahlenFormat.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), FormatKey.GetText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Align.Select 1 + ListAppend ( lsProps(), Align.GetSelText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + + if Spin.GetSelIndex = 1 then + Spin.Select 2 + else + Spin.Select 1 + end if + + ListAppend ( lsProps(), Spin.GetSelText ) + end if + +'##### PatternField ##### + if instr ( lcase ( sType ), "patternfield" ) then + TextText.SetText "tt_text_tt" + ListAppend ( lsProps(), TextText.GetText ) + MaxTextLen.More 4 + ListAppend ( lsProps(), MaxTextLen.GetText ) + EditMask.SetText "aeiopu" + ListAppend ( lsProps(), EditMask.GetText ) + LiteralMask.SetText "upqpsd" + ListAppend ( lsProps(), LiteralMask.GetText ) + + if StrictFormat.GetSelIndex = 1 then + StrictFormat.Select 2 + else + StrictFormat.Select 1 + end if + + ListAppend ( lsProps(), StrictFormat.GetSelText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 1 + ListAppend ( lsProps(), TabStop.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + end if + +'##### FileControl ##### + if instr ( lcase ( sType ), "filecontrol" ) then + TextText.SetText "tt_text_tt" + ListAppend ( lsProps(), TextText.GetText ) + + if Readonly.GetSelIndex = 1 then + Readonly.Select 2 + else + Readonly.Select 1 + end if + + ListAppend ( lsProps(), Readonly.GetSelText ) + TabStop.Select 1 + ListAppend ( lsProps(), TabStop.GetSelText ) + CharacterSetButton.Click + + Kontext "TabFont" + if bAsianLan = TRUE then + FontEast.Select ( 3 ) + else + Font.Select ( 3 ) + endif + TabFont.OK + + Kontext "TabGeneralControl" + ListAppend ( lsProps(), CharacterSet.GetText ) + Background.Select 1 + ListAppend ( lsProps(), Background.GetSelText ) + Border.Select 1 + ListAppend ( lsProps(), Border.GetSelText ) + end if + +end function diff --git a/testautomation/global/tools/includes/optional/t_ctrl_2.inc b/testautomation/global/tools/includes/optional/t_ctrl_2.inc new file mode 100644 index 000000000000..c81e340655c7 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_ctrl_2.inc @@ -0,0 +1,361 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_ctrl_2.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : marc.neumann@sun.com +'* +'* short description : +'* +'******************************************************************* +'* +' #1 hCheckControlSettings +'* +'\****************************************************************** + +function hCheckControlSettings ( sType as String, lsProps( ) ) as Boolean + + Kontext "TabGeneralControl" + if TabGeneralControl.Exists = FALSE then + Kontext "TB_MacroControls" + printlog " activate properties for '" + sType + "'" + Properties.Click + Kontext "TabGeneralControl" + Sleep (1) + end if + + printlog "- check global settings" + if NameText.GetText <> lsProps(1) then Warnlog "Name => changes not saved! should : '" + lsProps(1) + "' is : '" + NameText.GetText + "'" + if Enabled.GetSelText <> lsProps(2) then Warnlog "Enabled => changes not saved! should : '" + lsProps(2) + "' is : '" + Enabled.GetSelText + "'" + if sType <> "dialog" then + if Printable.GetSelText <> lsProps(3) then Warnlog "Printable => changes not saved! should : '" + lsProps(3) + "' is : '" + Printable.GetSelText + "'" + end if +' if PageStep.GetText <> lsProps(4) then Warnlog "Page Step => changes not saved! should : '" + lsProps(4) + "' is : '" + PageStep.GetText + "'" + if Order.GetText <> lsProps(5) then Warnlog "Order => changes not saved! should : '" + lsProps(5) + "' is : '" + Order.GetText + "'" + if Height.GetText <> lsProps(6) then Warnlog "Height => changes not saved! should : '" + lsProps(6) + "' is : '" + Height.GetText + "'" + if Width.GetText <> lsProps(7) then Warnlog "Width => changes not saved! should : '" + lsProps(7) + "' is : '" + Width.GetText + "'" +' if PositionX.GetText <> lsProps(8) then Warnlog "Position x => changes not saved! should : '" + lsProps(8) + "' is : '" + PositionX.GetText + "'" +' if PositionY.GetText <> lsProps(9) then Warnlog "Position y => changes not saved! should : '" + lsProps(9) + "' is : '" + PositionY.GetText + "'" + if Information.GetText <> lsProps(10) then Warnlog "Information => changes not saved! should : '" + lsProps(10) + "' is : '" + Information.GetText + "'" + if Help.GetText <> lsProps(11) then Warnlog "Help => changes not saved! should : '" + lsProps(11) + "' is : '" + Help.GetText + "'" + if HelpURL.GetText <> lsProps(12) then Warnlog "Help URL => changes not saved! should : '" + lsProps(12) + "' is : '" + HelpURL.GetText + "'" + + printlog "- check special settings for " + sType + +'##### CommandButton ##### + if instr ( lcase ( sType ), "commandbutton" ) then +' if Label.GetText <> lsProps(13) then Warnlog "Label => changes not saved! should : '" + lsProps(13) + "' is : '" + Label.GetText + "'" + if TabStop.GetSelText <> lsProps(14) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(14) + "' is : '" + TabStop.GetSelText + "'" + if CharacterSet.GetText <> lsProps(15) then Warnlog "Character set => changes not saved! should : '" + lsProps(15) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(16) then Warnlog "Background => changes not saved! should : '" + lsProps(16) + "' is : '" + Background.GetSelText + "'" +' if ButtonType.GetSelText <> lsProps(17) then Warnlog "Button type => changes not saved! should : '" + lsProps(17) + "' is : '" + ButtonType.GetSelText + "'" +' if State.GetSelText <> lsProps(18) then Warnlog "State => changes not saved! should : '" + lsProps(18) + "' is : '" + State.GetSelText + "'" + if DefaultButton.GetSelText <> lsProps(19) then Warnlog "Default button => changes not saved! should : '" + lsProps(19) + "' is : '" + DefaultButton.GetSelText + "'" + if Graphics.GetText <> lsProps(20) then Warnlog "Graphics => changes not saved! should : '" + lsProps(20) + "' is : '" + Graphics.GetText + "'" + if GraphicsAlignment.GetSelText <> lsProps(21) then Warnlog "Graphics alignment => changes not saved! should : '" + lsProps(21) + "' is : '" + GraphicsAlignment.GetSelText + "'" + end if + +'##### ImageControl ##### + if instr ( lcase ( sType ), "imagecontrol" ) then + if Background.GetSelText <> lsProps(13) then Warnlog "Background => changes not saved! should : '" + lsProps(13) + "' is : '" + Background.GetSelText + "'" + if Graphics.GetText <> lsProps(14) then Warnlog "Graphics => changes not saved! should : '" + lsProps(14) + "' is : '" + Graphics.GetText + "'" +' if Scale.GetSelText <> lsProps(15) then Warnlog "Scale => changes not saved! should : '" + lsProps(15) + "' is : '" + Scale.GetSelText + "'" + end if + +'##### CheckBox ##### + if instr ( lcase ( sType ), "checkbox" ) then +' if Label.GetText <> lsProps(13) then Warnlog "Label => changes not saved! should : '" + lsProps(13) + "' is : '" + Label.GetText + "'" + if TabStop.GetSelText <> lsProps(14) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(14) + "' is : '" + TabStop.GetSelText + "'" +' if State.GetSelText <> lsProps(15) then Warnlog "State => changes not saved! should : '" + lsProps(15) + "' is : '" + State.GetSelText + "'" +' if TriState.GetSelText <> lsProps(16) then Warnlog "TriState => changes not saved! should : '" + lsProps(16) + "' is : '" + TriState.GetSelText + "'" + end if + +'##### OptionButton ##### + if instr ( lcase ( sType ), "optionbutton" ) then +' if Label.GetText <> lsProps(13) then Warnlog "Label => changes not saved! should : '" + lsProps(13) + "' is : '" + Label.GetText + "'" + if TabStop.GetSelText <> lsProps(14) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(14) + "' is : '" + TabStop.GetSelText + "'" + if CharacterSet.GetText <> lsProps(15) then Warnlog "Character set => changes not saved! should : '" + lsProps(15) + "' is : '" + CharacterSet.GetText + "'" +' if State.GetSelText <> lsProps(16) then Warnlog "State => changes not saved! should : '" + lsProps(16) + "' is : '" + State.GetSelText + "'" + end if + +'##### Label ##### + if instr ( lcase ( sType ), "label" ) then +' if Label.GetText <> lsProps(13) then Warnlog "Label => changes not saved! should : '" + lsProps(13) + "' is : '" + Label.GetText + "'" + if TabStop.GetSelText <> lsProps(14) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(14) + "' is : '" + TabStop.GetSelText + "'" + if CharacterSet.GetText <> lsProps(15) then Warnlog "Character set => changes not saved! should : '" + lsProps(15) + "' is : '" + CharacterSet.GetText + "'" + if Align.GetSelText <> lsProps(16) then Warnlog "Alignment => changes not saved! should : '" + lsProps(16) + "' is : '" + Align.GetSelText + "'" + if Background.GetSelText <> lsProps(17) then Warnlog "Background => changes not saved! should : '" + lsProps(17) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(18) then Warnlog "Border => changes not saved! should : '" + lsProps(18) + "' is : '" + Border.GetSelText + "'" + if MultiLine.GetSelText <> lsProps(19) then Warnlog "MultiLine => changes not saved! should : '" + lsProps(19) + "' is : '" + MultiLine.GetSelText + "'" + end if + +'##### TextField ##### + if instr ( lcase ( sType ), "textfield" ) then +' if TextText.GetText <> lsProps(13) then Warnlog "Text => changes not saved! should : '" + lsProps(13) + "' is : '" + TextText.GetText + "'" + if MaxTextLen.GetText <> lsProps(14) then Warnlog "Max text lengh => changes not saved! should : '" + lsProps(14) + "' is : '" + MaxTextLen.GetText + "'" + if Readonly.GetSelText <> lsProps(15) then Warnlog "Readonly => changes not saved! should : '" + lsProps(15) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(16) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(16) + "' is : '" + TabStop.GetSelText + "'" + if CharacterSet.GetText <> lsProps(17) then Warnlog "Character set => changes not saved! should : '" + lsProps(17) + "' is : '" + CharacterSet.GetText + "'" + if Align.GetSelText <> lsProps(18) then Warnlog "Alignment => changes not saved! should : '" + lsProps(18) + "' is : '" + Align.GetSelText + "'" + if Background.GetSelText <> lsProps(19) then Warnlog "Background => changes not saved! should : '" + lsProps(19) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(20) then Warnlog "Border => changes not saved! should : '" + lsProps(20) + "' is : '" + Border.GetSelText + "'" + if MultiLine.GetSelText <> lsProps(21) then Warnlog "MultiLine => changes not saved! should : '" + lsProps(21) + "' is : '" + MultiLine.GetSelText + "'" + if ManualLineBreak.GetSelText <> lsProps(22) then Warnlog "Manual line break => changes not saved! should : '" + lsProps(22) + "' is : '" + ManualLineBreak.GetSelText + "'" + if HorizontalScroll.GetSelText <> lsProps(23) then Warnlog "Horizontal scrollbar => changes not saved! should : '" + lsProps(23) + "' is : '" + HorizontalScroll.GetSelText + "'" + if VerticalScroll.GetSelText <> lsProps(24) then Warnlog "Vertical scrollbar => changes not saved! should : '" + lsProps(24) + "' is : '" + VerticalScroll.GetSelText + "'" + if Password.GetText <> lsProps(25) then Warnlog "Password => changes not saved! should : '" + lsProps(25) + "' is : '" + Password.GetText + "'" + end if + +'##### Listbox ##### + if instr ( lcase ( sType ), "listbox" ) then + if Readonly.GetSelText <> lsProps(13) then Warnlog "Readonly => changes not saved! should : '" + lsProps(13) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(14) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(14) + "' is : '" + TabStop.GetSelText + "'" +' if ListEntries.GetText <> lsProps(15) then Warnlog "List entries => changes not saved! should : '" + lsProps(15) + "' is : '" + ListEntries.GetText + "'" + if CharacterSet.GetText <> lsProps(16) then Warnlog "Character set => changes not saved! should : '" + lsProps(16) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(17) then Warnlog "Background => changes not saved! should : '" + lsProps(17) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(18) then Warnlog "Border => changes not saved! should : '" + lsProps(18) + "' is : '" + Border.GetSelText + "'" + if DropDown.GetSelText <> lsProps(19) then Warnlog "Drop Down => changes not saved! should : '" + lsProps(19) + "' is : '" + DropDown.GetSelText + "'" + if LineCount.GetText <> lsProps(20) then Warnlog "Line counte => changes not saved! should : '" + lsProps(20) + "' is : '" + LineCount.GetText + "'" + if MultiSelection.GetSelText <> lsProps(21) then Warnlog "Multi selection. => changes not saved! should : '" + lsProps(21) + "' is : '" + MultiSelection.GetSelText + "'" + end if + +'##### Combobox ##### + if instr ( lcase ( sType ), "combobox" ) then + if TextText.GetText <> lsProps(13) then Warnlog "Text => changes not saved! should : '" + lsProps(13) + "' is : '" + TextText.GetText + "'" + if MaxTextLen.GetText <> lsProps(14) then Warnlog "Max text lenght => changes not saved! should : '" + lsProps(14) + "' is : '" + MaxTextLen.GetText + "'" + if Readonly.GetSelText <> lsProps(15) then Warnlog "Readonly => changes not saved! should : '" + lsProps(15) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(16) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(16) + "' is : '" + TabStop.GetSelText + "'" +' if ListEntries.GetText <> lsProps(17) then Warnlog "List entries => changes not saved! should : '" + lsProps(17) + "' is : '" + ListEntries.GetText + "'" + if CharacterSet.GetText <> lsProps(18) then Warnlog "Character set => changes not saved! should : '" + lsProps(18) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(19) then Warnlog "Background => changes not saved! should : '" + lsProps(19) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(20) then Warnlog "Border => changes not saved! should : '" + lsProps(20) + "' is : '" + Border.GetSelText + "'" + if DropDown.GetSelText <> lsProps(21) then Warnlog "Drop Down => changes not saved! should : '" + lsProps(21) + "' is : '" + DropDown.GetSelText + "'" + if AutoComplete.GetSelText <> lsProps(22) then Warnlog "Auto complete => changes not saved! should : '" + lsProps(22) + "' is : '" + AutoComplete.GetSelText + "'" + if LineCount.GetText <> lsProps(23) then Warnlog "Line count => changes not saved! should : '" + lsProps(23) + "' is : '" + LineCount.GetText + "'" + end if + +'##### Scrollbar ##### + if instr ( lcase ( sType ), "scrollbar" ) then +' if ScrollValue.GetText <> lsProps(13) then Warnlog "Scroll value => changes not saved! should : '" + lsProps(13) + "' is : '" + ScrollValue.GetText + "'" +' if ScrollValueMax.GetText <> lsProps(14) then Warnlog "Scroll value max => changes not saved! should : '" + lsProps(14) + "' is : '" + ScrollValueMax.GetText + "'" +' if LineIncrement.GetText <> lsProps(15) then Warnlog "Line increment => changes not saved! should : '" + lsProps(15) + "' is : '" + LineIncrement.GetText + "'" +' if BlockIncrement.GetText <> lsProps(16) then Warnlog "Block increment => changes not saved! should : '" + lsProps(16) + "' is : '" + BlockIncrement.GetText + "'" +' if VisibleSize.GetText <> lsProps(17) then Warnlog "Visible size => changes not saved! should : '" + lsProps(17) + "' is : '" + VisibleSize.GetText + "'" +' if Orientation.GetSelText <> lsProps(18) then Warnlog "Orientation => changes not saved! should : '" + lsProps(18) + "' is : '" + Orientation.GetSelText + "'" + if Border.GetSelText <> lsProps(19) then Warnlog "Border => changes not saved! should : '" + lsProps(19) + "' is : '" + Border.GetSelText + "'" + end if + +'##### FrameControl ##### + if instr ( lcase ( sType ), "framecontrol" ) then +' if Label.GetText <> lsProps(13) then Warnlog "Label => changes not saved! should : '" + lsProps(13) + "' is : '" + Label.GetText + "'" + if CharacterSet.GetText <> lsProps(14) then Warnlog "Character set => changes not saved! should : '" + lsProps(14) + "' is : '" + CharacterSet.GetText + "'" + end if + + +'##### progressBar ##### + if instr ( lcase ( sType ), "progressbar" ) then +' if ScrollValue.GetText <> lsProps(13) then Warnlog "Scroll value => changes not saved! should : '" + lsProps(13) + "' is : '" + ScrollValue.GetText + "'" +' if ScrollValueMax.GetText <> lsProps(14) then Warnlog "Scroll value max. => changes not saved! should : '" + lsProps(14) + "' is : '" + ScrollValueMax.GetText + "'"' +' if LineIncrement.GetText <> lsProps(15) then Warnlog "Line increment => changes not saved! should : '" + lsProps(15) + "' is : '" + LineIncrement.GetText + "'"' +' if BlockIncrement.GetText <> lsProps(16) then Warnlog "Block increment => changes not saved! should : '" + lsProps(16) + "' is : '" + BlockIncrement.GetText + "'"' +' if VisibleSize.GetText <> lsProps(17) then Warnlog "Visible size => changes not saved! should : '" + lsProps(17) + "' is : '" + VisibleSize.GetText + "'"' +' if Orientation.GetSelText <> lsProps(18) then Warnlog "Orientation => changes not saved! should : '" + lsProps(18) + "' is : '" + Orientation.GetSelTextGetText + "'"' + if Background.GetSelText <> lsProps(19) then Warnlog "Background => changes not saved! should : '" + lsProps(19) + "' is : '" + Background.GetSelText + "'" + end if + +'##### FixedLine ##### + if instr ( lcase ( sType ), "fixedline" ) then +' if Label.GetText <> lsProps(13) then Warnlog "Label => changes not saved! should : '" + lsProps(13) + "' is : '" + Label.GetText + "'" +' if Orientation.GetSelText <> lsProps(14) then Warnlog "Orientation => changes not saved! should : '" + lsProps(14) + "' is : '" + Orientation.GetSelTextGetText + "'"' + if CharacterSet.GetText <> lsProps(15) then Warnlog "Character set => changes not saved! should : '" + lsProps(15) + "' is : '" + CharacterSet.GetText + "'" + end if + +'##### DateField ##### + if instr ( lcase ( sType ), "datefield" ) then + if StrictFormat.GetSelText <> lsProps(13) then Warnlog "Strict format => changes not saved! should : '" + lsProps(13) + "' is : '" + StrictFormat.GetSelText + "'"' + if Readonly.GetSelText <> lsProps(14) then Warnlog "Read only => changes not saved! should : '" + lsProps(14) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(15) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(15) + "' is : '" + TabStop.GetSelText + "'" + if DateField.GetText <> lsProps(16) then Warnlog "Date => changes not saved! should : '" + lsProps(16) + "' is : '" + DateField.GetSelText + "'" + if DateMin.GetText <> lsProps(17) then Warnlog "Date min. => changes not saved! should : '" + lsProps(17) + "' is : '" + DateMin.GetSelText + "'" + if DateMax.GetText <> lsProps(18) then Warnlog "Date max => changes not saved! should : '" + lsProps(18) + "' is : '" + DateMax.GetSelText + "'" + if DateFormat.GetSelText <> lsProps(19) then Warnlog "Date format => changes not saved! should : '" + lsProps(19) + "' is : '" + DateFormat.GetSelText + "'" + if CharacterSet.GetText <> lsProps(20) then Warnlog "Character set => changes not saved! should : '" + lsProps(20) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(21) then Warnlog "Background => changes not saved! should : '" + lsProps(21) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(22) then Warnlog "Border => changes not saved! should : '" + lsProps(22) + "' is : '" + Border.GetSelText + "'" + if DropDown.GetSelText <> lsProps(23) then Warnlog "Drop Down => changes not saved! should : '" + lsProps(23) + "' is : '" + DropDown.GetSelText + "'" + if Spin.GetSelText <> lsProps(24) then Warnlog "Spin button => changes not saved! should : '" + lsProps(24) + "' is : '" + Spin.GetSelText + "'" + end if + +'##### TimeField ##### + if instr ( lcase ( sType ), "timefield" ) then + if StrictFormat.GetSelText <> lsProps(13) then Warnlog "Strict format => changes not saved! should : '" + lsProps(13) + "' is : '" + StrictFormat.GetSelText + "'"' + if Readonly.GetSelText <> lsProps(14) then Warnlog "Read only => changes not saved! should : '" + lsProps(14) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(15) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(15) + "' is : '" + TabStop.GetSelText + "'" + if TimeField.GetText <> lsProps(16) then Warnlog "Time => changes not saved! should : '" + lsProps(16) + "' is : '" + TimeField.GetText + "'" + if TimeMin.GetText <> lsProps(17) then Warnlog "Time min. => changes not saved! should : '" + lsProps(17) + "' is : '" + TimeMin.GetText + "'" + if TimeMax.GetText <> lsProps(18) then Warnlog "Time max => changes not saved! should : '" + lsProps(18) + "' is : '" + TimeMax.Getext + "'" + if TimeFormat.GetSelText <> lsProps(19) then Warnlog "Time format => changes not saved! should : '" + lsProps(19) + "' is : '" + TimeFormat.GetSelText + "'" + if CharacterSet.GetText <> lsProps(20) then Warnlog "Character set => changes not saved! should : '" + lsProps(20) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(21) then Warnlog "Background => changes not saved! should : '" + lsProps(21) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(22) then Warnlog "Border => changes not saved! should : '" + lsProps(22) + "' is : '" + Border.GetSelText + "'" + if Spin.GetSelText <> lsProps(23) then Warnlog "Spin button => changes not saved! should : '" + lsProps(23) + "' is : '" + Spin.GetSelText + "'" + end if + +'##### NumericField ##### + if instr ( lcase ( sType ), "numericfield" ) then + if StrictFormat.GetSelText <> lsProps(13) then Warnlog "Strict format => changes not saved! should : '" + lsProps(13) + "' is : '" + StrictFormat.GetSelText + "'"' + if Readonly.GetSelText <> lsProps(14) then Warnlog "Read only => changes not saved! should : '" + lsProps(14) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(15) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(15) + "' is : '" + TabStop.GetSelText + "'" + + if Value.GetText <> lsProps(16) then + if Value.GetText <> lsProps(16) + "000" then + Warnlog "Value => changes not saved! should : '" + lsProps(16) + "' is : '" + Value.GetText + "'" + else + Warnlog "Value => changes not saved! should : '" + lsProps(16) + "' is : '" + Value.GetText + "'" + end if + end if + if ValueMin.GetText <> lsProps(17) then + if ValueMin.GetText <> "-1,000,002.00000" then + Warnlog "Value min. => changes not saved! should : '-1,000,002.00000' is : '" + ValueMin.GetText + "'" + else + Warnlog "Value min. => changes not saved! should : '" + lsProps(17) + "' is : '" + ValueMin.GetText + "'" + end if + end if + if ValueMax.GetText <> lsProps(18) then + if ValueMax.GetText <> "999,997.00000" then + Warnlog "Value max => changes not saved! should : '999,997.00000' is : '" + ValueMax.GetText + "'" + else + Warnlog "Value max => changes not saved! should : '" + lsProps(18) + "' is : '" + ValueMax.GetText + "'" + end if + end if + if ValueStep.GetText <> lsProps(19) then Warnlog "Incr./decrement value => changes not saved! should : '" + lsProps(19) + "' is : '" + ValueStep.GetText + "'" + if Accuray.GetText <> lsProps(20) then Warnlog "Dec. accuracy => changes not saved! should : '" + lsProps(20) + "' is : '" + Accuray.GetText + "' Bugid #106852#" + if ThousandSeperator.GetSelText <> lsProps(21) then Warnlog "Thousands seperator => changes not saved! should : '" + lsProps(21) + "' is : '" + ThousandSeperator.GetSelText + "' Bugid #106852#" + if CharacterSet.GetText <> lsProps(22) then Warnlog "Character set => changes not saved! should : '" + lsProps(22) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(23) then Warnlog "Background => changes not saved! should : '" + lsProps(23) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(24) then Warnlog "Border => changes not saved! should : '" + lsProps(24) + "' is : '" + Border.GetSelText + "'" + if Spin.GetSelText <> lsProps(25) then Warnlog "Spin button => changes not saved! should : '" + lsProps(25) + "' is : '" + Spin.GetSelText + "'" + end if + +'##### CurrencyField ##### + if instr ( lcase ( sType ), "currencyfield" ) then + if StrictFormat.GetSelText <> lsProps(13) then Warnlog "Strict format => changes not saved! should : '" + lsProps(13) + "' is : '" + StrictFormat.GetSelText + "'"' + if Readonly.GetSelText <> lsProps(14) then Warnlog "Read only => changes not saved! should : '" + lsProps(14) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(15) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(15) + "' is : '" + TabStop.GetSelText + "'" + if Value.GetText <> lsProps(16) then + if Value.GetText <> lsProps(16) + "000" then + Warnlog "Value => changes not saved! should : '" + lsProps(16) + "' is : '" + Value.GetText + "'" + else + Warnlog "Value => changes not saved! should : '" + lsProps(16) + "' is : '" + Value.GetText + "'" + end if + end if + if ValueMin.GetText <> lsProps(17) then + if ValueMin.GetText <> "-1,000,002.00000" then + Warnlog "Value min. => changes not saved! should : '-1,000,002.00000' is : '" + ValueMin.GetText + "'" + else + Warnlog "Value min. => changes not saved! should : '" + lsProps(17) + "' is : '" + ValueMin.GetText + "'" + end if + end if + if ValueMax.GetText <> lsProps(18) then + if ValueMax.GetText <> "999,997.00000" then + Warnlog "Value max => changes not saved! should : '999,997.00000' is : '" + ValueMax.GetText + "'" + else + Warnlog "Value max => changes not saved! should : '" + lsProps(18) + "' is : '" + ValueMax.GetText + "'" + end if + end if + if ValueStep.GetText <> lsProps(19) then Warnlog "Incr./decrement value => changes not saved! should : '" + lsProps(19) + "' is : '" + ValueStep.GetText + "'" + if Accuray.GetText <> lsProps(20) then Warnlog "Dec. accuracy => changes not saved! should : '" + lsProps(20) + "' is : '" + Accuray.GetText + "' Bugid #106852#" + if ThousandSeperator.GetSelText <> lsProps(21) then Warnlog "Thousands seperator => changes not saved! should : '" + lsProps(21) + "' is : '" + ThousandSeperator.GetSelText + "' Bugid #106852#" + if CurrencySymbol.GetText <> lsProps(22) then Warnlog "Currency symbol => changes not saved! should : '" + lsProps(22) + "' is : '" + CurrencySymbol.GetSelText + "'" + if CurrSymPosition.GetSelText <> lsProps(23) then Warnlog "Prefix symbol => changes not saved! should : '" + lsProps(23) + "' is : '" + CurrSymPosition.GetSelText + "'" + if CharacterSet.GetText <> lsProps(24) then Warnlog "Character set => changes not saved! should : '" + lsProps(24) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(25) then Warnlog "Background => changes not saved! should : '" + lsProps(25) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(26) then Warnlog "Border => changes not saved! should : '" + lsProps(26) + "' is : '" + Border.GetSelText + "'" + if Spin.GetSelText <> lsProps(27) then Warnlog "Spin button => changes not saved! should : '" + lsProps(27) + "' is : '" + Spin.GetSelText + "'" + end if + +'##### FormattedField ##### + if instr ( lcase ( sType ), "formattedfield" ) then + if MaxTextLen.GetText <> lsProps(13) then Warnlog "Max text lenght => changes not saved! should : '" + lsProps(13) + "' is : '" + MaxTextLen.GetText + "'" + if StrictFormat.GetSelText <> lsProps(14) then Warnlog "Strict format => changes not saved! should : '" + lsProps(14) + "' is : '" + StrictFormat.GetSelText + "'"' + if Readonly.GetSelText <> lsProps(15) then Warnlog "Read only => changes not saved! should : '" + lsProps(15) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(16) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(16) + "' is : '" + TabStop.GetSelText + "'" +' if Effective.GetText <> lsProps(17) then Warnlog "Value => changes not saved! should : '" + lsProps(17) + "' is : '" + Effective.GetText + "'" + if EffectiveMin.GetText <> lsProps(18) then + printlog " Bugid #106852#:" + if EffectiveMin.GetText <> "1.00" then + Warnlog "Value min => changes not saved! should : '" + lsProps(18) + "' is : '" + EffectiveMin.GetText + "'" + else + Warnlog "Value min => changes not saved! should : '1.00' is : '" + EffectiveMin.GetText + "'" + end if + end if + if EffectiveMax.GetText <> lsProps(19) then + printlog " Bugid #106852#:" + if EffectiveMax.GetText <> "1.00" then + Warnlog "Value max => changes not saved! should : '1.00' is : '" + EffectiveMax.GetText + "'" + else + Warnlog "Value max => changes not saved! should : '" + lsProps(19) + "' is : '" + EffectiveMax.GetText + "'" + end if + end if + if FormatKey.GetText <> lsProps(20) then Warnlog "Format key => changes not saved! should : '" + lsProps(20) + "' is : '" + FormatKey.GetText + "'" + if CharacterSet.GetText <> lsProps(21) then Warnlog "Character set => changes not saved! should : '" + lsProps(21) + "' is : '" + CharacterSet.GetText + "'" + if Align.GetSelText <> lsProps(22) then Warnlog "Alignment => changes not saved! should : '" + lsProps(22) + "' is : '" + Align.GetSelText + "' BugId #106872#" + if Background.GetSelText <> lsProps(23) then Warnlog "Background => changes not saved! should : '" + lsProps(23) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(24) then Warnlog "Border => changes not saved! should : '" + lsProps(24) + "' is : '" + Border.GetSelText + "'" + if Spin.GetSelText <> lsProps(25) then Warnlog "Spin button => changes not saved! should : '" + lsProps(25) + "' is : '" + Spin.GetSelText + "'" + end if + +'##### PatternField ##### + if instr ( lcase ( sType ), "patternfield" ) then + if TextText.GetText <> lsProps(13) then Warnlog "Text => changes not saved! should : '" + lsProps(13) + "' is : '" + TextText.GetText + "'" + if MaxTextLen.GetText <> lsProps(14) then Warnlog "Max text lenght => changes not saved! should : '" + lsProps(14) + "' is : '" + MaxTextLen.GetText + "'" + if EditMask.GetText <> lsProps(15) then Warnlog "Edit mask => changes not saved! should : '" + lsProps(15) + "' is : '" + EditMask.GetText + "'" + if LiteralMask.GetText <> lsProps(16) then Warnlog "Literal mask => changes not saved! should : '" + lsProps(16) + "' is : '" + LiteralMask.GetText + "'" + if StrictFormat.GetSelText <> lsProps(17) then Warnlog "Strict format => changes not saved! should : '" + lsProps(17) + "' is : '" + StrictFormat.GetSelText + "'"' + if Readonly.GetSelText <> lsProps(18) then Warnlog "Read only => changes not saved! should : '" + lsProps(18) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(19) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(19) + "' is : '" + TabStop.GetSelText + "'" + if CharacterSet.GetText <> lsProps(20) then Warnlog "Character set => changes not saved! should : '" + lsProps(20) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(21) then Warnlog "Background => changes not saved! should : '" + lsProps(21) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(22) then Warnlog "Border => changes not saved! should : '" + lsProps(22) + "' is : '" + Border.GetSelText + "'" + end if + +'##### FileControl ##### + if instr ( lcase ( sType ), "filecontrol" ) then + if TextText.GetText <> lsProps(13) then Warnlog "Text => changes not saved! should : '" + lsProps(13) + "' is : '" + TextText.GetText + "'" + if Readonly.GetSelText <> lsProps(14) then Warnlog "Read only => changes not saved! should : '" + lsProps(14) + "' is : '" + Readonly.GetSelText + "'" + if TabStop.GetSelText <> lsProps(15) then Warnlog "Tab stop => changes not saved! should : '" + lsProps(15) + "' is : '" + TabStop.GetSelText + "'" + if CharacterSet.GetText <> lsProps(16) then Warnlog "Character set => changes not saved! should : '" + lsProps(16) + "' is : '" + CharacterSet.GetText + "'" + if Background.GetSelText <> lsProps(17) then Warnlog "Background => changes not saved! should : '" + lsProps(17) + "' is : '" + Background.GetSelText + "'" + if Border.GetSelText <> lsProps(18) then Warnlog "Border => changes not saved! should : '" + lsProps(18) + "' is : '" + Border.GetSelText + "'" + end if + + +end function diff --git a/testautomation/global/tools/includes/optional/t_locale_strings1.inc b/testautomation/global/tools/includes/optional/t_locale_strings1.inc new file mode 100755 index 000000000000..3bb6d6913817 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_locale_strings1.inc @@ -0,0 +1,549 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_locale_strings1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/*********************************************************************** +'* +'* owner : oliver.craemer@sun.com +'* +'* short description : defining locale dependant strings +'* +'\*********************************************************************** + +function fLocaleString (sReturn as string) as string + +'///The function fLocaleString should be used to concentrate all locale dependant strings +'///+ in one file in order to minimize the workload for adapting a new language +'///Here is a way how to get these strings out of OOo. +'/// - "LocaleTableHeading" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleTableContents" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleNumber" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleText" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleCurrency" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleDate" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleTime" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocalePercent" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleScientific" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleFraction" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleBoolean" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleTable" : run testscript qa\qatesttool\writer\tools\w_get_locale_strings.bas +'/// - "LocaleCurrencyValue" : enter 10 in a cell and format to currency +'/// - "LocaleDateValue" : a valid ( for this locale) date format +'/// - "LocaleDateOutput" : enter a valid date in a cell +'/// - "LocaleTimeInput" : a valid timecode (e.g. 15:42) +'/// - "LocaleTimeValue" : enter 15:42 in a cell +'/// - "LocalePercentValue" : enter 14% in a cell +'/// - "LocaleScientificValue" : enter 1e+008 in a cell +'/// - "LocaleBooleanValue" : enter 1 in a cell and format to boolean value +'/// - "LocaleLocaleSettings" : TOOLS-OPTIONS-LANGUAGE SETTINGS-Language +'/// - "LocaleScriptType" : possible script types are "Western", "CJK" and "CTL" + + Dim sLocaleTableHeading as string + Dim sLocaleTableContents as string + Dim sLocaleNumber as string + Dim sLocaleText as string + Dim sLocaleCurrency as string + Dim sLocaleDate as string + Dim sLocaleTime as string + Dim sLocalePercent as string + Dim sLocaleScientific as string + Dim sLocaleFraction as string + Dim sLocaleBoolean as string + Dim sLocaleTable as string + Dim sLocaleCurrencyValue as string + Dim sLocaleDateValue as string + Dim sLocaleDateOutput as string + Dim sLocaleTimeInput as string + Dim sLocaleTimeValue as string + Dim slocalePercentValue as string + Dim sLocaleScientificValue as string + Dim sLocaleBooleanValue as string + Dim sLocaleLocaleSettings as string + Dim sLocaleScriptType as string + Dim sLocaleNumFormLanEng as string + Dim sLocaleNumFormLanLith as string + Dim sLocaleNumFormLanDutch as string + + select case iSprache + case 01 : sLocaleTableHeading = "Table Heading" ' English (USA) + sLocaleTableContents = "Table Contents" + sLocaleNumber = "Number" + sLocaleText = "Text" + sLocaleCurrency = "Currency" + sLocaleDate = "Date" + sLocaleTime = "Time" + sLocalePercent = "Percent" + sLocaleScientific = "Scientific" + sLocaleFraction = "Fraction" + sLocaleBoolean = "Boolean Value" + sLocaleTable = "Table" + sLocaleCurrencyValue = "$10.00" + sLocaleDateValue = "03/31/06" + sLocaleDateOutput = "03/31/06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "03:42:00 PM" + slocalePercentValue = "14.00%" + sLocaleScientificValue = "1.00E+008" + sLocaleBooleanValue = "TRUE" + sLocaleLocaleSettings = "English (USA)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "English (USA)" + sLocaleNumFormLanLith = "Lithuanian" + sLocaleNumFormLanDutch = "Dutch (Netherlands)" + + case 03 : sLocaleTableHeading = "Cabeçalho da tabela" ' Portuguese + sLocaleTableContents = "Conteúdo da tabela" + sLocaleNumber = "Número" + sLocaleText = "Texto" + sLocaleCurrency = "Moeda" + sLocaleDate = "Data" + sLocaleTime = "Hora" + sLocalePercent = "Percentagem" + sLocaleScientific = "Científico" + sLocaleFraction = "Fracção" + sLocaleBoolean = "Valor logico" + sLocaleTable = "Tabela" + sLocaleCurrencyValue = "10,00 €" + sLocaleDateValue = "31-03-06" + sLocaleDateOutput = "31-03-06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "VERDADEIRO" + sLocaleLocaleSettings = "Português (Portugal)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Inglês (EUA)" + sLocaleNumFormLanLith = "Lituano" + sLocaleNumFormLanDutch = "Flamengo (Holanda)" + + case 07 : sLocaleTableHeading = "Заголовок таблицы" ' Russian + sLocaleTableContents = "Содержимое таблицы" + sLocaleNumber = "Число" + sLocaleText = "Текст" + sLocaleCurrency = "Деньги" + sLocaleDate = "Дата" + sLocaleTime = "TВремя" + sLocalePercent = "Процент" + sLocaleScientific = "Наука" + sLocaleFraction = "Дробь" + sLocaleBoolean = "Логические значения" + sLocaleTable = "Таблица" + sLocaleCurrencyValue = "10,00руб." + sLocaleDateValue = "31.03.06" + sLocaleDateOutput = "31.03.06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "ИСТИНА" + sLocaleLocaleSettings = "Русский" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Английский (США)" + sLocaleNumFormLanLith = "Литовский" + sLocaleNumFormLanDutch = "Голландский (Нидерланды)" + + case 31 : sLocaleTableHeading = "Tabelkop" ' Dutch + sLocaleTableContents = "Inhoud tabel" + sLocaleNumber = "Getal" + sLocaleText = "Tekst" + sLocaleCurrency = "Valuta" + sLocaleDate = "Datum" + sLocaleTime = "Tijd" + sLocalePercent = "Procent" + sLocaleScientific = "Wetenschappelijk" + sLocaleFraction = "Breuk" + sLocaleBoolean = "Logische waarde" + sLocaleTable = "Tabel" + sLocaleCurrencyValue = "€ 10,00" + sLocaleDateValue = "31-03-06" + sLocaleDateOutput = "31-03-06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "WAAR" + sLocaleLocaleSettings = "Nederlands (NL)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Engels (VS)" + sLocaleNumFormLanLith = "Litouws" + sLocaleNumFormLanDutch = "Nederlands (NL)" + + case 33 : sLocaleTableHeading = "Titre de tableau" ' French + sLocaleTableContents = "Contenu de tableau" + sLocaleNumber = "Nombre" + sLocaleText = "Texte" + sLocaleCurrency = "Monétaire" + sLocaleDate = "Date" + sLocaleTime = "Heure" + sLocalePercent = "Pourcentage" + sLocaleScientific = "Scientifique" + sLocaleFraction = "Fraction" + sLocaleBoolean = "Valeur logique" + sLocaleTable = "Tableau" + sLocaleCurrencyValue = "10,00 €" + sLocaleDateValue = "31/03/06" + sLocaleDateOutput = "31/03/06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "VRAI" + sLocaleLocaleSettings = "Français (France)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Anglais (U.S.A.)" + sLocaleNumFormLanLith = "Lituanien" + sLocaleNumFormLanDutch = "Néerlandais (Pays-Bas)" + + case 34 : sLocaleTableHeading = "Encabezado de la tabla" ' Spanish + sLocaleTableContents = "Contenido de la tabla" + sLocaleNumber = "Número" + sLocaleText = "Texto" + sLocaleCurrency = "Moneda" + sLocaleDate = "Fecha" + sLocaleTime = "Hora" + sLocalePercent = "Porcentaje" + sLocaleScientific = "Ciencia" + sLocaleFraction = "Fracción" + sLocaleBoolean = "Valor lógico" + sLocaleTable = "Tabla" + sLocaleCurrencyValue = "10,00 €" + sLocaleDateValue = "31/03/06" + sLocaleDateOutput = "31/03/06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "VERDADERO" + sLocaleLocaleSettings = "Español (España)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Inglés (Estados Unidos)" + sLocaleNumFormLanLith = "Lituano" + sLocaleNumFormLanDutch = "Holandés (Países Bajos)" + + case 36 : sLocaleTableHeading = "Táblázatfejléc" ' Hungarian + sLocaleTableContents = "Táblázattartalom" + sLocaleNumber = "Szám" + sLocaleText = "Szöveg" + sLocaleCurrency = "Pénznem" + sLocaleDate = "Dátum" + sLocaleTime = "Idő" + sLocalePercent = "Százalék" + sLocaleScientific = "Tudományos" + sLocaleFraction = "Tört" + sLocaleBoolean = "Logikai érték" + sLocaleTable = "Táblázat" + sLocaleCurrencyValue = "10,00 Ft" + sLocaleDateValue = "06-03-31" + sLocaleDateOutput = "2006-03-31" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "IGAZ" + sLocaleLocaleSettings = "Magyar" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Angol (USA)" + sLocaleNumFormLanLith = "Litván" + sLocaleNumFormLanDutch = "Holland (Hollandia)" + + case 39 : sLocaleTableHeading = "Intestazione tabella" ' Italian + sLocaleTableContents = "Contenuto tabella" + sLocaleNumber = "Numero" + sLocaleText = "Testo" + sLocaleCurrency = "Valuta" + sLocaleDate = "Data" + sLocaleTime = "Orario" + sLocalePercent = "Percentuale" + sLocaleScientific = "Scientifico" + sLocaleFraction = "Frazione" + sLocaleBoolean = "Valore booleano" + sLocaleTable = "Tabella" + sLocaleCurrencyValue = "€ 10,00" + sLocaleDateValue = "31/03/06" + sLocaleDateOutput = "31/03/06" + sLocaleTimeInput = "15.42" + sLocaleTimeValue = "15.42.00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "VERO" + sLocaleLocaleSettings = "Italiano (Italia)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Inglese (USA)" + sLocaleNumFormLanLith = "Lituano" + sLocaleNumFormLanDutch = "Olandese (Paesi Bassi)" + + case 46 : sLocaleTableHeading = "Tabellöverskrift" ' Swedish + sLocaleTableContents = "Tabellinnehåll" + sLocaleNumber = "Tal" + sLocaleText = "Text" + sLocaleCurrency = "Valuta" + sLocaleDate = "Datum" + sLocaleTime = "Tid" + sLocalePercent = "Procent" + sLocaleScientific = "Vetenskap" + sLocaleFraction = "Bråk" + sLocaleBoolean = "Sannolikhet" + sLocaleTable = "Tabell" + sLocaleCurrencyValue = "10,00 kr" + sLocaleDateValue = "06-03-31" + sLocaleDateOutput = "06-03-31" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "SANT" + sLocaleLocaleSettings = "Svenska (Sverige)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Engelska (USA)" + sLocaleNumFormLanLith = "Litauiska" + sLocaleNumFormLanDutch = "Holländska (Nederländerna)" + + case 48 : sLocaleTableHeading = "Nagłówek tabeli" ' Polish + sLocaleTableContents = "Zawartość tabeli" + sLocaleNumber = "Liczba" + sLocaleText = "Tekst" + sLocaleCurrency = "Waluta" + sLocaleDate = "Data" + sLocaleTime = "Godzina" + sLocalePercent = "Procent" + sLocaleScientific = "Naukowy" + sLocaleFraction = "Ułamek" + sLocaleBoolean = "Wartość logiczna" + sLocaleTable = "Tabela" + sLocaleCurrencyValue = "10,00 zł" + sLocaleDateValue = "2006-03-31" + sLocaleDateOutput = "2006-03-31" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "PRAWDA" + sLocaleLocaleSettings = "Polski" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Angielski (USA)" + sLocaleNumFormLanLith = "Litewski" + sLocaleNumFormLanDutch = "Holenderski (Holandia)" + + case 49 : sLocaleTableHeading = "Tabellen Überschrift" ' German + sLocaleTableContents = "Tabellen Inhalt" + sLocaleNumber = "Zahl" + sLocaleText = "Text" + sLocaleCurrency = "Währung" + sLocaleDate = "Datum" + sLocaleTime = "Zeit" + sLocalePercent = "Prozent" + sLocaleScientific = "Wissenschaft" + sLocaleFraction = "Bruch" + sLocaleBoolean = "Wahrheitswert" + sLocaleTable = "Tabelle" + sLocaleCurrencyValue = "10,00 €" + sLocaleDateValue = "31.03.06" + sLocaleDateOutput = "31.03.06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "WAHR" + sLocaleLocaleSettings = "Deutsch (Deutschland)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Englisch (USA)" + sLocaleNumFormLanLith = "Litauisch" + sLocaleNumFormLanDutch = "Niederländisch (Niederlande)" + + case 55 : sLocaleTableHeading = "Título da tabela" ' Brazil (Portuguese) + sLocaleTableContents = "Conteudo da table" + sLocaleNumber = "Número" + sLocaleText = "Texto" + sLocaleCurrency = "Moeda" + sLocaleDate = "Data" + sLocaleTime = "Hora" + sLocalePercent = "Porcentagem" + sLocaleScientific = "Científico" + sLocaleFraction = "Fração" + sLocaleBoolean = "Valor booleano" + sLocaleTable = "Tabela" + sLocaleCurrencyValue = "R$ 10,00" + sLocaleDateValue = "31/03/06" + sLocaleDateOutput = "31/03/06" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14,00%" + sLocaleScientificValue = "1,00E+008" + sLocaleBooleanValue = "VERDADEIRO" + sLocaleLocaleSettings = "Português (Brasil)" + sLocaleScriptType = "Western" + sLocaleNumFormLanEng = "Inglês (EUA)" + sLocaleNumFormLanLith = "Lituano" + sLocaleNumFormLanDutch = "Flamengo (Holanda)" + + case 81 : sLocaleTableHeading = "表の見出し" ' Japanese + sLocaleTableContents = "表の内容" + sLocaleNumber = "数値" + sLocaleText = "テキスト" + sLocaleCurrency = "通貨" + sLocaleDate = "日付" + sLocaleTime = "時刻" + sLocalePercent = "パーセンテージ" + sLocaleScientific = "科学" + sLocaleFraction = "分数" + sLocaleBoolean = "論理値" + sLocaleTable = "表" + sLocaleCurrencyValue = "￥10" + sLocaleDateValue = "3月31日" + sLocaleDateOutput = "3月31日" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42" + slocalePercentValue = "14%" + sLocaleScientificValue = "1.00E+08" + sLocaleBooleanValue = "TRUE" + sLocaleLocaleSettings = "日本語" + sLocaleScriptType = "CJK" + sLocaleNumFormLanEng = "英語 (米国)" + sLocaleNumFormLanLith = "リトアニア語" + sLocaleNumFormLanDutch = "オランダ語 (オランダ)" + + case 82 : sLocaleTableHeading = "표제목" ' Korean + sLocaleTableContents = "표 내용" + sLocaleNumber = "수" + sLocaleText = "텍스트" + sLocaleCurrency = "통화" + sLocaleDate = "날짜" + sLocaleTime = "시간" + sLocalePercent = "퍼센트" + sLocaleScientific = "과학" + sLocaleFraction = "분수" + sLocaleBoolean = "논리 값" + sLocaleTable = "표" + sLocaleCurrencyValue = "￦10" + sLocaleDateValue = "2006/3/31" + sLocaleDateOutput = "2006년 3월 31" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15시 42분 0초" + slocalePercentValue = "14%" + sLocaleScientificValue = "1.00E+08" + sLocaleBooleanValue = "참" + sLocaleLocaleSettings = "한국어(대한민국)" + sLocaleScriptType = "CJK" + sLocaleNumFormLanEng = "영어(미국)" + sLocaleNumFormLanLith = "리투아니아어" + sLocaleNumFormLanDutch = "네덜란드어(네덜란드)" + + case 86 : sLocaleTableHeading = "表格标题" ' Chinese (simplified) + sLocaleTableContents = "表格内容" + sLocaleNumber = "数字" + sLocaleText = "文字" + sLocaleCurrency = "货币" + sLocaleDate = "日期" + sLocaleTime = "时间" + sLocalePercent = "百分比" + sLocaleScientific = "科学" + sLocaleFraction = "分数" + sLocaleBoolean = "逻辑值" + sLocaleTable = "表格" + sLocaleCurrencyValue = "￥10.00" + sLocaleDateValue = "2006/3/31" + sLocaleDateOutput = "06年3月31日" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14.00%" + sLocaleScientificValue = "1.00E+008" + sLocaleBooleanValue = "真" + sLocaleLocaleSettings = "中文（简体）" + sLocaleScriptType = "CJK" + sLocaleNumFormLanEng = "英语（美国）" + sLocaleNumFormLanLith = "立陶宛语" + sLocaleNumFormLanDutch = "荷兰语（荷兰）" + + case 88 : sLocaleTableHeading = "表格標題" ' Chinese (traditional) + sLocaleTableContents = "表格內容" + sLocaleNumber = "数字" + sLocaleText = "文字" + sLocaleCurrency = "货币" + sLocaleDate = "日期" + sLocaleTime = "时间" + sLocalePercent = "百分比" + sLocaleScientific = "科学" + sLocaleFraction = "分数" + sLocaleBoolean = "逻辑值" + sLocaleTable = "表格" + sLocaleCurrencyValue = "NT$10.00" + sLocaleDateValue = "2006/3/31" + sLocaleDateOutput = "06/3/31" + sLocaleTimeInput = "15:42" + sLocaleTimeValue = "15:42:00" + slocalePercentValue = "14.00%" + sLocaleScientificValue = "1.00E+008" + sLocaleBooleanValue = "真" + sLocaleLocaleSettings = "中文 (繁體)" + sLocaleScriptType = "CJK" + sLocaleNumFormLanEng = "英文 (美國)" + sLocaleNumFormLanLith = "立陶宛文" + sLocaleNumFormLanDutch = "荷蘭文 (比利時)" + + case else : ' Fallback + QAErrorLog "The test does not support language " +iSprache + fLocaleString = "Abortion" + exit function + end select + + select case sReturn + case "LocaleTableHeading" : fLocaleString = slocaleTableHeading + case "LocaleTableContents" : fLocaleString = slocaleTableContents + case "LocaleNumber" : fLocaleString = sLocaleNumber + case "LocaleText" : fLocaleString = sLocaleText + case "LocaleCurrency" : fLocaleString = sLocaleCurrency + case "LocaleDate" : fLocaleString = sLocaleDate + case "LocaleTime" : fLocaleString = sLocaleTime + case "LocalePercent" : fLocaleString = sLocalePercent + case "LocaleScientific" : fLocaleString = sLocaleScientific + case "LocaleFraction" : fLocaleString = sLocaleFraction + case "LocaleBoolean" : fLocaleString = sLocaleBoolean + case "LocaleTable" : fLocaleString = sLocaleTable + case "LocaleCurrencyValue" : fLocaleString = sLocaleCurrencyValue + case "LocaleDateValue" : fLocaleString = sLocaleDateValue + case "LocaleDateOutput" : fLocaleString = sLocaleDateOutput + case "LocaleTimeInput" : fLocaleString = sLocaleTimeInput + case "LocaleTimeValue" : fLocaleString = sLocaleTimeValue + case "LocalePercentValue" : fLocaleString = slocalePercentValue + case "LocaleScientificValue" : fLocaleString = sLocaleScientificValue + case "LocaleBooleanValue" : fLocaleString = sLocaleBooleanValue + case "LocaleLocaleSettings" : fLocaleString = sLocaleLocaleSettings + case "LocaleScriptType" : fLocaleString = sLocaleScriptType + case "LocaleNumFormLanEng" : fLocaleString = sLocaleNumFormLanEng + case "LocaleNumFormLanLith" : fLocaleString = sLocaleNumFormLanLith + case "LocaleNumFormLanDutch" : fLocaleString = sLocaleNumFormLanDutch + + case else : ' Fallback + QAErrorLog "String not available" + fLocaleString = "Abortion" + end select + +end function diff --git a/testautomation/global/tools/includes/optional/t_locale_tools.inc b/testautomation/global/tools/includes/optional/t_locale_tools.inc new file mode 100644 index 000000000000..bfebdf6990fa --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_locale_tools.inc @@ -0,0 +1,70 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_locale_tools.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/*********************************************************************** +'* +'* owner : oliver.craemer@sun.com +'* +'* short description : place it here +'* +'\*********************************************************************** +'* +' #1 fThesaurusLocales 'Get locales which are supported by Thesaurus +'* +'\*********************************************************************** + +function fThesaurusLocales as boolean +'/// Gets the supported thesaurus locales from the API +'/// Returns TRUE if iSprache is supported by Thesaurus +'/// Returns FALSE if iSprache is not supported by Thesaurus + + dim uno as object + dim linugServiceMgr as object + dim aAllLocales (256) as variant + dim sLocale as string + dim i as integer + + fThesaurusLocales = FALSE + uno=hGetUnoService() + linugServiceMgr=uno.createInstance("com.sun.star.linguistic2.LinguServiceManager") + aAllLocales = linugServiceMgr.getThesaurus().getLocales() + for i = 0 to ubound( aAllLocales ()) + sLocale = ( aAllLocales(i).Language & "-" & (aAllLocales(i).Country) ) + printlog sLocale + if ConvertLanguage2 ( sLocale ) = iSprache then + fThesaurusLocales = TRUE + i = ubound( aAllLocales ()) + endif + next i + +end function + + diff --git a/testautomation/global/tools/includes/optional/t_proxy_info.inc b/testautomation/global/tools/includes/optional/t_proxy_info.inc new file mode 100644 index 000000000000..f87d157edc59 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_proxy_info.inc @@ -0,0 +1,144 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_proxy_info.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/****************************************************************************** +'* +'* owner : joerg.skottke@sun.com +'* +'* short description : Tools to retrieve auxilary environment information +'* +'******************************************************************************* +'** +' #1 hGetProxyInfo ' Retrieve the names and ports of the proxies +' #0 hPrintProxyInstructions ' print instructions to the log +'** +'\****************************************************************************** + +function hGetProxyInfo( sSection as string, sItem as string ) as string + + + '///<h3>Retrieve the names and ports of the proxies</h3> + '///<i>This function retrieves the names and ports of the proxies used + '///+ in your local network. The data is taken from a textfile that is + '///+ not visible on OpenOffice.org (Sun security policy)<br> + '///+ If the file is not found a message is printed to the log that + '///+ gives instructions on how to create and format such a file and + '///+ what other steps must be taken to make this work for your local + '///+ network (don't panic, it's simple!).</i><br><br> + + '///<u>Input values:</u><br> + '///<ol> + + '///+<li>Section (string). Valid options:</li> + '///<ul> + '///+<li>"http_proxy"</li> + '///+<li>"ftp_proxy"</li> + '///+<li>"socks_proxy"</li> + '///+<li>"no_proxy_for"</li> + '///</ul> + + '///+<li>Item (string). Valid options:</li> + '///<ul> + '///+<li>"Name"</li> + '///+<li>"Port" (not for "no_proxy_for")</li> + '///</ul> + + '///</ol> + + + '///<u>Return Value:</u><br> + '///<ol> + '///+<li>Name or port of an item (string)</li> + '///<ul> + '///+<li>Empty String on error</li> + '///</ul> + '///</ol> + + const CFN = "hGetProxyInfo::" + + dim irc as integer ' some integer returnvalue + dim crc as string ' some string returnvalue + + ' This is the workfile. Make sure it exists and contains valid data + dim cFile as string + cFile = gTesttoolPath & "sun_global\input\proxies.txt" + ' cFile = gTesttoolPath & "global\input\proxies.txt" + cFile = convertpath ( cFile ) + + ' this is a temporary list that holds the workfile + dim acList( 50 ) as string + + '///<u>Description:</u> + '///<ul> + '///+<li>Open the file, read the section, abort on error</li> + irc = hGetDataFileSection( cFile, acList(), sSection , "" , "" ) + if ( irc = 0 ) then + qaerrorlog( CFN & "File or section not found" ) + hGetProxyInfo() = "" + hPrintProxyInstructions() + exit function + endif + + '///+<li>Isolate the key</li> + crc = hGetValueForKeyAsString( acList(), sItem ) + if ( instr( crc , "Error:" ) > 0 ) then + qaerrorlog( CFN & "The requested item could not be found" ) + hGetProxyInfo() = "" + hPrintProxyInstructions() + exit function + endif + + '///+<li>Return the requested item</li> + + '///</ul> + + hGetProxyInfo() = crc + +end function + +'******************************************************************************* + +function hPrintProxyInstructions() + + printlog( "" ) + printlog( "How to configure proxy settings for your local network" ) + printlog( "" ) + printlog( "1. Edit the sample configuration file" ) + printlog( " Location: global/input/proxies.txt" ) + printlog( " Replace servernames and ports with valid entries" ) + printlog( "" ) + printlog( "2. Edit the function hGetProxyInfo" ) + printlog( " Make the first line with cFile = ... a comment" + printlog( " Make the second line with cFile = ... active" + printlog( " Save the file" ) + printlog( "" ) + +end function diff --git a/testautomation/global/tools/includes/optional/t_server_info.inc b/testautomation/global/tools/includes/optional/t_server_info.inc new file mode 100644 index 000000000000..2fb8db6948d1 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_server_info.inc @@ -0,0 +1,154 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_server_info.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/****************************************************************************** +'* +'* owner : joerg.skottke@sun.com +'* +'* short description : Tools to retrieve information about available servers +'* +'******************************************************************************* +'** +' #1 hGetServerInfo ' Retrieve names and services of some servers +' #0 hPrintServerInstructions ' print instructions to the log +'** +'\****************************************************************************** + +function hGetServerInfo( sType as string, sItem as string ) as string + + + '///<h3>Retrieve names and services of some servers</h3> + '///<i>This function retrieves some information about available + '///+ servers within the LAN. These services can be anything like + '///+ http-server, ftp etc.<br> + '///+ Please make sure you read the comments in the configuration + '///+ file to fully understand what this thing does.</i><br><br> + + '///<u>Input values:</u><br> + '///<ol> + + '///+<li>Type (string). Valid options:</li> + '///<ul> + '///+<li>"http_internal"</li> + '///+<li>"http_external"</li> + '///+<li>"ftp_internal"</li> + '///+<li>"ftp_external"</li> + '///</ul> + + '///+<li>Item (string). Valid options:</li> + '///<ul> + '///+<li>"Name" to get a name for the server</li> + '///+<li>"Port" to get the server's port</li> + '///+<li>"Protocol" to get the supported protocol</li> + '///+<li>"URL" to get the url (e.g. www.heise.de)</li> + '///+<li>"UseProxy" to find out whether proxies are needed or not</li> + '///+<li>"User" to get a loginname</li> + '///+<li>"Pass" to get a password</li> + '///</ul> + + '///</ol> + + + '///<u>Return Value:</u><br> + '///<ol> + '///+<li>Name, port or other info of an item (string)</li> + '///<ul> + '///+<li>Empty String on error</li> + '///+<li>Unique name for a server (can be NIS name)</li> + '///+<li>Port (optional, e.g. 80 for http, 21 for ftp ...)</li> + '///+<li>Protocol (e.g. "http://" or "ftp://"</li> + '///+<li>URL like www.mydomain.de</li> + '///+<li>UseProxy ("yes"/"no")</li> + '///+<li>User (some username)</li> + '///+<li>Password (some password, plain text!) + '///</ul> + '///</ol> + + const CFN = "hGetServerInfo::" + + dim irc as integer ' some integer returnvalue + dim crc as string ' some string returnvalue + + ' This is the workfile. Make sure it exists and contains valid data + dim cFile as string + cFile = gTesttoolPath & "sun_global\input\servers.txt" + ' cFile = gTesttoolPath & "global\input\servers.txt" + cFile = convertpath ( cFile ) + + ' this is a temporary list that holds the workfile + dim acList( 50 ) as string + + '///<u>Description:</u> + '///<ul> + '///+<li>Open the file, read the section, abort on error</li> + irc = hGetDataFileSection( cFile, acList(), sType , "" , "" ) + if ( irc = 0 ) then + qaerrorlog( CFN & "File or section not found" ) + hGetServerInfo() = "" + hPrintServerInstructions() + exit function + endif + + '///+<li>Isolate the key</li> + crc = hGetValueForKeyAsString( acList(), sItem ) + if ( instr( crc , "Error:" ) > 0 ) then + qaerrorlog( CFN & "The requested item could not be found" ) + hGetServerInfo() = "" + hPrintServerInstructions() + exit function + endif + + '///+<li>Return the requested item</li> + + '///</ul> + + hGetServerInfo() = crc + +end function + +'******************************************************************************* + +function hPrintServerInstructions() + + printlog( "" ) + printlog( "How to configure server settings for your local network" ) + printlog( "" ) + printlog( "1. Edit the sample configuration file" ) + printlog( " Location: global/input/servers.txt" ) + printlog( " Replace servernames, ports etc. with valid entries" ) + printlog( "" ) + printlog( "2. Edit the function hGetServerInfo" ) + printlog( " Make the first line with cFile = ... a comment" + printlog( " Make the second line with cFile = ... active" + printlog( " Save the file" ) + printlog( "" ) + +end function diff --git a/testautomation/global/tools/includes/optional/t_set_standard_controls.inc b/testautomation/global/tools/includes/optional/t_set_standard_controls.inc new file mode 100644 index 000000000000..0214fcc01f2c --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_set_standard_controls.inc @@ -0,0 +1,657 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_set_standard_controls.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : Tool library for setting controls and verifying the functionality +'* +'************************************************************************************************** +'* +' #1 tControlsToolsDocumentation 'Documentation of this library +' #0 fSetListBoxByItem 'Function to select item in list box +' #0 fSetListBoxByString 'Function to select item by string in list box +' #0 fSetSpinFieldByString 'Function to set a string in a spin field control +' #0 fSetSpinFieldByButton 'Function to set a spin field control by using 'more' or 'less' button +' #0 fSetSpinFieldByLimit 'Function to set a spin field control to minimum or maximum value +' #0 fSetComboBoxByItem 'Function to select item in combo box +' #0 fSetComboBoxByString 'Function to select item in combo box +' #0 fSetComboBoxByText 'Function to Edit Field part of a combo box +' #0 fSetCheckBox 'Function to (un)check a check box +' #0 fSetRadioButton 'Function to check a radio button +' #0 fSetTextBox 'Function to set a textbox +'* +'\************************************************************************************************ + +testcase tControlsToolsDocumentation +'///<u><b>Library for abtracted handling of several control types</b></u> +'///+Note: This functions are designed to be called by wrapping functions +'///+All functions are designed to return error codes depending on the behaviour of the action applied. +'///<b>Return codes:</b> +'///+<ul><li>Error 0: Success</li> +'///+<li>Error 1: The basic action beeing applied caused a serious problem, e.g. a crash</li> +'///+<li>Error 2 TO 9: A functional problem occured.</li> +'///+<li>Error 11 TO 19: Wrong marginal conditions end up in Failure, e.g. control not visible</li></ul> +'/// NOTE: This errors can also be used for 'negative' testing. +'///+<ul><li>Error 42: Wrong input. Probably only of interest during test development</li> +'///+<li>Error 99: Unexpected behaviour - Shouldn't normally occur</li></ul> +'///<b>ATTENTION:</b> +'///+<ul><li>Only Errors 42 and 99 throw 'warnlogs'</li> +'///+<li>All other errors are silent!</li> +'///+<li>They only throw QAErrorlogs the give a hint what probably went wrong.</li> +'///+<li>Expected Errors MUST exclusivly be handled by the calling routine!</li></ul> +'///+<p><font size=-1><i>The idea and the first implementation of this library has been made by Peter Junge (pj at openoffice.org)</i></font></p> + QAErrorLog "This testcase isn't really meant to be used!!!" +endcase +' +'-------------------------------------------------------------------- +' +function fSetTextBox ( oThisTextBox as OBJECT , sThisText as STRING ) as INTEGER + fSetTextBox = 99 +'Function to set a text box +'Input: +'+OBJECT oThisTextBox (text box name in declaration) +'+STRING sThisText (text to be set in text box control) +' Return (Error-codes): +'+0 = Sucess +'+1 = Serious problem trying to set value +'+2 = Value was not set +'+11 = Text box is not visible +'+12 = Text box is not enabled +'+99 = Unexpected error + + dim iIndex as INTEGER + dim iListLength as INTEGER + dim sResultInUI as STRING + + sResultInUI = "" + + printlog "Setting text in Text Box Edit field" + ' Check if desired Text box is visible + if NOT oThisTextBox.IsVisible then + QAErrorLog "Error 11: Text box is not visible" + fSetTextBox = 11 + exit function + endif + ' Check if desired Text box is enabled + if NOT oThisTextBox.IsEnabled then + QAErrorLog "Error 12: Text box is not enabled" + fSetTextBox = 12 + exit function + endif + ' Try to set text on Text Box + try + oThisTextBox.setText sThisText + catch + ' Throw error 1 and quit on serious problem + qaErrorLog "Error 1: Set text on Text box seems to cause a serious problem." + fSetTextBox = 1 + exit function + endcatch + 'Verify (against input) if text was set correctly + sResultInUI = oThisTextBox.GetText + if sResultInUI = sThisText then + fSetTextBox = 0 + printlog "Set '" & sThisText & "' in 'text box' control PASSED." + else + QAErrorLog "Error 2: Setting '" & sThisText & "' in 'text box' control failed!" + fSetTextBox = 2 + endif + + if fSetTextBox = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetListBoxByItem ( oThisListBox as OBJECT , iThisValue as INTEGER ) as INTEGER + fSetListBoxByItem = 99 +'Function to select item in list box +'Input: +'+OBJECT oThisListBox (list box name in declaration) +'+INTEGER iThisValue (item number to be selected in list box control) +'Return (Error-codes): +'+0 = Sucess +'+ 1 = Serious problem trying to set value +'+ 2 = Value was not set +'+11 = List box is not visible +'+12 = List box is not enabled +'+13 = Item number to be selected out of list range +'+99 = Unexpected error + + dim iListLength as INTEGER + dim iResultFromUI as INTEGER + + iResultFromUI = "" + + printlog "Setting Item in list box" + 'Check if desired list box is visible + if NOT oThisListBox.IsVisible then + QAErrorLog "Error 11: List box is not visible" + fSetListBoxByItem = 11 + exit function + endif + 'Check if desired list box is enabled + if NOT oThisListBox.IsEnabled then + QAErrorLog "Error 12: List box is not enabled" + fSetListBoxByItem = 12 + exit function + endif + 'Check if input value is within list length + iListLength = oThisListBox.GetItemCount + if iThisValue < 1 OR iThisValue > iListLength then + QAErrorLog "Error 13: Item number out of list range" + fSetListBoxByItem = 13 + exit function + endif + 'Try to set value in List Box + try + oThisListBox.select iThisValue + catch + 'Throw error 1 and quit on serious problem + QAErrorLog "Error 1: Set value on list box seems to cause a serious problem." + fSetListBoxByItem = 1 + exit function + endcatch + 'Verify (against input) if item was set correctly + iResultFromUI = oThisListBox.GetSelIndex + if iResultFromUI = iThisValue then + fSetListBoxByItem = 0 + printlog ">> Set value in list box seems to work" + else + QAErrorLog "Error 2: Set value in list box failed." + fSetListBoxByItem = 2 + endif + + if fSetListBoxByItem = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetListBoxByString ( oThisListBox as OBJECT , sThisString as STRING ) as INTEGER + fSetListBoxByString = 99 +'Function to select item by string in list box +'Input: +'+OBJECT oThisListBox (list box name in declaration) +'+STRING sThisString (string trying to match in list box items) +'Return(E rror-codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to set value +'+ 2 = Value was not set +'+11 = List box is not visible +'+12 = List box is not enabled +'+13 = String to be selected doesn't exist in list box +'+99 = Unexpected error + + dim iIndex as INTEGER + dim iListLength as INTEGER + dim bStringIsInList as BOOLEAN + dim sUIStringNow as STRING + + bStringIsInList = FALSE + sUIStringNow = "" + + printlog "** Setting Item in list box" + 'Check if desired list box is visible + if NOT oThisListBox.IsVisible then + qaErrorLog "Error 11: List box is not visible" + fSetListBoxByString = 11 + exit function + endif + 'Check if desired list box is enabled + if NOT oThisListBox.IsEnabled then + qaErrorLog "Error 12: List box is not enabled" + fSetListBoxByString = 12 + exit function + endif + 'Check if input value is existent in list entries + iListLength = oThisListBox.GetItemCount + for iIndex = 1 to iListLength + if oThisListBox.GetItemText ( iIndex ) = sThisString then + bStringIsInList = TRUE + endif + next iIndex + if bStringIsInList then + printlog "OK, String exists in list box" + else + qaErrorLog "Error 13: Input String not found in list entries" + fSetListBoxByString = 13 + exit function + endif + 'Try to set value in List Box + try + oThisListBox.select sThisString + catch + 'Throw error 1 and quit on serious problem + qaErrorLog "Error 1: Set value on list box seems to cause a serious problem." + fSetListBoxByString = 1 + exit function + endcatch + 'Verify (against input) if item was set correctly + sUIStringNow = oThisListBox.GetSelText + if sUIStringNow = sThisString then + fSetListBoxByString = 0 + printlog "Setting value in list box is OK" + else + qaErrorLog "Error 2: Set value in list box failed." + fSetListBoxByString = 2 + endif + + if fSetListBoxByString = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetSpinFieldByString ( oThisSpinField as OBJECT , sThisString as STRING ) as INTEGER + fSetSpinFieldByString = 99 +'Function to set a string in a spin field control +'Input: +'+OBJECT oThisSpinField (spin field name in declaration) +'+STRING sThisString (string to set in spin field control) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to set value +'+11 = Spin field is not visible +'+12 = Spin field is not enabled +'+99 = Unexpected error + + printlog "Setting value in spin field" + 'Check if desired spin field is visible + if NOT oThisSpinField.IsVisible then + qaErrorLog "Error 11: Spin field is not visible" + fSetSpinFieldByString = 11 + exit function + endif + 'Check if desired spin field is enabled + if NOT oThisSpinField.IsEnabled then + qaErrorLog "Error 12: Spin field is not enabled" + fSetSpinFieldByString = 12 + exit function + endif + 'Try to set value in spin field + try + oThisSpinField.setText sThisString + fSetSpinFieldByString = 0 + catch + 'Throw error 1 and quit on serious problem + qaErrorLog "Error 1: Setting value on spin field seems to cause a serious problem." + fSetSpinFieldByString = 1 + exit function + endcatch + if fSetSpinFieldByString = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetSpinFieldByButton ( oThisSpinField as OBJECT , sMoreOrLess as STRING , OPTIONAL iTimes as INTEGER ) as INTEGER + fSetSpinFieldByButton = 99 +'Function to set a spin field control by using More or Less button +'Input: +'+OBJECT oThisSpinField (spin field control name in declaration +'+STRING sMoreOrLess has to be <i>more</i> or <i>less</i> (to click on 'More' or 'Less' button in spin field) +'+<i>optional</i> INTEGER iTimes (How often to click if more than once) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to set value +'+11 = Spin field is not visible +'+12 = Spin field is not enabled +'+42 = User error, input doesn't match +'+99 = Unexpected error + + 'toggle spin field as least once + if isMissing ( iTimes ) then + iTimes = 1 + endif + printlog "Toggle value in spin field" + 'Check if desired spin field is visible + if NOT oThisSpinField.IsVisible then + qaErrorLog "Error 11: Spin field is not visible" + fSetSpinFieldByButton = 11 + exit function + endif + 'Check if desired spin field is enabled + if NOT oThisSpinField.IsEnabled then + qaErrorLog "Error 12: Spin field is not enabled" + fSetSpinFieldByButton = 12 + exit function + endif + 'Try to toggle value in spin field + try + select case lcase ( sMoreOrLess ) + case "more" : oThisSpinField.more ( iTimes ) + case "less" : oThisSpinField.less ( iTimes ) + case else + fSetSpinFieldByButton = 42 + warnlog "USER ERROR: Input doesn't match!" + exit function + end select + fSetSpinFieldByButton = 0 + catch + 'Throw error 1 and quit on serious problem + qaErrorLog "Error 1: Try to toggle spin field seems to cause a serious problem." + fSetSpinFieldByButton = 1 + exit function + endcatch + if fSetSpinFieldByButton = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetSpinFieldByLimit ( oThisSpinField as OBJECT , sMinOrMax as STRING ) as INTEGER + fSetSpinFieldByLimit = 99 +'Function to set a spin field control to minimum or maximum value +'Input: +'+OBJECT oThisSpinField (spin field name in declaration +'+STRING sMinOrMax has to be <i>min</i> or <i>max</i> (to set spin field to minimum or maximum value) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to set value +'+11 = Spin field is not visible +'+12 = Spin field is not enabled +'+42 = User error, input doesn't match +'+99 = Unexpected error + + printlog "Set spin field control to minimum or maximum value" + 'Check if desired spin field is visible + if NOT oThisSpinField.IsVisible then + qaErrorLog "Error 11: Spin field is not visible" + fSetSpinFieldByLimit = 11 + exit function + endif + 'Check if desired spin field is enabled + if NOT oThisSpinField.IsEnabled then + qaErrorLog "Error 12: spin field is not enabled" + fSetSpinFieldByLimit = 12 + exit function + endif + 'Try to set spin field to minimum or maximum value + try + select case lcase ( sMinOrMax ) + case "max" : oThisSpinField.toMax + case "min" : oThisSpinField.toMin + case else + fSetSpinFieldByLimit = 42 + warnlog "USER ERROR: Input doesn't match!" + exit function + end select + fSetSpinFieldByLimit = 0 + catch + 'Throw error 1 and quit on serious problem + qaErrorLog "Error 1: Trying to set spin field to minimum or maximum value seems to cause a serious problem." + fSetSpinFieldByLimit = 1 + exit function + endcatch + if fSetSpinFieldByLimit = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetComboBoxByItem ( oThisComboBox as OBJECT , iThisValue as INTEGER ) as INTEGER +'This is an alias for 'fSetListBoxByItem' + +'Function to select item in combo box +'Input: +'+OBJECT oThisComboBox (combo box name in declaration) +'+INTEGER iThisValue (item number to be selected in Combo box) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to set value +'+ 2 = Value was not set +'+11 = Combo box is not visible +'+12 = Combo box is not enabled +'+13 = Item number to be selected out of list range +'+99 = Unexpected error + fSetComboBoxByItem = fSetListBoxByItem ( oThisComboBox , iThisValue ) +end function +' +'-------------------------------------------------------------------- +' +function fSetComboBoxByString ( oThisComboBox as OBJECT , iThisString as STRING ) as INTEGER +'This is an alias for 'fSetListBoxByString' +'Function to select item in combo box +'Input: +'+OBJECT oThisComboBox (combo box name in declaration) +'+STRING iThisString (string to be selected in combo box control) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to set value +'+ 2 = Value was not set +'+11 = Combo box is not visible +'+12 = Combo box is not enabled +'+13 = String to be selected doesn't exist in list box +'+99 = Unexpected error + fSetComboBoxByString = fSetListBoxByString ( oThisComboBox , iThisString ) +end function +' +'-------------------------------------------------------------------- +' +function fSetComboBoxByText ( oThisComboBox as OBJECT , sThisText as STRING , OPTIONAL bVerifyAgainstEntries as BOOLEAN ) as INTEGER + fSetComboBoxByText = 99 +'Function to Edit Field part of a combo box +'Input: +'+OBJECT oThisComboBox (combo box name in declaration) +'+STRING sThisText (Text to be set in combo box edit field +'+<i>optional</i> BOOLEAN bVerifyAgainstEntries (Check if setting the text succeeded) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to set value +'+ 2 = Value was not set +'+11 = Combo box is not visible +'+12 = Combo box is not enabled +'+13 = String to be selected doesn't exist in list box (if <i>optional</i> input parameter has been used) +'+99 = Unexpected error + + dim iIndex as INTEGER + dim iListLength as INTEGER + dim bStringIsInList as BOOLEAN + dim sStringinUI as STRING + + bStringIsInList = FALSE + sStringinUI = "" + + 'Only check Edit Field against list box if 'bVerifyAgainstEntries' is explizitly TRUE + if isMissing ( bVerifyAgainstEntries ) then + bVerifyAgainstEntries = FALSE + endif + + printlog "Setting text in Combo Box Edit field" + 'Check if desired combo box is visible + if NOT oThisComboBox.IsVisible then + qaErrorLog "Error 11: Combo box is not visible" + fSetComboBoxByText = 11 + exit function + endif + 'Check if desired combo box is enabled + if NOT oThisComboBox.IsEnabled then + qaErrorLog "Error 12: Combo box is not enabled" + fSetComboBoxByText = 12 + exit function + endif + 'Check if input value is existent in list entries (optinal if desired) + if bVerifyAgainstEntries then + iListLength = oThisComboBox.GetItemCount + for iIndex = 1 to iListLength + if oThisComboBox.GetItemText ( iIndex ) = sThisText then + bStringIsInList = TRUE + endif + next iIndex + if bStringIsInList then + printlog "OK, string exists in list box control" + else + qaErrorLog "Error 13: Input string not found in list entries" + fSetComboBoxByText = 13 + exit function + endif + endif + 'Trying to set text on combo box + try + oThisComboBox.setText sThisText + catch + 'Throw error 1 and quit on serious problem + qaErrorLog "Error 1: Set text in combo box seems to cause a serious problem." + fSetComboBoxByText = 1 + exit function + endcatch + 'Verify (against input) if text was set correctly + sStringinUI = oThisComboBox.GetSelText + if sStringinUI = sThisText then + fSetComboBoxByText = 0 + printlog "Setting text in Combo box works" + else + qaErrorLog "Error 2: Set text in Combo box failed." + fSetComboBoxByText = 2 + endif + + if fSetComboBoxByText = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetCheckBox ( oThisCheckBox as OBJECT , bCheck as BOOLEAN ) as INTEGER + fSetCheckBox = 99 +'Function to (un)check a check box +'Input: +'+OBJECT oThisCheckBox (check box name in declaration) +'+BOOLEAN bCheck (check or uncheck the check box control) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to check the box +'+ 2 = Box was not checked +'+11 = Check box is not visible +'+12 = Check box is not enabled +'+99 = Unexpected error + + printlog "Checking check box" + 'Check if desired check box is visible + if NOT oThisCheckBox.IsVisible then + qaErrorLog "Error 11: Check box is not visible" + fSetCheckBox = 11 + exit function + endif + 'Check if desired check box is enabled + if NOT oThisCheckBox.IsEnabled then + qaErrorLog "Error 12: Check box is not enabled" + fSetCheckBox = 12 + exit function + endif + 'Try to check check box control + try + if bCheck then + oThisCheckBox.Check + else + oThisCheckBox.Uncheck + endif + catch + 'Throw error 1 and quit on serious problem + if bCheck then + qaErrorLog "Error 1: Checking check box control cause into a serious problem." + else + qaErrorLog "Error 1: Unchecking check box control cause into a serious problem." + endif + fSetCheckBox = 1 + exit function + endcatch + 'Verify (against input) if check box is checked + if oThisCheckBox.IsChecked = bCheck then + fSetCheckBox = 0 + printlog "Check check box seems to work" + else + qaErrorLog "Error 2: Check check box failed." + fSetCheckBox = 2 + endif + if fSetCheckBox = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function +' +'-------------------------------------------------------------------- +' +function fSetRadioButton ( oThisRadioButton as OBJECT ) as INTEGER + fSetRadioButton = 99 +'Function to check a radio button +'Input: +'+OBJECT oThisRadioButton (radio button name in declaration) +'Return (Error codes): +'+ 0 = Sucess +'+ 1 = Serious problem trying to check the radio button +'+ 2 = Radio button was not checked +'+11 = Radio button is not visible +'+12 := Radio button is not enabled +'+99 := Unexpected error + printlog "Checking radio button" + 'Check if desired radio button is visible + if NOT oThisRadioButton.IsVisible then + qaErrorLog "Error 11: Radio button is not visible" + fSetRadioButton = 11 + exit function + endif + 'Check if desired radio button is enabled + if NOT oThisRadioButton.IsEnabled then + qaErrorLog "Error 12: Radio button is not enabled" + fSetRadioButton = 12 + exit function + endif + 'Try to check Radio Button + try + oThisRadioButton.Check + catch + 'Throw error 1 and quit on serious problem + qaErrorLog "Error 1: Check radio button seems to cause a serious problem." + fSetRadioButton = 1 + exit function + endcatch + 'Verify if radio button is checked + if oThisRadioButton.IsChecked = TRUE then + fSetRadioButton = 0 + printlog "Check radio button seems to work" + else + qaErrorLog "Error 2: Check radio button failed." + fSetRadioButton = 2 + endif + if fSetRadioButton = 99 then + warnlog "Error 99: Something unexpected happened!!" + endif +end function + diff --git a/testautomation/global/tools/includes/optional/t_spreadsheet_tools1.inc b/testautomation/global/tools/includes/optional/t_spreadsheet_tools1.inc new file mode 100644 index 000000000000..51bc373efc2c --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_spreadsheet_tools1.inc @@ -0,0 +1,90 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_spreadsheet_tools1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:08 $ +'* +'* 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. +'* +'/*********************************************************************** +'* +'* owner : oliver.craemer@sun.com +'* +'* short description : Global tools for spreadsheet +'* +'************************************************************************ +'* +' #1 fGotoCell ' Set active cell in a spreadhseet to a defined cell adress +' +'* +'\*********************************************************************** + +function fGotoCell (sCelladdress as String) as integer +'/// The function sets the active cell in a spreadsheet to a defined cell address. +'/// Input: sCelladdress as String +'/// Output: <ul><li>0 = active cell has changed successfully</li> +'///+ <li>1 = active cell hasn't changed</li> + + Dim sActualPlace as string + + const CFN = "qa:qatesttool:global:tools:inc:t_spreadsheet_tools1.inc:fGotoCell: " + + 'function will return 1 if something goes wrong + fGotoCell = 1 + Kontext "RechenleisteCalc" + '/// If the spreadsheet <i>formula toolbar</i> isn't available make them + '/// + available with View / Toolbars / Formula Bar + if NOT RechenleisteCalc.Exists(1) then + ViewToolbarsFormulaBar + end if + try + Kontext "RechenleisteCalc" + sActualPlace = AktiverZellbereich.GetSelText + if UCase(sActualPlace) = UCase(sCelladdress) then + fGotocell = 0 + exit function + else + sActualPlace = "" + '/// Type the cell address into the <i>name box</i> + AktiverZellbereich.SetText sCelladdress + '///+ and press RETURN + AktiverZellbereich.TypeKeys "<RETURN>" + sleep(1) + '/// If the <i>name box<i>' address has been changed to the expected + '///+ cell address the function was successfull. + sActualPlace = AktiverZellbereich.GetSelText + if UCase(sActualPlace) = UCase(sCelladdress) then + fGotocell = 0 + else + warnlog CFN & "The cell address has not been changed!" + end if + end if + catch + warnlog CFN & "Something unexpected happened! The cell address has not been changed!" + fGotocell = 1 + endcatch +end function + diff --git a/testautomation/global/tools/includes/optional/t_toolbar_calc.inc b/testautomation/global/tools/includes/optional/t_toolbar_calc.inc new file mode 100644 index 000000000000..604a46c559d4 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_toolbar_calc.inc @@ -0,0 +1,306 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_toolbar_calc.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : Toolbar tools - Calc +'* +'*************************************************************************************** +'* +' #0 fGetObjectCalc +'* +'\************************************************************************************* + +'******************************************************* +'* This function will get the location for image button +'* in Commands in Tools/Customize/Toolbars from Calc +'******************************************************* +function fGetObjectCalc(sToolbar as String , sObject as String) as Integer + + Select case sToolbar + case "3D-Settings" + Select case sObject + case "Extrusion On/Off" : fGetObjectCalc = 1 + '----------------- 2 + case "Tilt Down" : fGetObjectCalc = 3 + case "Tilt Up" : fGetObjectCalc = 4 + case "Tilt Left" : fGetObjectCalc = 5 + case "Tilt Right" : fGetObjectCalc = 6 + '----------------- 7 + case "Depth" : fGetObjectCalc = 8 + case "Direction" : fGetObjectCalc = 9 + case "Lighting" : fGetObjectCalc = 10 + case "Surfact" : fGetObjectCalc = 11 + case "3D Color" : fGetObjectCalc = 12 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Align" + Select case sObject + case "Left" : fGetObjectCalc = 1 + case "Centered" : fGetObjectCalc = 2 + case "Right" : fGetObjectCalc = 3 + case "Top" : fGetObjectCalc = 4 + case "Center" : fGetObjectCalc = 5 + case "Bottom" : fGetObjectCalc = 6 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Basic Shapes" + Select case sObject + end select + + case "Block Arrows" + Select case sObject + end select + + case "Callouts" + Select case sObject + end select + + case "Color" + Select case sObject + end select + + case "Controls" + Select case sObject + end select + + case "Drawing" + Select case sObject + case "Select" : fGetObjectCalc = 1 + '----------------- 2 + case "Line" : fGetObjectCalc = 3 + case "Rectangle" : fGetObjectCalc = 4 + case "Ellipse" : fGetObjectCalc = 5 + case "Polygon" : fGetObjectCalc = 6 + case "Curve" : fGetObjectCalc = 7 + case "Freeform Line" : fGetObjectCalc = 8 + case "Arc" : fGetObjectCalc = 9 + case "Ellipse Pie" : fGetObjectCalc = 10 + case "Circle Segment" : fGetObjectCalc = 11 + case "Text" : fGetObjectCalc = 12 + case "Vertical Text" : fGetObjectCalc = 13 + case "Text Animation" : fGetObjectCalc = 14 + case "Callouts" : fGetObjectCalc = 15 + case "Vertical Callouts" : fGetObjectCalc = 16 + '----------------- 17 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Drawing Object Properties" + Select case sObject + case "Display Grid" : fGetObjectCalc = 21 + case "Snap to Grid" : fGetObjectCalc = 22 + case "Guides When Moving" : fGetObjectCalc = 23 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Flowchart" + Select case sObject + end select + + case "Fontwork" + Select case sObject + end select + + case "Fontwork Shape" + Select case sObject + end select + + case "Form Design" + Select case sObject + case "Bring to Front" : fGetObjectCalc = 14 + case "Send to Back" : fGetObjectCalc = 15 + case "Group" : fGetObjectCalc = 17 + case "UnGroup" : fGetObjectCalc = 18 + case "Enter Group" : fGetObjectCalc = 19 + case "Exit Group" : fGetObjectCalc = 20 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Form Filter" + Select case sObject + end select + + case "Form Navigation" + Select case sObject + end select + + case "Form Object" + Select case sObject + end select + + case "Formatting" : + Select case sObject + case "Styles and Formatting" : fGetObjectCalc = 1 + case "Apply Style" : fGetObjectCalc = 2 + '---------------------- 3 + case "Font Name" : fGetObjectCalc = 4 + '---------------------- 5 + case "Font Size" : fGetObjectCalc = 6 + '---------------------- 7 + case "Bold" : fGetObjectCalc = 8 + case "Italic" : fGetObjectCalc = 9 + case "Underline" : fGetObjectCalc = 10 + case "Underline:Double" : fGetObjectCalc = 11 + '---------------------- 12 + case "Align Left" : fGetObjectCalc = 13 + case "Align Center Horizontally" : fGetObjectCalc = 14 + case "Align Right" : fGetObjectCalc = 15 + case "Justified" : fGetObjectCalc = 16 + case "Merge Cells" : fGetObjectCalc = 17 + '---------------------- 18 + case "Left-To-Right" : fGetObjectCalc = 19 + case "Right-To-Left" : fGetObjectCalc = 20 + '---------------------- 21 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Full Screen" + Select case sObject + case "Full Screen" : fGetObjectCalc = 1 + end select + + case "Graphic Filter" + Select case sObject + end select + + case "Insert" + Select case sObject + case "Chart" : fGetObjectCalc = 18 + case "Insert Object" : fGetObjectCalc = 19 + case "Controls" : fGetObjectCalc = 20 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Insert Cell" + Select case sObject + end select + + case "Insert Object" + Select case sObject + end select + + case "Media Playback" + Select case sObject + end select + + case "More Controls" + Select case sObject + end select + + case "Picture" + Select case sObject + end select + + case "Standard" + Select case sObject + case "Load URL" : fGetObjectCalc = 1 + case "New" : fGetObjectCalc = 2 + case "New Document From Template" : fGetObjectCalc = 3 + case "Open" : fGetObjectCalc = 4 + case "Save" : fGetObjectCalc = 5 + case "Save As" : fGetObjectCalc = 6 + case "Document as E-mail" : fGetObjectCalc = 7 + '----------------- 8 + case "Edit File" : fGetObjectCalc = 9 + '----------------- 10 + case "Export Directly as PDF" : fGetObjectCalc = 11 + case "Print File Directly" : fGetObjectCalc = 12 + case "Page Rreview" : fGetObjectCalc = 13 + '----------------- 14 + case "Spellcheck" : fGetObjectCalc = 15 + case "AutoSpellcheck" : fGetObjectCalc = 16 + '----------------- 17 + case "Cut" : fGetObjectCalc = 18 + case "Copy" : fGetObjectCalc = 19 + case "Paste" : fGetObjectCalc = 20 + case "Format Paintbrush" : fGetObjectCalc = 21 + '----------------- 22 + case "Can't Undo" : fGetObjectCalc = 23 + case "Can't Restore" : fGetObjectCalc = 24 + '----------------- 25 + case "Hyperlink" : fGetObjectCalc = 26 + case "Sort Ascending" : fGetObjectCalc = 27 + case "Sort Descending" : fGetObjectCalc = 28 + '----------------- 29 + case "Insert Chart" : fGetObjectCalc = 30 + case "Show Draw Functions" : fGetObjectCalc = 31 + '----------------- 32 + case "Find & Replace" : fGetObjectCalc = 33 + case "Navigator" : fGetObjectCalc = 34 + case "Gallery" : fGetObjectCalc = 35 + case "Data Sources" : fGetObjectCalc = 36 + case "Zoom" : fGetObjectCalc = 37 + '----------------- 38 + case "StarOffice Help" : fGetObjectCalc = 39 + case "What's This?" : fGetObjectCalc = 40 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Standard(Viewing Mode)" + Select case sObject + end select + + case "Stars and Banners" + Select case sObject + end select + + case "Symbol Shapes" + Select case sObject + end select + + case "Text Formatting" + Select case sObject + end select + + case "Tools" + Select case sObject + end select + + case "previewbar" + Select case sObject + end select + + end select + +end function diff --git a/testautomation/global/tools/includes/optional/t_toolbar_impress.inc b/testautomation/global/tools/includes/optional/t_toolbar_impress.inc new file mode 100644 index 000000000000..52ea929311df --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_toolbar_impress.inc @@ -0,0 +1,296 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_toolbar_impress.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : fredrik.haegg@sun.com +'* +'* short description : Toolbar tools - Impress +'* +'*************************************************************************************** +'* +' #0 fGetObjectImpress +'* +'\************************************************************************************* + +'******************************************************* +'* This function will get the location for image button +'* in Commands in Tools/Customize/Toolbars from Impress +'******************************************************* +function fGetObjectImpress(sToolbar as String , sObject as String) as Integer + + Select case sToolbar + case "3D-Objects" + Select case sObject + end select + + case "3D-Settings" + Select case sObject + case "Extrusion On/Off" : fGetObjectImpress = 1 + '----------------- 2 + case "Tilt Down" : fGetObjectImpress = 3 + case "Tilt Up" : fGetObjectImpress = 4 + case "Tilt Left" : fGetObjectImpress = 5 + case "Tilt Right" : fGetObjectImpress = 6 + '----------------- 7 + case "Depth" : fGetObjectImpress = 8 + case "Direction" : fGetObjectImpress = 9 + case "Lighting" : fGetObjectImpress = 10 + case "Surfact" : fGetObjectImpress = 11 + case "3D Color" : fGetObjectImpress = 12 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectImpress = 0 + end select + + case "Align" + Select case sObject + case "Left" : fGetObjectImpress = 1 + case "Centered" : fGetObjectImpress = 2 + case "Right" : fGetObjectImpress = 3 + '----------------- 4 + case "Top" : fGetObjectImpress = 5 + case "Center" : fGetObjectImpress = 6 + case "Bottom" : fGetObjectImpress = 7 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectImpress = 0 + end select + + case "Arrows" + Select case sObject + end select + + case "Basic Shapes" + Select case sObject + end select + + case "Block Arrows" + Select case sObject + end select + + case "Bullets and Numbering" + Select case sObject + end select + + case "Callouts" + Select case sObject + end select + + case "Color" + Select case sObject + end select + + case "Connectors" + Select case sObject + end select + + case "Controls" + Select case sObject + end select + + case "Drawing" + Select case sObject + case "Select" : fGetObjectImpress = 1 + '----------------- 2 + case "Line" : fGetObjectImpress = 3 + case "Rectangle" : fGetObjectImpress = 4 + case "Ellipse" : fGetObjectImpress = 5 + case "Text" : fGetObjectImpress = 6 + case "Vertical Text" : fGetObjectImpress = 7 + '----------------- 8 + case "Curve" : fGetObjectImpress = 9 + case "Connector" : fGetObjectImpress = 10 + case "3D Objects" : fGetObjectImpress = 11 + case "Basic Shapes" : fGetObjectImpress = 12 + case "Symbol Shapes" : fGetObjectImpress = 13 + case "Block Arrows" : fGetObjectImpress = 14 + case "Flowcharts" : fGetObjectImpress = 15 + case "Callouts" : fGetObjectImpress = 16 + case "Stars" : fGetObjectImpress = 17 + '----------------- 18 + case "Points" : fGetObjectImpress = 19 + case "Glue Points" : fGetObjectImpress = 20 + case "To Curve" : fGetObjectImpress = 21 + case "To Polygon" : fGetObjectImpress = 22 + case "To 3D" : fGetObjectImpress = 23 + case "To 3D Rotation Objet" : fGetObjectImpress = 24 + '----------------- 25 + case "Fontwork Gallery" : fGetObjectImpress = 26 + case "From File" : fGetObjectImpress = 27 + case "Gallerty" : fGetObjectImpress = 28 + '----------------- 29 + case "Rotate" : fGetObjectImpress = 30 + case "Rotation and Size" : fGetObjectImpress = 31 + case "Flip" : fGetObjectImpress = 32 + case "Alignment" : fGetObjectImpress = 33 + case "Arrange" : fGetObjectImpress = 34 + '----------------- 35 + case "Insert" : fGetObjectImpress = 36 + case "Controls" : fGetObjectImpress = 37 + '----------------- 38 + case "Extrusion On/Off" : fGetObjectImpress = 39 + case "Custom Animation" : fGetObjectImpress = 40 + case "Interaction" : fGetObjectImpress = 41 + case "Animated Image" : fGetObjectImpress = 42 + case "3D Effects" : fGetObjectImpress = 43 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectImpress = 0 + end select + + case "Edit Points" + Select case sObject + end select + + case "Flowchart" + Select case sObject + end select + + case "Fontwork" + Select case sObject + end select + + case "Fontwork Shape" + Select case sObject + end select + + case "Form Design" + Select case sObject + end select + + case "Form Filter" + Select case sObject + end select + + case "Form Navigation" + Select case sObject + end select + + case "Full Screen" + Select case sObject + end select + + case "Gluepoints" + Select case sObject + end select + + case "Graphic Filter" + Select case sObject + end select + + case "Insert" + Select case sObject + case "Floating Frame" : fGetObjectImpress = 6 + case "Plug-in" : fGetObjectImpress = 8 + case "Applet" : fGetObjectImpress = 9 + case "File" : fGetObjectImpress = 11 + case "Sound" : fGetObjectImpress = 14 + case "Video" : fGetObjectImpress = 15 + end select + + case "OLE-Object" + Select case sObject + case "Wrap Left" : fGetObjectImpress = 11 + case "Wrap Right" : fGetObjectImpress = 12 + case "Optimal Page Wrap" : fGetObjectImpress = 16 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectImpress = 0 + end select + + case "Standard" + Select case sObject + case "Load URL" : fGetObjectImpress = 1 + case "New" : fGetObjectImpress = 2 + case "New Document From Template" : fGetObjectImpress = 3 + case "Open" : fGetObjectImpress = 4 + case "Save" : fGetObjectImpress = 5 + case "Save As" : fGetObjectImpress = 6 + case "Document as E-mail" : fGetObjectImpress = 7 + '----------------- 8 + case "Edit File" : fGetObjectImpress = 9 + '----------------- 10 + case "Export Directly as PDF" : fGetObjectImpress = 11 + case "Print File Directly" : fGetObjectImpress = 12 + '----------------- 13 + case "Spellcheck" : fGetObjectImpress = 14 + case "AutoSpellcheck" : fGetObjectImpress = 15 + '----------------- 16 + case "Cut" : fGetObjectImpress = 17 + case "Copy" : fGetObjectImpress = 18 + case "Paste" : fGetObjectImpress = 19 + case "Format Paintbrush" : fGetObjectImpress = 20 + '----------------- 21 + case "Can't Undo" : fGetObjectImpress = 22 + case "Can't Restore" : fGetObjectImpress = 23 + '----------------- 24 + case "Chart" : fGetObjectImpress = 25 + case "Spreadsheet" : fGetObjectImpress = 26 + case "Hyperlink" : fGetObjectImpress = 27 + '----------------- 28 + case "Display Grid" : fGetObjectImpress = 29 + '----------------- 30 + case "Navigator" : fGetObjectImpress = 31 + case "Zoom" : fGetObjectImpress = 32 + '----------------- 33 + case "StarOffice Help" : fGetObjectImpress = 34 + case "What's This?" : fGetObjectImpress = 35 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectImpress = 0 + end select + + case "Table" + Select case sObject + case "Table" : fGetObjectImpress = 22 + case "Columns" : fGetObjectImpress = 23 + case "Rows" : fGetObjectImpress = 24 + end select + + case "Text Object" + Select case sObject + case "Line Spacing 1" : fGetObjectImpress = 16 + case "Line Spacing 1.5" : fGetObjectImpress = 17 + case "Line Spacing 2" : fGetObjectImpress = 18 + case "Font Color" : fGetObjectImpress = 20 + case "Left-To-Right" : fGetObjectImpress = 22 + case "Right-To-Left" : fGetObjectImpress = 23 + end select + + case "XML Form Design" + Select case sObject + case "Bring to Front" : fGetObjectImpress = 14 + case "Send to Back" : fGetObjectImpress = 15 + case "Group" : fGetObjectImpress = 17 + case "UnGroup" : fGetObjectImpress = 18 + case "Enter Group" : fGetObjectImpress = 19 + case "Exit Group" : fGetObjectImpress = 20 + end select + + end select + +end function diff --git a/testautomation/global/tools/includes/optional/t_toolbar_tools1.inc b/testautomation/global/tools/includes/optional/t_toolbar_tools1.inc new file mode 100644 index 000000000000..124e3492762b --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_toolbar_tools1.inc @@ -0,0 +1,407 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_toolbar_tools1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : Toolbar tools 1 +'* +'*************************************************************************************** +'* +' #1 fActiveObjectInToolbar ' active/inactive image button in toolbar +'* +'\************************************************************************************* + +'****************************************************************** +'* Created by hercule.li@sun.com +'* This function will active or inactive image button in toolbar +'* sToolbar : Toolbar name +'* sObject : image button name +'* bActive : Active or Inactive image button +'* TRUE --> Active +'* FALSE --> Inactive +'* Will return the original status of the image button +'***************************************************************** +function fActiveObjectInToolbar(sToolbar as String , sObject as String , bActive as Boolean) as Boolean + + Dim iObject as Integer + Dim sToolbarName as String + Dim sFlag as Boolean + + sToolbarName = fGetToolbarName(sToolbar) + iObject = fGetObject(sToolbar , sObject) + + ToolsCustomize + sleep 3 + Kontext + Active.SetPage TabCustomizeToolbars + Kontext "TabCustomizeToolbars" + Menu.Select sToolbarName + Sleep 1 + ToolbarContents.Typekeys "<Home>" + Sleep 1 + if iObject-1 > 0 then + ToolbarContents.Typekeys "<Down>" , iObject-1 + endif + sFlag = ToolbarContents.IsChecked + if bActive = TRUE then + if sFlag = FALSE then ToolbarContents.Check + else + ToolbarContents.UnCheck + endif + TabCustomizeToolbars.OK + fActiveObjectInToolbar = sFlag + +end function + + +'****************************************** +'* This function will Get toolbar's name ** +'* Return Toolbar's name in StarOffice ** +'****************************************** +function fGetToolbarName(sToolbar) as String + + Select case sToolbar + case "3D-Settings" : + Select case iSprache + case 01 : fGetToolbarName = "3D-Settings" + case 33 : fGetToolbarName = "3D-Settings" + case 34 : fGetToolbarName = "3D-Settings" + case 39 : fGetToolbarName = "3D-Settings" + case 46 : fGetToolbarName = "3D-Settings" + case 49 : fGetToolbarName = "3D-Einstellungen" + case 55 : fGetToolbarName = "3D-Settings" + case 81 : fGetToolbarName = "3D-Settings" + case 82 : fGetToolbarName = "3D-Settings" + case 86 : fGetToolbarName = "3D-Settings" + case 88 : fGetToolbarName = "3D-Settings" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "3D-Settings" + end select + + case "Align" : + Select case iSprache + case 01 : fGetToolbarName = "Align" + case 33 : fGetToolbarName = "Align" + case 34 : fGetToolbarName = "Align" + case 39 : fGetToolbarName = "Align" + case 46 : fGetToolbarName = "Align" + case 49 : fGetToolbarName = "Ausrichten" + case 55 : fGetToolbarName = "Align" + case 81 : fGetToolbarName = "Align" + case 82 : fGetToolbarName = "Align" + case 86 : fGetToolbarName = "Align" + case 88 : fGetToolbarName = "Align" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Align" + end select + + case "Basic Shapes" : + Select case iSprache + case 01 : fGetToolbarName = "Basic Shapes" + case 33 : fGetToolbarName = "Basic Shapes" + case 34 : fGetToolbarName = "Basic Shapes" + case 39 : fGetToolbarName = "Basic Shapes" + case 46 : fGetToolbarName = "Basic Shapes" + case 49 : fGetToolbarName = "Standardformen" + case 55 : fGetToolbarName = "Basic Shapes" + case 81 : fGetToolbarName = "Basic Shapes" + case 82 : fGetToolbarName = "Basic Shapes" + case 86 : fGetToolbarName = "Basic Shapes" + case 88 : fGetToolbarName = "Basic Shapes" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Basic Shapes" + end select + + case "Block Arrows" : + Select case iSprache + case 01 : fGetToolbarName = "Block Arrows" + case 33 : fGetToolbarName = "Block Arrows" + case 34 : fGetToolbarName = "Block Arrows" + case 39 : fGetToolbarName = "Block Arrows" + case 46 : fGetToolbarName = "Block Arrows" + case 49 : fGetToolbarName = "Blockpfeile" + case 55 : fGetToolbarName = "Block Arrows" + case 81 : fGetToolbarName = "Block Arrows" + case 82 : fGetToolbarName = "Block Arrows" + case 86 : fGetToolbarName = "Block Arrows" + case 88 : fGetToolbarName = "Block Arrows" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Block Arrows" + end select + + case "Bullets and Numbering" : + Select case iSprache + case 01 : fGetToolbarName = "Bullets and Numbering" + case 33 : fGetToolbarName = "Bullets and Numbering" + case 34 : fGetToolbarName = "Bullets and Numbering" + case 39 : fGetToolbarName = "Bullets and Numbering" + case 46 : fGetToolbarName = "Bullets and Numbering" + case 49 : fGetToolbarName = "Nummerierung und Aufzählungszeichen" + case 55 : fGetToolbarName = "Bullets and Numbering" + case 81 : fGetToolbarName = "Bullets and Numbering" + case 82 : fGetToolbarName = "Bullets and Numbering" + case 86 : fGetToolbarName = "Bullets and Numbering" + case 88 : fGetToolbarName = "Bullets and Numbering" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Bullets and Numbering" + end select + + case "Database Form Design" : + Select case iSprache + case 01 : fGetToolbarName = "Database Form Design" + case 33 : fGetToolbarName = "Database Form Design" + case 34 : fGetToolbarName = "Database Form Design" + case 39 : fGetToolbarName = "Database Form Design" + case 46 : fGetToolbarName = "Database Form Design" + case 49 : fGetToolbarName = "Datenbank Formularentwurf" + case 55 : fGetToolbarName = "Database Form Design" + case 81 : fGetToolbarName = "Database Form Design" + case 82 : fGetToolbarName = "Database Form Design" + case 86 : fGetToolbarName = "Database Form Design" + case 88 : fGetToolbarName = "Database Form Design" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Database Form Design" + end select + + case "Drawing" : + Select case iSprache + case 01 : fGetToolbarName = "Drawing" + case 33 : fGetToolbarName = "Drawing" + case 34 : fGetToolbarName = "Drawing" + case 39 : fGetToolbarName = "Drawing" + case 46 : fGetToolbarName = "Drawing" + case 49 : fGetToolbarName = "Zeichnen" + case 55 : fGetToolbarName = "Drawing" + case 81 : fGetToolbarName = "Drawing" + case 82 : fGetToolbarName = "Drawing" + case 86 : fGetToolbarName = "Drawing" + case 88 : fGetToolbarName = "Drawing" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Drawing" + end select + + case "Drawing Object Properties" : + Select case iSprache + case 01 : fGetToolbarName = "Drawing Object Properties" + case 33 : fGetToolbarName = "Drawing Object Properties" + case 34 : fGetToolbarName = "Drawing Object Properties" + case 39 : fGetToolbarName = "Drawing Object Properties" + case 46 : fGetToolbarName = "Drawing Object Properties" + case 49 : fGetToolbarName = "Zeichnungsobjekt-Eigenschaften" + case 55 : fGetToolbarName = "Drawing Object Properties" + case 81 : fGetToolbarName = "Drawing Object Properties" + case 82 : fGetToolbarName = "Drawing Object Properties" + case 86 : fGetToolbarName = "Drawing Object Properties" + case 88 : fGetToolbarName = "Drawing Object Properties" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Drawing Object Properties" + end select + + case "Form Design" : + Select case iSprache + case 01 : fGetToolbarName = "Form Design" + case 33 : fGetToolbarName = "Form Design" + case 34 : fGetToolbarName = "Form Design" + case 39 : fGetToolbarName = "Form Design" + case 46 : fGetToolbarName = "Form Design" + case 49 : fGetToolbarName = "Formular Entwurf" + case 55 : fGetToolbarName = "Form Design" + case 81 : fGetToolbarName = "Form Design" + case 82 : fGetToolbarName = "Form Design" + case 86 : fGetToolbarName = "Form Design" + case 88 : fGetToolbarName = "Form Design" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Form Design" + end select + + case "Formatting" : + Select case iSprache + case 01 : fGetToolbarName = "Formatting" + case 33 : fGetToolbarName = "Formatting" + case 34 : fGetToolbarName = "Formatting" + case 39 : fGetToolbarName = "Formatting" + case 46 : fGetToolbarName = "Formatting" + case 49 : fGetToolbarName = "Format" + case 55 : fGetToolbarName = "Formatting" + case 81 : fGetToolbarName = "Formatting" + case 82 : fGetToolbarName = "Formatting" + case 86 : fGetToolbarName = "Formatting" + case 88 : fGetToolbarName = "Formatting" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Formatting" + end select + + case "Frame" : + Select case iSprache + case 01 : fGetToolbarName = "Frame" + case 33 : fGetToolbarName = "Frame" + case 34 : fGetToolbarName = "Frame" + case 39 : fGetToolbarName = "Frame" + case 46 : fGetToolbarName = "Frame" + case 49 : fGetToolbarName = "Rahmen" + case 55 : fGetToolbarName = "Frame" + case 81 : fGetToolbarName = "Frame" + case 82 : fGetToolbarName = "Frame" + case 86 : fGetToolbarName = "Frame" + case 88 : fGetToolbarName = "Frame" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Frame" + end select + + case "Insert" : + Select case iSprache + case 01 : fGetToolbarName = "Insert" + case 33 : fGetToolbarName = "Insert" + case 34 : fGetToolbarName = "Insert" + case 39 : fGetToolbarName = "Insert" + case 46 : fGetToolbarName = "Insert" + case 49 : fGetToolbarName = "Einfügen" + case 55 : fGetToolbarName = "Insert" + case 81 : fGetToolbarName = "Insert" + case 82 : fGetToolbarName = "Insert" + case 86 : fGetToolbarName = "Insert" + case 88 : fGetToolbarName = "Insert" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Insert" + end select + + case "OLE-Object" : + Select case iSprache + case 01 : fGetToolbarName = "OLE-Object" + case 33 : fGetToolbarName = "OLE-Object" + case 34 : fGetToolbarName = "OLE-Object" + case 39 : fGetToolbarName = "OLE-Object" + case 46 : fGetToolbarName = "OLE-Object" + case 49 : fGetToolbarName = "OLE Objekt" + case 55 : fGetToolbarName = "OLE-Object" + case 81 : fGetToolbarName = "OLE-Object" + case 82 : fGetToolbarName = "OLE-Object" + case 86 : fGetToolbarName = "OLE-Object" + case 88 : fGetToolbarName = "OLE-Object" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "OLE-Object" + end select + + case "Standard" : + Select case iSprache + case 01 : fGetToolbarName = "Standard" + case 33 : fGetToolbarName = "Standard" + case 34 : fGetToolbarName = "Standard" + case 39 : fGetToolbarName = "Standard" + case 46 : fGetToolbarName = "Standard" + case 49 : fGetToolbarName = "Standard" + case 55 : fGetToolbarName = "Standard" + case 81 : fGetToolbarName = "Standard" + case 82 : fGetToolbarName = "Standard" + case 86 : fGetToolbarName = "Standard" + case 88 : fGetToolbarName = "Standard" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Standard" + end select + + case "Table" : + Select case iSprache + case 01 : fGetToolbarName = "Table" + case 33 : fGetToolbarName = "Table" + case 34 : fGetToolbarName = "Table" + case 39 : fGetToolbarName = "Table" + case 46 : fGetToolbarName = "Table" + case 49 : fGetToolbarName = "Tabelle" + case 55 : fGetToolbarName = "Table" + case 81 : fGetToolbarName = "Table" + case 82 : fGetToolbarName = "Table" + case 86 : fGetToolbarName = "Table" + case 88 : fGetToolbarName = "Table" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Table" + end select + + case "Text Object" : + Select case iSprache + case 01 : fGetToolbarName = "Text Object" + case 33 : fGetToolbarName = "Text Object" + case 34 : fGetToolbarName = "Text Object" + case 39 : fGetToolbarName = "Text Object" + case 46 : fGetToolbarName = "Text Object" + case 49 : fGetToolbarName = "Textobjekt" + case 55 : fGetToolbarName = "Text Object" + case 81 : fGetToolbarName = "Text Object" + case 82 : fGetToolbarName = "Text Object" + case 86 : fGetToolbarName = "Text Object" + case 88 : fGetToolbarName = "Text Object" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "Text Object" + end select + + case "XML Form Design" : + Select case iSprache + case 01 : fGetToolbarName = "XML Form Design" + case 33 : fGetToolbarName = "XML Form Design" + case 34 : fGetToolbarName = "XML Form Design" + case 39 : fGetToolbarName = "XML Form Design" + case 46 : fGetToolbarName = "XML Form Design" + case 49 : fGetToolbarName = "XML Formularentwurf" + case 55 : fGetToolbarName = "XML Form Design" + case 81 : fGetToolbarName = "XML Form Design" + case 82 : fGetToolbarName = "XML Form Design" + case 86 : fGetToolbarName = "XML Form Design" + case 88 : fGetToolbarName = "XML Form Design" + case else : QAErrorLog "The test does not support the language " + iSprache + fGetToolbarName = "XML Form Design" + end select + + end select + +end function + +'******************************************************* +'* This function will get the location for image button +'* in Commands in Tools/Customize/Toolbars +'******************************************************* +function fGetObject(sToolbar as String , sObject as String) as Integer + + select case gApplication + + case "WRITER" : fGetObject = fGetObjectWriter(sToolbar , sObject) + case "HTMLDOKUMENT" : fGetObject = fGetObjectWriter(sToolbar , sObject) + case "MASTERDOC" : fGetObject = fGetObjectWriter(sToolbar , sObject) + + case "CALC" : fGetObject = fGetObjectCalc(sToolbar , sObject) + + case "IMPRESS" : fGetObject = fGetObjectImpress(sToolbar , sObject) + + end select + +end function + + diff --git a/testautomation/global/tools/includes/optional/t_toolbar_writer.inc b/testautomation/global/tools/includes/optional/t_toolbar_writer.inc new file mode 100644 index 000000000000..71557de7f9b4 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_toolbar_writer.inc @@ -0,0 +1,772 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_toolbar_writer.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : helge.delfs@sun.com +'* +'* short description : Toolbar tools - Writer +'* +'*************************************************************************************** +'* +' #0 fGetObjectWriter +' #0 fGetObjectCalc +'* +'\************************************************************************************* + +'******************************************************* +'* This function will get the location for image button +'* in Commands in Tools/Customize/Toolbars from Writer +'******************************************************* +function fGetObjectWriter(sToolbar as String , sObject as String) as Integer + + Select case sToolbar + case "3D-Settings" + Select case sObject + case "Extrusion On/Off" : fGetObjectWriter = 1 + '----------------- 2 + case "Tilt Down" : fGetObjectWriter = 3 + case "Tilt Up" : fGetObjectWriter = 4 + case "Tilt Left" : fGetObjectWriter = 5 + case "Tilt Right" : fGetObjectWriter = 6 + '----------------- 7 + case "Depth" : fGetObjectWriter = 8 + case "Direction" : fGetObjectWriter = 9 + case "Lighting" : fGetObjectWriter = 10 + case "Surfact" : fGetObjectWriter = 11 + case "3D Color" : fGetObjectWriter = 12 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Align" + Select case sObject + case "Left" : fGetObjectWriter = 1 + case "Centered" : fGetObjectWriter = 2 + case "Right" : fGetObjectWriter = 3 + case "Top" : fGetObjectWriter = 4 + case "Center" : fGetObjectWriter = 5 + case "Bottom" : fGetObjectWriter = 6 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Basic Shapes" + Select case sObject + case "Rectangle" : fGetObjectWriter = 1 + case "Rectangle,Rounded" : fGetObjectWriter = 2 + case "Square" : fGetObjectWriter = 3 + case "Square,Rounded" : fGetObjectWriter = 4 + case "Circle" : fGetObjectWriter = 5 + case "Ellipse" : fGetObjectWriter = 6 + '----------------- 7 + case "Circle Pie" : fGetObjectWriter = 8 + case "Isosceles Triangle" : fGetObjectWriter = 9 + case "Right Triangle" : fGetObjectWriter = 10 + case "Trapezoid" : fGetObjectWriter = 11 + case "Diamond" : fGetObjectWriter = 12 + case "Parallelogram" : fGetObjectWriter = 13 + '----------------- 14 + case "Regular Pentagon" : fGetObjectWriter = 15 + case "Hexagon" : fGetObjectWriter = 16 + case "Octagon" : fGetObjectWriter = 17 + case "Cross" : fGetObjectWriter = 18 + case "Ring" : fGetObjectWriter = 19 + case "Block Arc" : fGetObjectWriter = 20 + '----------------- 21 + case "Cylinder" : fGetObjectWriter = 22 + case "Cube" : fGetObjectWriter = 23 + case "Rolded Corner" : fGetObjectWriter = 24 + case "Rrame" : fGetObjectWriter = 25 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Block Arrows" + Select case sObject + end select + + case "Bullets and Numbering" + Select case sObject + end select + + case "Callouts" + Select case sObject + case "Rectanguar Callout" : fGetObjectWriter = 1 + case "Rounded Rectanguar Callout" : fGetObjectWriter = 2 + case "Round Callout" : fGetObjectWriter = 3 + case "Cloud" : fGetObjectWriter = 4 + case "Line Callout 1" : fGetObjectWriter = 5 + case "Line Callout 2" : fGetObjectWriter = 6 + case "Line Callout 3" : fGetObjectWriter = 7 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Color" + Select case sObject + case "Red" : fGetObjectWriter = 1 + '----------------- 2 + case "Green" : fGetObjectWriter = 3 + '----------------- 4 + case "Blue" : fGetObjectWriter = 5 + '----------------- 6 + case "Brightness" : fGetObjectWriter = 7 + '----------------- 8 + case "Contrast" : fGetObjectWriter = 9 + '----------------- 10 + case "Gamma" : fGetObjectWriter = 11 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Controls" + Select case sObject + end select + + case "Database Controls" + Select case sObject + end select + + case "Database Form Design" + Select case sObject + case "Change Anchor" : fGetObjectWriter = 12 + case "Bring To Front" : fGetObjectWriter = 13 + case "Send To Back" : fGetObjectWriter = 14 + case "Group" : fGetObjectWriter = 15 + case "UnGroup" : fGetObjectWriter = 18 + case "Enter Group" : fGetObjectWriter = 19 + case "Exit Group" : fGetObjectWriter = 20 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Drawing" + Select case sObject + case "Select" : fGetObjectWriter = 1 + '----------------- 2 + case "Line" : fGetObjectWriter = 3 + case "Rectangle" : fGetObjectWriter = 4 + case "Ellipse" : fGetObjectWriter = 5 + case "Polygon" : fGetObjectWriter = 6 + case "Curve" : fGetObjectWriter = 7 + case "Freeform Line" : fGetObjectWriter = 8 + case "Arc" : fGetObjectWriter = 9 + case "Ellipse Pie" : fGetObjectWriter = 10 + case "Circle Segment" : fGetObjectWriter = 11 + case "Text" : fGetObjectWriter = 12 + case "Vertical Text" : fGetObjectWriter = 13 + case "Text Animation" : fGetObjectWriter = 14 + case "Callouts" : fGetObjectWriter = 13 + case "Vertical Callouts" : fGetObjectWriter = 14 + '----------------- 15 + case "Basic Shapes" : fGetObjectWriter = 16 + case "Symbol Shapes" : fGetObjectWriter = 17 + case "Block Arrows" : fGetObjectWriter = 18 + case "Flowcharts" : fGetObjectWriter = 19 + case "Callouts2" : fGetObjectWriter = 20 + case "Stars" : fGetObjectWriter = 21 + '----------------- 22 + case "Points" : fGetObjectWriter = 23 + '----------------- 24 + case "Fontwork Gallery" : fGetObjectWriter = 25 + case "Insert Graphics" : fGetObjectWriter = 26 + '----------------- 27 + case "Extrusion On/Off" : fGetObjectWriter = 28 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Drawing Object Properties" + Select case sObject + case "Line" : fGetObjectWriter = 1 + case "Arrow Style" : fGetObjectWriter = 2 + '----------------- 3 + case "Line Style" : fGetObjectWriter = 4 + '----------------- 5 + case "Line Width" : fGetObjectWriter = 6 + '----------------- 7 + case "Line Color" : fGetObjectWriter = 8 + '----------------- 9 + case "Area" : fGetObjectWriter = 10 + '----------------- 11 + case "Area Style/Filling" : fGetObjectWriter = 12 + '----------------- 13 + case "Object rotation mode" : fGetObjectWriter = 14 + case "Display Grid" : fGetObjectWriter = 15 + case "Snap to Grid" : fGetObjectWriter = 16 + case "Guides When Moving" : fGetObjectWriter = 17 + '----------------- 18 + case "Wrap Off" : fGetObjectWriter = 19 + case "Page Wrap" : fGetObjectWriter = 20 + case "Optimal Page Wrap" : fGetObjectWriter = 21 + case "Wrap Left" : fGetObjectWriter = 22 + case "Wrap Right" : fGetObjectWriter = 23 + case "Wrap Through" : fGetObjectWriter = 24 + case "Contour" : fGetObjectWriter = 25 + '----------------- 26 + case "To Foreground" : fGetObjectWriter = 27 + case "To Background" : fGetObjectWriter = 28 + case "Bring to Front" : fGetObjectWriter = 29 + case "Send to Back" : fGetObjectWriter = 30 + case "Alignment" : fGetObjectWriter = 31 + '----------------- 32 + case "Change Anchor" : fGetObjectWriter = 33 + '----------------- 34 + case "Ungroup" : fGetObjectWriter = 35 + case "Group" : fGetObjectWriter = 36 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Edit Points" + Select case sObject + end select + + case "Flowchart" + Select case sObject + end select + + case "Fontwork" + Select case sObject + case "Fontwork Gallery" : fGetObjectWriter = 1 + '----------------- 2 + case "Fontwork Shape" : fGetObjectWriter = 3 + case "Fontwork Same Letter Heights" : fGetObjectWriter = 4 + '----------------- 5 + case "Fontwork Alignment" : fGetObjectWriter = 6 + case "Fontwork Character Spacing" : fGetObjectWriter = 7 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Fontwork Shape" + Select case sObject + end select + + case "Form Design" + Select case sObject + case "Bring to Front" : fGetObjectWriter = 14 + case "Send to Back" : fGetObjectWriter = 15 + case "Group" : fGetObjectWriter = 17 + case "UnGroup" : fGetObjectWriter = 18 + case "Enter Group" : fGetObjectWriter = 19 + case "Exit Group" : fGetObjectWriter = 20 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Form Filter" + Select case sObject + case "Apply Form-Based Filter" : fGetObjectWriter = 1 + case "Filter Navigation" : fGetObjectWriter = 2 + '----------------- 3 + case "Close" : fGetObjectWriter = 4 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Form Navigation" + Select case sObject + end select + + case "Form Object" + Select case sObject + end select + + case "Formatting" + Select case sObject + case "Sytles and Formatting" : fGetObjectWriter = 1 + '----------------- 2 + case "Apply Style" : fGetObjectWriter = 3 + '----------------- 4 + case "Font Name" : fGetObjectWriter = 5 + '----------------- 6 + case "Font Size" : fGetObjectWriter = 7 + '----------------- 8 + case "Bold" : fGetObjectWriter = 9 + case "Italic" : fGetObjectWriter = 10 + case "Underline" : fGetObjectWriter = 11 + case "Superscript" : fGetObjectWriter = 12 + case "Subscript" : fGetObjectWriter = 13 + '----------------- 14 + case "Align Left" : fGetObjectWriter = 15 + case "Centered" : fGetObjectWriter = 16 + case "Align Right" : fGetObjectWriter = 17 + case "Justfied" : fGetObjectWriter = 18 + '----------------- 19 + case "Left-To-Right" : fGetObjectWriter = 20 + case "Right-To-Left" : fGetObjectWriter = 21 + '----------------- 22 + case "Line Spacing 1" : fGetObjectWriter = 23 + case "Line Spacing 1.5" : fGetObjectWriter = 24 + case "Line Spacing 2" : fGetObjectWriter = 25 + '----------------- 26 + case "Numbering Of/Off" : fGetObjectWriter = 27 + case "Bullets Of/Off" : fGetObjectWriter = 28 + case "Decrease Indent" : fGetObjectWriter = 29 + case "Increase Indent" : fGetObjectWriter = 30 + case "Increase Font" : fGetObjectWriter = 31 + case "Reduce Font" : fGetObjectWriter = 32 + '----------------- 33 + case "Font Color" : fGetObjectWriter = 34 + case "Highlighting" : fGetObjectWriter = 35 + case "Background Color" : fGetObjectWriter = 36 + '----------------- 37 + case "Select All" : fGetObjectWriter = 38 + case "Character" : fGetObjectWriter = 39 + case "Paragraph" : fGetObjectWriter = 40 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Frame" + Select case sObject + case "Optimal Page Wrap" : fGetObjectWriter = 5 + case "Wrap Left" : fGetObjectWriter = 6 + case "Wrap Right" : fGetObjectWriter = 7 + case "Wrap Through" : fGetObjectWriter = 8 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Full Screen" + Select case sObject + end select + + case "Graphic Filter" + Select case sObject + end select + + case "Insert" + Select case sObject + case "Chart" : fGetObjectWriter = 18 + case "Insert Object" : fGetObjectWriter = 19 + case "Controls" : fGetObjectWriter = 20 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Insert Object" + Select case sObject + end select + + case "Media Playback" + Select case sObject + end select + + case "More Controls" + Select case sObject + end select + + case "More Database Controls" + Select case sObject + end select + + case "More XML Form Controls" + Select case sObject + end select + + case "OLE-Object" + Select case sObject + case "Wrap Left" : fGetObjectWriter = 11 + case "Wrap Right" : fGetObjectWriter = 12 + case "Optimal Page Wrap" : fGetObjectWriter = 16 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Optimize" + Select case sObject + end select + + case "Page Preview" + Select case sObject + end select + + case "Picture" + Select case sObject + end select + + case "Standard" + Select case sObject + case "Load URL" : fGetObjectWriter = 1 + case "New" : fGetObjectWriter = 2 + case "New Document From Template" : fGetObjectWriter = 3 + case "Open" : fGetObjectWriter = 4 + case "Save" : fGetObjectWriter = 5 + case "Save As" : fGetObjectWriter = 6 + case "Document as E-mail" : fGetObjectWriter = 7 + '----------------- 8 + case "Edit File" : fGetObjectWriter = 9 + '----------------- 10 + case "Export Directly as PDF" : fGetObjectWriter = 11 + case "Print File Directly" : fGetObjectWriter = 12 + case "Page Rreview" : fGetObjectWriter = 13 + '----------------- 14 + case "Spellcheck" : fGetObjectWriter = 15 + case "AutoSpellcheck" : fGetObjectWriter = 16 + '----------------- 17 + case "Cut" : fGetObjectWriter = 18 + case "Copy" : fGetObjectWriter = 19 + case "Paste" : fGetObjectWriter = 20 + case "Format Paintbrush" : fGetObjectWriter = 21 + '----------------- 22 + case "Can't Undo" : fGetObjectWriter = 23 + case "Can't Restore" : fGetObjectWriter = 24 + '----------------- 25 + case "Hyperlink" : fGetObjectWriter = 26 + case "Table" : fGetObjectWriter = 27 + case "Show Draw Functions" : fGetObjectWriter = 28 + '----------------- 29 + case "Find & Replace" : fGetObjectWriter = 30 + case "Navigator" : fGetObjectWriter = 31 + case "Gallery" : fGetObjectWriter = 32 + case "Data Sources" : fGetObjectWriter = 33 + case "Nonprinting Characters" : fGetObjectWriter = 34 + case "Zoom" : fGetObjectWriter = 35 + '----------------- 36 + case "StarOffice Help" : fGetObjectWriter = 37 + case "What's This?" : fGetObjectWriter = 38 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectWriter = 0 + end select + + case "Standard(Viewing MOde)" + Select case sObject + end select + + case "Stars and Banners" + Select case sObject + end select + + case "Symbol Shapes" + Select case sObject + end select + + case "Table" + Select case sObject + case "Table" : fGetObjectWriter = 22 + case "Columns" : fGetObjectWriter = 23 + case "Rows" : fGetObjectWriter = 24 + end select + + case "Text Object" + Select case sObject + case "Line Spacing 1" : fGetObjectWriter = 16 + case "Line Spacing 1.5" : fGetObjectWriter = 17 + case "Line Spacing 2" : fGetObjectWriter = 18 + case "Font Color" : fGetObjectWriter = 20 + case "Left-To-Right" : fGetObjectWriter = 22 + case "Right-To-Left" : fGetObjectWriter = 23 + end select + + case "XML Form Design" + Select case sObject + case "Bring to Front" : fGetObjectWriter = 14 + case "Send to Back" : fGetObjectWriter = 15 + case "Group" : fGetObjectWriter = 17 + case "UnGroup" : fGetObjectWriter = 18 + case "Enter Group" : fGetObjectWriter = 19 + case "Exit Group" : fGetObjectWriter = 20 + end select + + end select + +end function + + +'******************************************************* +'* This function will get the location for image button +'* in Commands in Tools/Customize/Toolbars from Calc +'******************************************************* +function fGetObjectCalc(sToolbar as String , sObject as String) as Integer + + Select case sToolbar + case "3D-Settings" + Select case sObject + case "Extrusion On/Off" : fGetObjectCalc = 1 + '----------------- 2 + case "Tilt Down" : fGetObjectCalc = 3 + case "Tilt Up" : fGetObjectCalc = 4 + case "Tilt Left" : fGetObjectCalc = 5 + case "Tilt Right" : fGetObjectCalc = 6 + '----------------- 7 + case "Depth" : fGetObjectCalc = 8 + case "Direction" : fGetObjectCalc = 9 + case "Lighting" : fGetObjectCalc = 10 + case "Surfact" : fGetObjectCalc = 11 + case "3D Color" : fGetObjectCalc = 12 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Align" + Select case sObject + case "Left" : fGetObjectCalc = 1 + case "Centered" : fGetObjectCalc = 2 + case "Right" : fGetObjectCalc = 3 + case "Top" : fGetObjectCalc = 4 + case "Center" : fGetObjectCalc = 5 + case "Bottom" : fGetObjectCalc = 6 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Basic Shapes" + Select case sObject + end select + + case "Block Arrows" + Select case sObject + end select + + case "Callouts" + Select case sObject + end select + + case "Color" + Select case sObject + end select + + case "Controls" + Select case sObject + end select + + case "Drawing" + Select case sObject + case "Select" : fGetObjectCalc = 1 + '----------------- 2 + case "Line" : fGetObjectCalc = 3 + case "Rectangle" : fGetObjectCalc = 4 + case "Ellipse" : fGetObjectCalc = 5 + case "Polygon" : fGetObjectCalc = 6 + case "Curve" : fGetObjectCalc = 7 + case "Freeform Line" : fGetObjectCalc = 8 + case "Arc" : fGetObjectCalc = 9 + case "Ellipse Pie" : fGetObjectCalc = 10 + case "Circle Segment" : fGetObjectCalc = 11 + case "Text" : fGetObjectCalc = 12 + case "Vertical Text" : fGetObjectCalc = 13 + case "Text Animation" : fGetObjectCalc = 14 + case "Callouts" : fGetObjectCalc = 15 + case "Vertical Callouts" : fGetObjectCalc = 16 + '----------------- 17 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Drawing Object Properties" + Select case sObject + case "Display Grid" : fGetObjectCalc = 21 + case "Snap to Grid" : fGetObjectCalc = 22 + case "Guides When Moving" : fGetObjectCalc = 23 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Flowchart" + Select case sObject + end select + + case "Fontwork" + Select case sObject + end select + + case "Fontwork Shape" + Select case sObject + end select + + case "Form Design" + Select case sObject + case "Bring to Front" : fGetObjectCalc = 14 + case "Send to Back" : fGetObjectCalc = 15 + case "Group" : fGetObjectCalc = 17 + case "UnGroup" : fGetObjectCalc = 18 + case "Enter Group" : fGetObjectCalc = 19 + case "Exit Group" : fGetObjectCalc = 20 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Form Filter" + Select case sObject + end select + + case "Form Navigation" + Select case sObject + end select + + case "Form Object" + Select case sObject + end select + + case "Formatting" : + Select case sObject + case "Styles and Formatting" : fGetObjectCalc = 1 + case "Apply Style" : fGetObjectCalc = 2 + '---------------------- 3 + case "Font Name" : fGetObjectCalc = 4 + '---------------------- 5 + case "Font Size" : fGetObjectCalc = 6 + '---------------------- 7 + case "Bold" : fGetObjectCalc = 8 + case "Italic" : fGetObjectCalc = 9 + case "Underline" : fGetObjectCalc = 10 + case "Underline:Double" : fGetObjectCalc = 11 + '---------------------- 12 + case "Align Left" : fGetObjectCalc = 13 + case "Align Center Horizontally" : fGetObjectCalc = 14 + case "Align Right" : fGetObjectCalc = 15 + case "Justified" : fGetObjectCalc = 16 + case "Merge Cells" : fGetObjectCalc = 17 + '---------------------- 18 + case "Left-To-Right" : fGetObjectCalc = 19 + case "Right-To-Left" : fGetObjectCalc = 20 + '---------------------- 21 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Full Screen" + Select case sObject + case "Full Screen" : fGetObjectCalc = 1 + end select + + case "Graphic Filter" + Select case sObject + end select + + case "Insert" + Select case sObject + case "Chart" : fGetObjectCalc = 18 + case "Insert Object" : fGetObjectCalc = 19 + case "Controls" : fGetObjectCalc = 20 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Insert Cell" + Select case sObject + end select + + case "Insert Object" + Select case sObject + end select + + case "Media Playback" + Select case sObject + end select + + case "More Controls" + Select case sObject + end select + + case "Picture" + Select case sObject + end select + + case "Standard" + Select case sObject + case "Load URL" : fGetObjectCalc = 1 + case "New" : fGetObjectCalc = 2 + case "New Document From Template" : fGetObjectCalc = 3 + case "Open" : fGetObjectCalc = 4 + case "Save" : fGetObjectCalc = 5 + case "Save As" : fGetObjectCalc = 6 + case "Document as E-mail" : fGetObjectCalc = 7 + '----------------- 8 + case "Edit File" : fGetObjectCalc = 9 + '----------------- 10 + case "Export Directly as PDF" : fGetObjectCalc = 11 + case "Print File Directly" : fGetObjectCalc = 12 + case "Page Rreview" : fGetObjectCalc = 13 + '----------------- 14 + case "Spellcheck" : fGetObjectCalc = 15 + case "AutoSpellcheck" : fGetObjectCalc = 16 + '----------------- 17 + case "Cut" : fGetObjectCalc = 18 + case "Copy" : fGetObjectCalc = 19 + case "Paste" : fGetObjectCalc = 20 + case "Format Paintbrush" : fGetObjectCalc = 21 + '----------------- 22 + case "Can't Undo" : fGetObjectCalc = 23 + case "Can't Restore" : fGetObjectCalc = 24 + '----------------- 25 + case "Hyperlink" : fGetObjectCalc = 26 + case "Sort Ascending" : fGetObjectCalc = 27 + case "Sort Descending" : fGetObjectCalc = 28 + '----------------- 29 + case "Insert Chart" : fGetObjectCalc = 30 + case "Show Draw Functions" : fGetObjectCalc = 31 + '----------------- 32 + case "Find & Replace" : fGetObjectCalc = 33 + case "Navigator" : fGetObjectCalc = 34 + case "Gallery" : fGetObjectCalc = 35 + case "Data Sources" : fGetObjectCalc = 36 + case "Zoom" : fGetObjectCalc = 37 + '----------------- 38 + case "StarOffice Help" : fGetObjectCalc = 39 + case "What's This?" : fGetObjectCalc = 40 + case else : QAErrorLog "The test does not support Object : " + sObject + fGetObjectCalc = 0 + end select + + case "Standard(Viewing Mode)" + Select case sObject + end select + + case "Stars and Banners" + Select case sObject + end select + + case "Symbol Shapes" + Select case sObject + end select + + case "Text Formatting" + Select case sObject + end select + + case "Tools" + Select case sObject + end select + + case "previewbar" + Select case sObject + end select + + end select + +end function + + + diff --git a/testautomation/global/tools/includes/optional/t_xml1.inc b/testautomation/global/tools/includes/optional/t_xml1.inc new file mode 100755 index 000000000000..4490d95cbe41 --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_xml1.inc @@ -0,0 +1,658 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_xml1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* Owner : joerg.sievers@sun.com +'* +'* short description : simple XML-Parser for XML-Files from Registration-Database and Routines to work with SAX-Parser in Testtool +'* +'*********************************************************************************** +' #1 hXMLGotoElement +' #1 hXMLGetFirstCharsForElement +' #1 ExtractSections +' #1 GetXMLValue +' #1 GetXMLTagValue +' #1 GetXMLValueList +' #1 GetXMLValueType +' #1 GetXMLValueLine +' #1 GetXMLValueGlobal +' #1 GetExtractXMLValue +' #1 GetExtractXMLValueList +' #1 GetExtractXMLValueFromList +' #1 hXMLSeekElementInTree +'\********************************************************************************** + +function hXMLGotoElement ( sElementLine as String, optional bSilent as boolean) as boolean +'/// uses SAX Interface in testtool ///' +'///hXMLGotoElement ( sElementLine as String ) +'///+Input : sElementLine => the tree in DOM as one string seperated with ';' +'///+ - - - - - to be more exact, the Attribute Values to 'oor:name' ///' +'///+ - - - -: bSilent => print warnings? ///' +'///+Output : -- +'///+Return : was the Element found? +'///- you can jump directly to the correct entry in the DOM-tree + + Dim sList (50) as String + Dim i as Integer + Dim x as Integer + Dim y as Integer + Dim n as Integer + dim iMax as integer + dim bFound as boolean + dim bFoundCollect as boolean + dim iAttrCount as integer + dim bLocalSilent as boolean + + if (isMissing(bSilent)) then + bLocalSilent = FALSE + else + bLocalSilent = bSilent + endif + + bFoundCollect = TRUE + ExtractSections ( sElementLine, sList () ) + + for i=1 to ListCount ( sList () ) ' for every Section + iMax = SAXGetChildCount() + x = 0 + bFound = FALSE +' ' ------------ debug start ---------------------- +' for n = 1 to iMax +' SAXSeekElement (n) +' Printlog " " + i + ":(" + n + "/" + iMax + "): '" + SAXGetElementName +' iAttrCount = SAXGetAttributeCount +' for y = 1 to iAttrCount +' Printlog " " + i + ":" + n + ":(" + y + "/" + iAttrCount + "): '"+SAXGetAttributeName (y) +"' : '"+SAXGetAttributeValue (y) +"' " +' next y +' SAXSeekElement (0) +' next n +' ' ------------- debug end ----------------------- + while ((bFound = FALSE) AND (x < iMax)) ' compare the VALUE for the ATTRIBUTE 'oor:name' with the wanted ITEM + inc(x) ' do it until it fits; else print warnlog + SAXSeekElement (x) + if (SAXGetAttributeValue ("oor:name") <> sList (i)) then + SAXSeekElement (0) + else + bFound = TRUE + endif + wend + if ((bFound = FALSE) AND (bSilent = FALSE)) then + Warnlog "hXMLGotoElement::ERROR! Element " + i + ": '" + sList (i) + "' not found :-(" + endif + bFoundCollect = bFound AND bFoundCollect + next i + hXMLGotoElement = bFoundCollect +end function +' +'------------------------------------------------------------------------------- +' +function hXMLGetFirstCharsForElement ( sElementLine as String, optional sXMLFile as String, optional bClose as Boolean ) as String +'/// uses SAX Interface in testtool ///' + Dim bCloseLocal as Boolean +'///hXMLGetFirstCharsForElement ( sElementLine as String, optional sXMLFile as String, optional bClose as Boolean ) as String +'///+Input : sElementLine => the tree in DOM as one string seperated with ';' +'///+- sXMLFile => ( optional ) if you want to open the DOM for a file you can set here the filename +'///+- bClose => ( optional ) if you want to close the DOM after getting the char, you can set this to TRUE ( default is FALSE ) +'///+Output : -- +'///+Return : the string for the element +'///- you can jump directly to the correct entry in the DOM-tree and get the char for that entry +'///- the DOM is closed after this return + + if IsMissing( sXMLFile ) = FALSE then + SAXReadFile ( sXMLFile ) + end if + + if IsMissing( bClose ) = TRUE then + bCloseLocal = FALSE + else + bCloseLocal = bClose + end if + + hXMLGotoElement ( sElementLine ) + SAXSeekElement ( 1 ) + if SAXGetNodeType = NodeTypeCharacter then + hXMLGetFirstCharsForElement = SAXGetChars + else + Warnlog "hXMLGetFirstCharsForElement : the element " + sElementLine + " has no chars" + hXMLGetFirstCharsForElement = "" + end if + + if bCloseLocal = TRUE then SAXRelease +end function +' +'------------------------------------------------------------------------------- +' +function ExtractSections ( sInput as String, lsXMLsections() as String ) as Integer +'///Input : - sInput => a full section seperated with ';' +'///+- lsXMLsections => an empty list +'///+Output : the list ( lxXMLsections ) with seperated sectionnames +'///+Return : number of sections + + Dim ii, iLen as Integer + Dim iList ( 50 ) as String + Dim bFirstEntry as Boolean + Dim Dummy as String + dim sTemp as string + + lsXMLsections(0) = 0 + iList (0) = 0 + iLen = len ( sInput ) + bFirstEntry = TRUE + + for ii=1 to ( iLen ) + Dummy = mid ( sInput, ii, 1 ) + if ( mid ( sInput, ii, 1 ) ) = ";" then ListAppend ( iList(), Str ( ii ) ) + next ii + + for ii=1 to ( ListCount ( iList () ) ) + if bFirstEntry = TRUE then + ListAppend ( lsXMLsections(), Left ( sInput, Val(iList(1))-1 ) ) + bFirstEntry = FALSE + end if + Dummy = mid ( sInput, Val(iList(ii))+1, Val(iList(ii+1))-Val(iList(ii))-1 ) + ListAppend ( lsXMLsections(), Dummy ) + next ii + + sTemp = ListCount ( lsXMLsections() ) + ExtractSections = sTemp + if (sTemp = 0) then + ListAppend (lsXMLsections(), sInput) + ExtractSections = 1 + end if +end function +' +'------------------------------------------------------------------------------- +' +function GetXMLValue ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional bSilent as Boolean ) as String +'/// Input : - sXMLfile => Filename with full path /// +'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) /// +'///+ - - - - - sXMLsection => full way to the item /// +'///+ Output : - - /// +'///+ Return : - the value /// +'/// wraper for GetXMLValueGlobal ///' + if IsMIssing ( bSilent ) <> TRUE then + GetXMLValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, , , , bSilent ) + else + GetXMLValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, , , , ) + end if +end function + +function GetXMLTagValue ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, sValue as String ) as String +'/// Input : - sXMLfile => Filename with full path /// +'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) /// +'///+ - - - - - sXMLsection => full way to the item /// +'///+ Output : - - /// +'///+ Return : - the value /// +'/// wraper for GetXMLValueGlobal ///' + GetXMLTagValue = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, ,sValue , , ) +end function + +function GetXMLValueList ( lsXMLValue() as String, sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String +'/// Input : - sXMLfile => Filename with full path /// +'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) /// +'///+ - - - - - sXMLsection => full way to the item /// +'///+ Output : - - /// +'///+ Return : - the value /// +'/// wraper for GetXMLValueGlobal ///' + Dim sLine, sLine1 as String + Dim i, iCounter as Integer + + sLine = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, ,"cfg:value" , TRUE, ) + if sLine = "" then + GetXMLValueList = "" + else + GetXMLValueList = GetExtractXMLValueList ( lsXMLValue(), sLine, , ) + end if +end function +' +'------------------------------------------------------------------------------- +' +function GetXMLValueType ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional sType ) as String +'/// Input : - sXMLfile => Filename with full path /// +'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) /// +'///+ - - - - - sXMLsection => full way to the item /// +'///+ Output : - - /// +'///+ Return : - the value /// +'/// wraper for GetXMLValueGlobal ///' + Dim sDummy as String + if IsMissing ( sType ) = TRUE then + sDummy = "type" + else + sDummy = sType + end if + + GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection, sDummy, , , ) + GetXMLValueType = sDummy +end function + +function GetXMLValueLine ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String +'/// Input : - sXMLfile => Filename with full path /// +'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) /// +'///+ - - - - - sXMLsection => full way to the item /// +'///+ Output : - - /// +'///+ Return : - the value /// +'/// wraper for GetXMLValueGlobal ///' + GetXMLValueLine = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection,,, TRUE, ) +end function +' +'------------------------------------------------------------------------------- +' +function GetXMLValueGlobal ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, optional sXMLType, optional sXMLTag, optional biWholeLine, optional bSil as Boolean ) as String +'/// uses no SAX Parser : just text search in the file ///' +'/// You can get the value of an item in a XML-file. The value of the item must be set between <value> and <value/>. /// +'///+ The item can be written in one line or in more lines. /// +'/// Input : - sXMLfile => Filename with full path /// +'///+ - - - - - sXMLsectionMaster => the master-section ( mostly in StarOffice the filename without extension ) /// +'///+ - - - - - sXMLsection => full way to the item ///' +'///+ - - - - - optional sXMLType => if you want to get the XML-Type this variable must be set ///' +'///+ - - - - - optional sXMLTag => if sXMLTag isn't set, "value" is the tag, else you must set the tag here ///' +'///+ Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///' +'///+ Return : - the value of the searched item ///' +' Dim FileNum as Integer + Dim Pos, iSec, i, j, iDum as Integer + Dim MasterSecOK, MasterSecEnd, SecOK, SecEnd, bThrough, bWholeLine as Boolean + Dim xmlZeile, xmlZeile2, sVariable, sDummy, sDummy2 as String + Dim lsSecList ( 1000 ) as String + Dim lsInterim ( 1000 ) as String + Dim textin as object, sfa as object, xInput as object + Dim bSilent as Boolean + + if ( IsMissing ( bSil ) ) = TRUE then + bSilent = FALSE + else + bSilent = TRUE + end if + + if ( IsMissing ( biWholeLine ) ) = TRUE then + bWholeLine = FALSE + else + bWholeLine = TRUE + end if + + if Dir( sXMLfile ) = "" then + if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : " + sXMLfile + " is missing!" + exit function + end if + + MasterSecOK = FALSE : MasterSecEND = FALSE + SecOK=FALSE : SecEND=FALSE + bThrough = FALSE + Pos = 1 + GetXMLValueGlobal = "" + + lsSecList (0) = 0 + lsInterim (0) = 0 + + iSec = ExtractSections ( sXMLsection, lsSecList () ) + sVariable = lsSecList (iSec) + ListDelete ( lsSecList(), iSec ) + iSec = iSec-1 + if iSec = 0 then ListAppend ( lsSecList(), "" ) + + textin = createUnoService( "com.sun.star.io.TextInputStream" ) + textin.setEncoding("utf8") + sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" ) + xInput = sfa.openFileRead( sXMLfile ) + textin.setInputStream( xInput ) + + do until textin.isEOF() + xmlZeile = textin.readLine() + + xmlZeile = TrimTab ( Trim ( xmlZeile ) ) + xmlZeile2 = lCASE( xmlZeile ) ' control case-insensitiv + + if MasterSecOK = FALSE then ' master-section ( com.sun.star. ... ) + if xmlZeile2= "<" + lCASE( sXMLsectionMaster ) + ">" OR Instr ( xmlZeile2, "<" + lCASE( sXMLsectionMaster ) + " " ) <> 0 then + MasterSecOK = TRUE + else + if xmlZeile2 = "<" + lCASE( sXMLsectionMaster ) + "/>" then + if bSilent = FALSE then warnlog "GetXMLValueGlobal(...) : '" + sXMLsectionMaster + "' -> master-section has no entries!" + exit do + end if + end if + else + if xmlZeile2= "</" + lCASE( sXMLsectionMaster ) + ">" OR xmlZeile2= "<" + lCASE( sXMLsectionMaster ) + "/>" then + if bSilent = FALSE then warnlog "GetXMLValueGlobal(...) : '" + lsSecList (Pos) + "' -> entry could not be found!" + exit do + end if + + if ( Instr (xmlZeile2, lCASE ( "<" + lsSecList (Pos)) ) <> 0 AND iSec > 0 ) AND Pos < iSec+1 then + iDum = Instr ( lsSecList (Pos), " " ) + if iDum <> 0 then lsSecList(Pos) = Left ( lsSecList(Pos), iDum -1 ) + if xmlZeile2 = "<" + lCASE( lsSecList (Pos) ) + "/>" then + if Pos = iSec then + if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : '" + svariable + "' -> entry could not be found" + else + if bSilent = FALSE then Warnlog "GetXMLValueGlobal(...) : '" + lsSecList (Pos) + "' -> entry could not be found" + end if + exit do + else + Pos = Pos + 1 + end if + else + if Pos > iSec then + sDummy2 = Mid ( xmlZeile2, 2, len ( svariable ) + 1 ) + if sDummy2 = lCase ( svariable ) + ">" OR sDummy2 = lCase ( svariable ) + " " OR bThrough = TRUE then + iDum = Instr ( svariable, " " ) ' inserted because an error in GetXMLValueLineExtra 3.11.00 (TZ) + if iDum <> 0 then svariable = Left ( svariable, iDum -1 ) ' inserted because an error in GetXMLValueLineExtra 3.11.00 (TZ) + sDummy = Mid ( xmlZeile2, len ( xmlZeile2 ) - 1 - len ( svariable), len ( svariable)+1 ) + if ( bThrough = FALSE AND ( sDummy = "/" + lCase ( svariable ) OR Right (sDummy, 1 ) = "/" ) ) OR ( bThrough = TRUE AND sDummy = "/" + lCase ( svariable ) ) then + if ListCount ( lsInterim () ) = 0 then + if bWholeLine = TRUE then + GetXMLValueGlobal = xmlZeile + else + if ( IsMissing ( sXMLTag ) ) = TRUE then + if ( IsMissing ( sXMLType ) ) = TRUE then + GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile,, ) + else + GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile, sXMLType, ) + end if + else + if ( IsMissing ( sXMLType ) ) = TRUE then + GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile,, sXMLTag ) + else + GetXMLValueGlobal = GetExtractXMLValue ( xmlZeile, sXMLType, sXMLTag ) + end if + end if + end if + else + ListAppend ( lsInterim (), xmlZeile2 ) + if bWholeLine = TRUE then + for j=1 to ListCount ( lsInterim () ) + GetXMLValueGlobal = GetXMLValueGlobal + lsInterim (j) + next j + else + if ( IsMissing ( sXMLTag ) ) = TRUE then + if ( IsMissing ( sXMLType ) ) = TRUE then + GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (),, ) + else + GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (), sXMLType, ) + end if + else + if ( IsMissing ( sXMLType ) ) = TRUE then + GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (),, sXMLTag ) + else + GetXMLValueGlobal = GetExtractXMLValueFromList ( lsInterim (), sXMLType, sXMLTag ) + end if + end if + end if + end if + bThrough = FALSE + exit do + else + if xmlZeile2 <> "" then + bThrough = TRUE + ListAppend ( lsInterim (), xmlZeile2 ) + end if + end if + end if + end if + end if + end if + loop + + xInput.closeInput '* uno-file-close + + if bSilent = FALSE then + if MasterSecOK = FALSE then warnlog "GetXMLValueGlobal (...) : '" + sXMLsectionMaster + "' -> Master-section was not found!" + end if + wait 1000 +end function +' +'------------------------------------------------------------------------------- +' +function GetExtractXMLValue ( sFullLine as String, optional sXMLType, optional sXMLTag ) as String +'/// Get the value-string, when the text is only in one line. ///' +'/// Input : - sFullLine => the whole line out of XML-File ///' +'/// Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///' +'/// Return : - the text between <value> and <value/> ///' + Dim i, ii, iStart, iEnd as Integer + Dim sInterim, ssTag as String + + if ( IsMissing ( sXMLTag ) ) = TRUE then + ssTag = "value" + else + ssTag = sXMLTag + end if + + sInterim = lCase ( sFullLine ) + + if InStr ( sInterim, "<" + ssTag + "/>" ) <> 0 then + GetExtractXMLValue = "" + else + iStart = InStr ( sInterim, "<" + ssTag + ">" ) + iEnd = InStr ( sInterim, "</" + ssTag + ">" ) + if iStart <> 0 AND iEnd <> 0 then + if iStart + len(ssTag) + 2 = iEnd then + GetExtractXMLValue = "" + else + GetExtractXMLValue = Mid ( sFullLine, iStart + len ( ssTag )+2, iEnd - iStart - len ( ssTag ) - 2 ) + end if + end if + end if + + if ( IsMissing ( sXMLType ) ) = FALSE then + sXMLType = lcase (sXMLType) + ii = InStr ( sInterim, sXMLType + "=" ) + if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" ) + if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" ) + + if ii = 0 then + sXMLType = "" + else + for i=ii to len ( sInterim ) - ii + if Mid ( sInterim, i, 1 ) = chr (34) then + iStart=i + i=1000 + end if + next i + for i=(iStart+1) to len ( sInterim ) - (iStart+1) + if Mid ( sInterim, i, 1 ) = chr (34) then + iEnd=i + i=1000 + end if + next i + sXMLType = Mid ( sFullLine, iStart+1, iEnd-iStart-1 ) + end if + end if + +end function +' +'------------------------------------------------------------------------------- +' +function GetExtractXMLValueList ( lsXMLValues (), sFullLine as String, optional sXMLType, optional sXMLTag ) as Integer +'/// Get the value-string, when the text is only in one line ///' +'/// Input : - ///' +'/// Output : - ///' +'/// Return : - ///' + Dim i, ii, iStart, iEnd as Integer + Dim sInterim, ssTag as String + + lsXMLValues(0)=0 + + if ( IsMissing ( sXMLTag ) ) = TRUE then + ssTag = "value" + else + ssTag = sXMLTag + end if + + sInterim = lCase ( sFullLine ) + ii = len( sInterim ) / len ( ssTag ) ' maximal so viele Wiederholungen, wie es sTags gibt + + for i=1 to ii + if InStr ( sInterim, "<" + ssTag + "/>" ) = 0 then + iStart = InStr ( sInterim, "<" + ssTag + ">" ) + iEnd = InStr ( sInterim, "</" + ssTag + ">" ) + if iStart <> 0 AND iEnd <> 0 then + if iStart + len(ssTag) + 2 = iEnd then + ListAppend ( lsXMLValues(), "" ) + sInterim = Mid ( sInterim, iEnd + len (ssTag)+2, len (sInterim) - iEnd - len (ssTag) - 1 - 2 ) + else + ListAppend ( lsXMLValues(), Mid ( sInterim, iStart + len(ssTag)+2, iEnd - iStart - len(ssTag)-2 ) ) + sInterim = Mid ( sInterim, iEnd + len (ssTag), len (sInterim) - iEnd - len (ssTag) - 1 ) + end if + else + i = ii + 1 + end if + end if + next i + GetExtractXMLValueList = ListCount ( lsXMLValues() ) + + if ( IsMissing ( sXMLType ) ) = FALSE then + sXMLType = lcase (sXMLType) + ii = InStr ( sInterim, sXMLType + "=" ) + if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" ) + if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" ) + + if ii = 0 then + sXMLType = "" + else + for i=ii to len ( sInterim ) - ii + if Mid ( sInterim, i, 1 ) = chr (34) then + iStart=i + i=1000 + end if + next i + for i=(iStart+1) to len ( sInterim ) - (iStart+1) + if Mid ( sInterim, i, 1 ) = chr (34) then + iEnd=i + i=1000 + end if + next i + sXMLType = Mid ( sFullLine, iStart+1, iEnd-iStart-1 ) + end if + end if + +end function +' +'------------------------------------------------------------------------------- +' +function GetExtractXMLValueFromList ( lsList() as String, optional sXMLType, optional sXMLTag ) as String +'/// Get the value-string, when the text is in a list ( when the item is written in more than one line ). ///' +'/// Input : - lsList() => the list of the whole entry of the xml-item ///' +'/// Output : - optional sXMLType => if sXMLType is set, it will be returned the Type of the value as string ///' +'/// Return : - the text between <value> and <value/> ///' + Dim i, ii, iStart, iEnd as Integer + Dim sInterim, sInterim1, ssTag as String + + if ( IsMissing ( sXMLTag ) ) = TRUE then + ssTag = "value" + else + ssTag = sXMLTag + end if + + for i=1 to ListCount ( lsList() ) + sInterim1 = sInterim1 + lsList(i) + next i + + sInterim = lCase ( sInterim1 ) + + if InStr ( sInterim, "<"+ ssTag +"/>" ) <> 0 then + GetExtractXMLValueFromList = "" + else + iStart = InStr ( sInterim, "<" + ssTag + ">" ) + iEnd = InStr ( sInterim, "</" + ssTag + ">" ) + if iStart <> 0 AND iEnd <> 0 then + if iStart + len(ssTag) + 2 = iEnd then + GetExtractXMLValueFromList = "" + else + GetExtractXMLValueFromList = Mid ( sInterim1, iStart + len ( ssTag )+2, iEnd - iStart - len ( ssTag ) - 2 ) + end if + end if + end if + + if ( IsMissing ( sXMLType ) ) = FALSE then + sXMLType = lcase (sXMLType) + ii = InStr ( sInterim, sXMLType + "=" ) + if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" ) + if ii = 0 then ii = InStr ( sInterim, sXMLType + " =" ) + + if ii = 0 then + sXMLType = "" + else + for i=ii to len ( sInterim ) - ii + if Mid ( sInterim, i, 1 ) = chr (34) then + iStart=i + i=1000 + end if + next i + for i=(iStart+1) to len ( sInterim ) - (iStart+1) + if Mid ( sInterim, i, 1 ) = chr (34) then + iEnd=i + i=1000 + end if + next i + sXMLType = Mid ( sInterim1, iStart+1, iEnd-iStart-1 ) + end if + end if +end function +' +'----------------------------------------------------------------------------- +' +function hXMLSeekElementInTree ( sSeekThisNodeXML as STRING ) as BOOLEAN + hXMLSeekElementInTree = FALSE +' Peter Junge: 2005-07-29 +'///<u><b>Recursion to find XML element</b></u>/// +'///Input: 'sSeekThisNodeXML' - XML element to seek, e.g. 'foo:bar'/// +'///(A XML DOM has to be loaded before)/// +'///Seek begins at current XML pointer/// +'///Return: TRUE if element was found, else FALSE/// +'///BEHAVIOUR: XML pointer is set to 'foo:bar' if found, if not XML pointer is reset to initial element/// +'///NOTE: Currently only the first appearence of 'foo:bar' is found./// +'///NOTE: If e.g. the Nth element should be found you have to modify this function/// +'///NOTE: There should be further enhancements possible, e.g. find element with specific attribute/// + dim iIndex as INTEGER + '///<ul><li>Check if current node matches 'sSeekThisNodeXML'</li>/// + if SAXGetElementName() = sSeekThisNodeXML then + '///<li>MATCH: Function returns TRUE</li>/// + hXMLSeekElementInTree = TRUE + else + '///<li>NO MATCH: LOOKUP if current node has elements</li>/// + for iIndex = 1 to SAXGetChildCount() + '///<li>-> (Loop) Set pointer on child</li>/// + SAXSeekElement ( iIndex ) + '///<li>-> Check if child is a XML element</li>/// + if SAXGetNodeType() = 556 then + '///<li>-> RECURSION: function recalls itself for current element</li>/// + if hXMLSeekElementInTree ( sSeekThisNodeXML ) = TRUE then + '///<li>Don't forget to pass back the result TRUE to recursions parent</li>/// + hXMLSeekElementInTree = TRUE + '///<li>Exit loop if found</li>/// + Exit For + endif + endif + '///<li>NO MATCH: Go back to parent in DOM tree</li></ul>/// + SAXSeekElement( 0 ) + next iIndex + endif +end function + diff --git a/testautomation/global/tools/includes/optional/t_xml2.inc b/testautomation/global/tools/includes/optional/t_xml2.inc new file mode 100755 index 000000000000..a089b780c83a --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_xml2.inc @@ -0,0 +1,498 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_xml2.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : XML search routines II +'* +'************************************************************************ +'* +' #1 GetXMLValueLineExtra ' DEPRECATED depending on t_xml1.inc::GetXMLValueGlobal +' #1 XMLWellFormed ' Checks the well formness of a XML file. +' #1 GetXMLValue2 ' OBSOLETE: XML search routine (as TT has no SAX included we have used that rountine) +' #1 GetBodiesItemStyleName ' DEPRECATED used by ../xml/level1/inc/sxw7_02.inc +' #1 GetLineInXMLBody ' DEPRECATED used by ../xml/level1/inc/sxw7_02.inc and ../sxw7_03.inc +' #1 GetItemStyleName ' DEPRECATED used by ../xml/level1/inc/sxw7_01.inc +' #1 GetXMLElementPath ' Gets the elementpath in a DOM tree (mostly used for [automatic-]styles) +' #1 fWhereIsXMLElementInBody ' Gets the elementpath in a DOM tree in the second level (mostly body elements) +'* +'\*********************************************************************** + +function GetXMLValueLineExtra ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String, sGroupTyp as String, sGroupName as String ) as String +'///+ Input:<ul><li>sXMLfile => Filename with full path</li> +'///+ <li>sXMLsectionMaster => The master-section (mostly in OpenOffice.org the filename without extension)</li> +'///+ <li>sXMLsection => Full way to the item</li> +'///+ <li>sGroupTyp => First entry after tag</li> +'///+ <li>sGroupName => Value of first entry</li></ul> + GetXMLValueLineExtra = GetXMLValueGlobal ( sXMLfile, sXMLsectionMaster, sXMLsection + " " + sGroupTyp + "=" + Chr(34) + sGroupName + Chr(34),,, TRUE ) +end function + +'------------------------------------------------------------------------- + +function GetXMLItemInstance ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String +'/// Input:<ul><li>sXMLfile => Filename with full path</li> +'///+ <li>sXMLsectionMaster => The master-section (mostly in OpenOffice.org the filename without extension)</li> +'///+ <li>sXMLsection => Full way to the item</li></ul> + Dim sLine, sLine2 as String + Dim iStart, iEnd, i, iStr, iLen as Integer + + sLine = GetXMLValueLine ( sXMLfile, sXMLsectionMaster, sXMLsection ) + sLine2 = lcase ( sLine ) + iStr = Instr ( sLine2, "instance" ) + iLen = len ( sLine2 ) + iStart = 0 + + if iStr=0 then + GetXMLItemInstance = "false" + exit function + else + for i=iStr to iLen + if iStart = 0 then + if Mid ( sLine2, i, 1 ) = Chr(34) then iStart = i + else + if Mid ( sLine2, i, 1 ) = Chr(34) then + iEnd = i + i= iLen + 1 + end if + end if + next i + end if + if iStart = 0 then + GetXMLItemInstance = "" + else + GetXMLItemInstance = Mid ( sLine, iStart+1, iEnd - iStart - 1 ) + end if +end function + +'------------------------------------------------------------------------- + +function GetXMLItemEncoding ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String +'/// Input: <ul><li>sXMLfile => Filename with full path</li> +'///+ <li>sXMLsectionMaster => The master-section (mostly in OpenOffice.org the filename without extension)</li> +'///+ <li>sXMLsection => Full way to the item</li></ul> + Dim sLine, sLine2 as String + Dim iStart, iEnd, i, iStr, iLen as Integer + + sLine = GetXMLValueLine ( sXMLfile, sXMLsectionMaster, sXMLsection ) + sLine2 = lcase ( sLine ) + iStr = Instr ( sLine2, "encoding" ) + iLen = len ( sLine2 ) + iStart = 0 + + if iStr=0 then + GetXMLItemEncoding = "false" + exit function + else + for i=iStr to iLen + if iStart = 0 then + if Mid ( sLine2, i, 1 ) = Chr(34) then iStart = i + else + if Mid ( sLine2, i, 1 ) = Chr(34) then + iEnd = i + i= iLen + 1 + end if + end if + next i + end if + if iStart = 0 then + GetXMLItemEncoding = "" + else + GetXMLItemEncoding = Mid ( sLine, iStart+1, iEnd - iStart - 1 ) + end if +end function + +'------------------------------------------------------------------------- + +function XMLWellFormed ( sFileName as String, optional bDebug as Boolean ) as Boolean +'/// Input: File name as string +'/// <i>(obsolete: Debug)</i> +'/// Return: TRUE or FALSE + Dim InputstreamXML as string + XMLWellFormed = FALSE + if IsMissing(bDebug) = FALSE then + warnlog "Debugmode 'XMLWellFormed' is obsolete. FUNCTION is now a native TestTool function!" + end if + InputstreamXML = SAXCheckWellFormed(sFileName) + if InputstreamXML <> "" then + warnlog "Problem was found: " & InputstreamXML + else + printlog "File: '" & sFileName & "' is well formed." + XMLWellFormed = TRUE + end if +end function + +'------------------------------------------------------------------------- + +function GetXMLValue2 ( sXMLfile as String, sXMLsectionMaster as String, sXMLsection as String ) as String +'/// Input: <ul><li>sXMLfile => Filename with full path</li></ul> + Dim lsList(10) as String + Dim sInterim, sInterim2 as String + Dim i, ii, iLen, ibegin ,iEnd as Integer + + sInterim = GetXMLValueLine ( sXMLfile, sXMLsectionMaster, sXMLsection,,, ) + if sInterim = "" then + GetXMLValue2 = "" + exit function + end if + + i = ExtractSections ( sXMLsection, lsList() ) + sInterim2 = lsList(i) + iLen = len ( sInterim ) + ii = len ( sInterim2 ) + 1 + + for i=ii to iLen + if mid( sInterim, i, 1 ) = ">" then + iBegin = i+1 + i=iLen+1 + end if + next i + iEnd = ( iLen - ii - 1 ) - iBegin + GetXMLValue2 = Mid ( sInterim, iBegin, iEnd ) +end function + +'------------------------------------------------------------------------- + +function GetBodiesItemStyleName ( AXMLfile as string , WhichItem as string , HowOften as integer , OPTIONAL B ) as string +' Author: Joerg Sievers +'/// With GetBodiesItemStyleName you can get the NAME of a STYLE from +'///+ a item in the BODY of a OpenOffice.org XML-file. +'/// <blockquote>OPTIONAL PARAMETER +'///+ If there are more than one "style-name" tags in ONE line, you +'///+ have to use an optional parameter. +'/// <i>see also</i>:<ul> +'///+ <li>GetXMLValueLineExtra</li></ul> +'/// <u>simple Example</u>: +'///+ String = GetBodiesStyleName ("example.sxc") , "table:table-row" , 2) +'///+ Return: The second STYLE-NAME of the 'table-row'-tag in the office:body +'/// <u>Example with optional parameter</u>: +'///+ XML-line you want to parse for the text:span style-name and it is the second +'///+ text:span-attribute in the office:body-section: +'///+ <blockquote> +'///+ <text:p text:style-name="P1"><text:span text:style-name="T1">The first text</text:span></text:p> +'///+ <text:p text:style-name="P4"><text:span text:style-name="T4">Just a text</text:span></text:p> +'///+ </blockquote> +'///+ then you have to use: +'///+ String = GetBodiesStyleName ("example.sxc") , "table:table-row" , 2 , 1) +'///+ The first ineteger (2) is for the second <text:span-entry in the file. +'///+ The OPTIONAL second integer is the 'ONE' AFTER the first tag in the same line. + Dim FileNum as integer + Dim XMLRawLine as string + Dim XMLCLearedLine as string + Dim a as integer + Dim i as integer + Dim FoundEntry as boolean + Dim DelLeft as integer + Dim ItemPosInString as integer + Dim XMLCLearedLineWithoutLeft as string + Dim DelRight as integer + Dim XMLCLearedAndSeperatedLine as string + + if Dir ( AXMLfile ) = "" then + warnlog "GetBodiesItemStyleName(...) : '" & AXMLfile & "' is missing!" + exit function + end if + + WhichItem = "<" & WhichItem + + a = 0 + FoundEntry = FALSE + + FileNum = FreeFile + + Open AXMLfile For Input As #FileNum + + Do until EOF(#FileNum) = TRUE OR FoundEntry = TRUE + + Line input #FileNum, XMLRawLine +' deleting tabs and spaces + XMLCLearedLine = TrimTab ( Trim ( XMLRawLine ) ) +' jumping to the office:body + if InStr(XMLCLearedLine , "<office:document-") <> 0 then + + Do until EOF(#FileNum) = TRUE OR FoundEntry = TRUE + Line input #FileNum, XMLRawLine + XMLCLearedLine = TrimTab ( Trim ( XMLRawLine ) ) +' if the count of the item is the same as the one searching for... + ItemPosInString = InStr(XMLCLearedLine , WhichItem) + if ItemPosInString <> 0 then +' warnlog "Debug: ItemPosInString = '" & ItemPosInString & "'" +' Is there more than one time the 'WhichItem' in this line? +' (MUST BE GIVEN BY OPTIONAL PARAMETER!) + if IsMissing(B) = FALSE then + For i = 1 to B + DelLeft = InStr(XMLCLearedLine , "style-name=" & CHR$(34)) + XMLCLearedLineWithoutLeft = Mid(XMLCLearedLine, DelLeft+12) + XMLCLearedLine = XMLCLearedLineWithoutLeft + Next i + end if + a = a+1 + if a=HowOften then +' searching for exakt attribute stylename=" + DelLeft = InStr(XMLCLearedLine , "style-name=" & CHR$(34)) +' extrcting, stripping all things after the style-name-attribute (=12 chars) + XMLCLearedLineWithoutLeft = Mid(XMLCLearedLine, DelLeft+12) +' extracting the real name without the " + DelRight = InStr(XMLCLearedLineWithoutLeft , CHR$(34)) +' stripping it + XMLCLearedAndSeperatedLine = Mid(XMLCLearedLineWithoutLeft, 1 , DelRight-1) + GetBodiesItemStyleName = GetBodiesItemStyleName+XMLCLearedAndSeperatedLine + FoundEntry = TRUE + end if + end if + loop + end if + + loop + Close #FileNum +end function + +'------------------------------------------------------------------------- + +function GetLineInXMLBody ( AXMLfile as string , WhichItem as string , HowOften as integer) as string +'Author: Joerg Sievers +'/// With this function you can extract a whole line in <office:body> +'///+ of a XML document. It is important to give this routine the +'///+ correct <ITEM and the count in <office:body>. +'/// <u>simple Example</u>: +'///+ We want to find the 2nd (!) table:table-row item +'///+ <table:table-row table:style-name="ro2" table:visibility="collapse"> +'///+ String = GetLineInXMLBody(gOfficePath & ConvertPath("Content.xml") , "table:table-row" , 2) +'///+ Return: The whole line of the second 'table:table-row'-item. + Dim FileNum as integer + Dim XMLRawLine as string + Dim XMLCLearedLine as string + Dim a as integer + Dim FoundEntry as boolean + Dim ItemPosInString as integer + + if Dir ( AXMLfile ) = "" then + warnlog "GetLineInXMLBody(...) : '" & AXMLfile & "' is missing!" + exit function + end if + + WhichItem = "<" & WhichItem + + a = 0 + FoundEntry = FALSE + + FileNum = FreeFile + + Open AXMLfile For Input As #FileNum + + Do until EOF(#FileNum) = TRUE OR FoundEntry = TRUE + + Line input #FileNum, XMLRawLine +' deleting tabs and spaces + XMLCLearedLine = TrimTab ( Trim ( XMLRawLine ) ) +' jumping to the office:body + if InStr(XMLCLearedLine , "office:body") <> 0 then + Do until EOF(#FileNum) = TRUE OR FoundEntry = TRUE + Line input #FileNum, XMLRawLine + XMLCLearedLine = TrimTab ( Trim ( XMLRawLine ) ) +' if the count of the item is the same as the one searching for... + ItemPosInString = InStr(XMLCLearedLine , WhichItem) + if ItemPosInString <> 0 then + a = a+1 + if a=HowOften then + GetLineInXMLBody = XMLCLearedLine +' printlog "Debug from 'GetLineInXMLBody'-function: '" & XMLCLearedLine & "'" + FoundEntry = TRUE + end if + end if + loop + end if + loop + Close #FileNum +end function +' +'------------------------------------------------------------------------------- +' +function GetItemStyleName ( sMainElement$ , sUsedElement$ , sElement$ , sCount as integer , sStyleName$ ) as string +'Author: Joerg Sievers +'/// With GetItemStyleName you can get the NAME of a STYLE in ANY +'///+ Element in a main element (like office:body-content) of a OpenOffice.org XML-file. +'/// ATTENTION: +'///+ If the second parameter is the SAME as the third one, you are not going into the +'///+ third area. You will stay in the DOM in the second, where e.g. table:table element could +'///+ be found. +'/// <u>simple Example</u>: +'///+ String = GetItemStyleName ( "office:body", "table:table", "table:table-row" , 3 , "table:style-name" ) +'///+ Return: The (attribute) name of the 3rd table-row node in a Writer document. +'///+ With this name you can search in the style-section for the correct values. + Dim InputstreamXML as integer + Dim i as integer + Dim a as integer + Dim xElementName as string + 'Read the file and go to the main DOM node + SAXSeekElement(1) +' If you need a debug mode, enable the printlog entries +' ----------------------------------------------------- +' printlog " +-- function: GetItemStyleName ---------------------------" +' printlog " | Main Node : " & SAXGetElementName + 'Go to the main element (like office:body, office:script, office:automatic-styles, etc.) + SAXSeekElement(sMainElement$) +' printlog " | Main Element : " & sMainElement$ + if sUsedElement$ <> sElement$ then + SAXSeekElement(sUsedElement$) +' printlog " | Used Element : " & sUsedElement$ + end if + InputstreamXML = SaxGetChildCount +' printlog " | Count of Children : " & InputstreamXML + for i = 1 to InputstreamXML + SAXSeekElement(i) + if SAXGetNodeType = NodeTypeElement then + xElementName = SAXGetElementName + if xElementName = sElement$ then + a= a+1 +' printlog "("& i & " / " & a & ") Element:" & xElementName + if a = sCount then + GetItemStyleName = SAXGetAttributeValue(sStyleName$) +' printlog " | Name of Element : " & GetItemStyleName + exit for + end if + end if + SAXSeekElement(0) + end if + next i +' printlog " +---------------------------------------------------------" +end function + +'------------------------------------------------------------------------- + +function GetXMLElementPath ( sMainElement$ , sUsedElement$ , sStyleName$, sStyleNameValue$ ) as string +'Author: Joerg Sievers +'///+ Returns the path (in a DOM tree) for an exact named element. +'///+ With this string it is possible to navigate easily to a named +'///+ element with <i>SAXSeekElement</i>-function. + Dim InputstreamXML as integer + Dim i as integer + Dim xAttributeValue as string + Dim a as integer + Dim xElementName as string + 'Read the file and go to the main DOM node + SAXSeekElement("/") + SAXSeekElement(1) + InputstreamXML = SaxGetChildCount +' If you need a debug mode, enable the printlog entries +' ----------------------------------------------------- +' printlog " +-- function: GetXMLElementPath --------------------------" +' printlog " | Main Node : " & SAXGetElementName + 'Go to the main element (like office:body, office:script, office:automatic-styles, etc.) + SAXSeekElement(sMainElement$) +' printlog " | Main Element : " & sMainElement$ + InputstreamXML = SaxGetChildCount +' printlog " | Count of Children : " & InputstreamXML + for i = 1 to InputstreamXML + SAXSeekElement(i) + xElementName = SAXGetElementName(i) + if xElementName = sUsedElement$ then + xAttributeValue = SAXGetAttributeValue(sStyleName$) + if xAttributeValue = sStyleNameValue$ then +' printlog " | Elementname (" & i & ") : " & xElementName +' printlog " | Attribute value : " & xAttributeValue + GetXMLElementPath = SAXGetElementPath + exit for + end if + end if + SAXSeekElement(0) + next i +' printlog " +---------------------------------------------------------" +end function + +'------------------------------------------------------------------------- + +function fWhereIsXMLElementInBody ( sSubDocumentRootElement as string , sDocumentRootElement as string , sWhichElement as string , OPTIONAL A ) as string +Dim iXMLElements as integer +Dim k as integer +Dim iXMLElementsInSecondLayer as integer +Dim i as integer +'/// A function to parse a XML DOM of an office document and return the <i>Elementpath</i> +'///+ of an element where you can search for in the <u>second level</u>. +SAXSeekElement(sSubDocumentRootElement) +'/// Input:<ol><li>Which element to be searched for</li> +'///+ <li><i>SubDocumentRootElement</i>: +'///+ <ul><li>office:document-meta</li> +'///+ <li>office:document-styles</li> +'///+ <li>office:document-content</li> +'///+ <li>office:document-settings</li></ul></li> +SAXSeekElement(sDocumentRootElement) +'///+ <li><i>DocumentRootElement</i>: +'///+ <ul><li>office:meta</li> +'///+ <li>office:settings</li> +'///+ <li>office:scripts</li> +'///+ <li>office:font-decls</li> +'///+ <li>office:styles</li> +'///+ <li>office:automatic-styles</li> +'///+ <li>office:master-styles</li> + '///+ <li>office:body</li></ul></li></ol> +iXMLElements = SAXGetChildCount + 'If you need debug information, change next line value to TRUE + EnableQAErrors = FALSE + QAErrorLog "Debug: t_xml2.inc::fWhereIsXMLElementInBody::iXMLElements = "& iXMLElements +for i = 1 to iXMLElements + if SAXHasElement(i) = TRUE then + SAXSeekElement(i) + QAErrorLog "Debug: t_xml2.inc::fWhereIsXMLElementInBody::SAXSeekelement(i) [" & i & "] = +- "& SAXGetElementname(i) + iXMLElementsInSecondLayer = SAXGetChildCount + QAErrorLog "Debug: t_xml2.inc::fWhereIsXMLElementInBody::iXMLElementsInSecondLayer [" & i & "] = +- "& iXMLElementsInSecondLayer + if iXMLElementsInSecondLayer <> 0 then + for k = 1 to iXMLElementsInSecondLayer + SAXSeekElement(k) + if SAXGetNodeType = NodeTypeElement then + QAErrorLog "Debug: t_xml2.inc::fWhereIsXMLElementInBody::SAXGetElementName(a) [" & k & "] = +- "& SAXGetElementName(k) + if IsMissing(A) then + if SAXGetElementName(k) = sWhichElement then + fWhereIsXMLElementInBody = SAXGetElementPath + QAErrorLog "Debug: t_xml2.inc::fWhereIsXMLElementInBody =" & fWhereIsXMLElementInBody + exit function + end if + else + if SAXGetElementName((k-1)+A) = sWhichElement then + SAXSeekElement(0) + SAXSeekElement(sWhichElement , A) + QAErrorLog "Debug: t_xml2.inc::fWhereIsXMLElementInBody::SAXGetChildCount =" & SAXGetChildCount + fWhereIsXMLElementInBody = SAXGetElementPath + QAErrorLog "Debug: t_xml2.inc::fWhereIsXMLElementInBody =" & fWhereIsXMLElementInBody + exit function + end if + end if + end if + SAXSeekElement(0) + next k + end if + SAXSeekElement(0) + end if +next i +end function +'------------------------------------------------------------------------- + diff --git a/testautomation/global/tools/includes/optional/t_xml_filter1.inc b/testautomation/global/tools/includes/optional/t_xml_filter1.inc new file mode 100644 index 000000000000..9677b3d84cdc --- /dev/null +++ b/testautomation/global/tools/includes/optional/t_xml_filter1.inc @@ -0,0 +1,771 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_xml_filter1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : Tools / XML Filter Settings Resource Test +'* +'************************************************************************ +'* +' #1 tToolsXMLFilterSettings 'Resource test for 'Tools' / 'XML Filter Settings' +' #1 fInitialXMLSetting 'Checks the availibility of the Excel XML import filter +' #0 sRemoveXSLTFilter +'* +'\*********************************************************************** + +testcase tToolsXMLFilterSettings + Dim iCountOfXSLTStylesAtBeginning as integer + Dim iCountOfXSLTStylesAfterInstallCheck as integer + Dim iApplicationEntries as integer + Dim ia as integer + Dim ib as integer + Dim ic as integer + Dim iCountMsgBox as integer + Dim sErrorPointerTextForResultfile as string + Dim sFilterPackagePath as string + Dim sDocXMLTestFile as string + Dim sWhichFilterToUse as string + Dim sTempReadFilterName as string + Dim bREMOVEXSLT as boolean + Dim bJavaBroken as boolean + + 'Not being used for Writer/WEB + if lcase(gApplication) = "htmldokument" then + goto endsub + endif + + 'Define the pointer where all warnlogs/QAErrorLogs will come from in this routine. + sErrorPointerTextForResultfile = "global::tools::inc::t_xml_filter1,inc::tToolsXMLFilterSettings: " + + 'Later it will be detected if the JRE is working with the office installation + 'Here bJavaBroken will be set to the default behaviour (Java is detected and is working) + bJavaBroken = FALSE + + '/// Opening new document. + printlog "- Opening new (application) document." + call hNewDocument + '/// Calling the menu item <i>Tools -> XML Filter Settings</i> + ToolsXMLFilterSettings + printlog "- XML Filter Settings" + Kontext "XMLFilterSettings" + if XMLFilterSettings.Exists(1) then + call Dialogtest (XMLFilterSettings) + else + warnlog sErrorPointerTextForResultfile & "Slot to open the 'XML Filter Settings dialog' failed. Exiting." + goto endsub + end if + 'Counting the existing XSLT stylesheets to verify them after the + 'XSLT stylesheet Check. Setting bREMOVEXSLT = FALSE which only will + 'be TRUE if the count of before and after the check are different. + bREMOVEXSLT = FALSE + iCountOfXSLTStylesAtBeginning = FilterList.GetItemCount + '/// Closing the XML Filter Settings-dialog. + printlog "Closing the 'XML Filter Settings'-dialog." + CloseBtn.Click + '/// Checking if there are any XSLT stylesheets available (<i>finitialXMLSetting("docbook or word or excel")</i>). + printlog " + Checking if there are any XSLT stylesheets available." + select case gApplication + case "CALC" : sWhichFilterToUse = "excel" + case "WRITER" : sWhichFilterToUse = "word" + case else : sWhichFilterToUse = "docbook" + end select + if finitialXMLSetting(sWhichFilterToUse) = FALSE then + warnlog "It wasn't possible to use/install external XML filter. Test aborting!" + goto endsub + end if + ToolsXMLFilterSettings + printlog "Open XML Filter Settings dialog again." + Kontext "XMLFilterSettings" + iCountOfXSLTStylesAfterInstallCheck = FilterList.GetItemCount + if iCountOfXSLTStylesAfterInstallCheck <> iCountOfXSLTStylesAtBeginning then + bREMOVEXSLT = TRUE + end if + '/// Checking disabling of buttons on this dialog. + printlog " + Checking that Edit/Test/Delete/SaveToPackage buttons disabled when no filter is selected." + if EditBtn.IsEnabled then + FilterList.Typekeys "<MOD1 SPACE>" + sleep(1) + end if + if EditBtn.IsEnabled then + warnlog sErrorPointerTextForResultfile & "Edit button: Enabled when no entry is selected!?" + end if + if TestXSLTs.IsEnabled then + warnlog sErrorPointerTextForResultfile & "TestXSLTs button: Enabled when no entry is selected!?" + end if + if DeleteBtn.IsEnabled then + warnlog sErrorPointerTextForResultfile & "Delete button: Enabled when no entry is selected!?" + end if + if SaveToPackage.IsEnabled then + warnlog sErrorPointerTextForResultfile & "SaveToPackage button: Enabled when no entry is selected!?" + end if + '/// Checking disabling of buttons on this dialog. + printlog " + Checking that Edit/Test/Delete/SaveToPackage buttons enabled when one filter is selected." + if NOT EditBtn.IsEnabled then + FilterList.Typekeys "<SPACE>" + sleep(1) + end if + if NOT EditBtn.IsEnabled then + warnlog sErrorPointerTextForResultfile & "Edit button: Disabled when one entry is selected!?" + end if + if NOT TestXSLTs.IsEnabled then + warnlog sErrorPointerTextForResultfile & "TestXSLTs button: Disabled when one entry is selected!?" + end if + if NOT DeleteBtn.IsEnabled then + warnlog sErrorPointerTextForResultfile & "Delete button: Disabled when one entry is selected!?" + end if + if NOT SaveToPackage.IsEnabled then + warnlog sErrorPointerTextForResultfile & "SaveToPackage button: Disabled when one entry is selected!?" + end if + '/// <i>[Loop]</i> + '///+ <ol><li>Clicking the "New" button</li> + '///+ <li>Clicking the "Edit" button</li></ol> + Kontext "XMLFilterSettings" + FilterList.TypeKeys "<HOME>" + for ic = 1 to iCountOfXSLTStylesAfterInstallCheck + Kontext "XMLFilterSettings" + sleep(1) + 'read the filter names from the dialog. + sTempReadFilterName = FilterList.GetItemText(ic) + 'lower case comparison! + sTempReadFilterName = lcase(sTempReadFilterName) + if InStr(sTempReadFilterName , sWhichFilterToUse) <> 0 then + FilterList.TypeKeys "<DOWN> " , ic-1 + ' printlog "DEBUG: Filtername: " & FilterList.GetItemText(ic) + sleep(1) + end if + next ic + for ia = 1 to 2 + Kontext "XMLFilterSettings" + select case ia + case 1 : printlog "+- New" + NewBtn.Click + case 2 : printlog "+- Edit" + EditBtn.Click + end select + sleep(1) + Kontext "XMLFilter" + if XMLFilter.Exists(2) then + select case ia + case 1 : printlog " (XML Filter: New)" + case 2 : printlog " (XML Filter: Edit)" + end select + call Dialogtest (XMLFilter) + Tabcontrol.SetPage TabXMLGeneral + Kontext "TabXMLGeneral" + printlog " +- TabXMLGeneral" + if ia = 1 then + '/// If the "New"-button has been used: + call Dialogtest (TabXMLGeneral) + iApplicationEntries = Application.GetItemCount + '///+ <ul><li>Checking the count of applications. Should be 8.</li></ul> + printlog " Checking the count of applications. Should be 8." + if iApplicationEntries <> 8 then + warnlog " +- There should be 8 applications listed in the 'Application'-listbox but there are " & iApplicationEntries & " available!" + else + printlog " +- 8 applications listed in 'Application' listbox." + end if + end if + Kontext "XMLFilter" + Tabcontrol.SetPage TabXMLTransformation + Kontext "TabXMLTransformation" + printlog " +- TabXMLTransformation" + call Dialogtest (TabXMLTransformation) + '/// On tab page "Transformation" press all "Browse"-buttons. + printlog " +- On tab page 'Transformation' press all 'Browse'-buttons." + for ib = 1 to 4 + Kontext "TabXMLTransformation" + select case ib + case 1 : printlog " +- Browse button 'DTD'" + DTDBrowse.Click + case 2 : printlog " +- Browse button 'XSLT for export'" + XSLTForExportBrowse.Click + case 3 : printlog " +- Browse button 'XSLT for import'" + XSLTForImportBrowse.Click + case 4 : printlog " +- Browse button 'Template for import'" + BrowseTemplateForImport.Click + end select + sleep(2) + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(1) then + '/// After every click on "Browse"-button an "FileOpen"-dialog shoud be visible. Cancel that dialog. + printlog " +- After every click on 'Browse'-button an 'FileOpen'-dialog shoud be visible. Cancel that dialog." + call Dialogtest (OeffnenDlg) + OeffnenDlg.Cancel + sleep(3) + else + warnlog sErrorPointerTextForResultfile & "File Open dialog did not appeared." + end if + next ib + '/// [Loop end] + Kontext "XMLFilter" + printlog " +- Closing 'XML Filter: New Filter'-dialog." + XMLFilter.Cancel + '/// Closing "XML Filter: New Filter"-dialog + else + warnlog "XML Filter dialog did not appeared!" + end if + next ia + Kontext "XMLFilterSettings" + '/// Clicking "Test XLSTs"-button. + printlog "+- Clicking 'Test XLSTs'-button." + TestXSLTs.Click + sleep(1) + 'If it's an Import filter it makes no sense to test the export. + if sWhichFilterToUse = "docbook" then + printlog "+- E X P O R T (Writer, Impress)" + Kontext "TestXMLFilter" + if TestXMLFilter.Exists(1) then + call Dialogtest(TestXMLFilter) + else + warnlog sErrorPointerTextForResultfile & "Testing of the XML filter not possible. Exiting." + Kontext "XMLFilterSettings" + '/// Closing the "XML Filter Settings"-dialog. + printlog "+- Closing the 'XML Filter Settings'-dialog." + 'Deinstall the XSLT stylesheet if this routine has + 'added one at the beginning. + if bREMOVEXSLT = TRUE then + call sRemoveXSLTFilter + end if + Kontext "XMLFilterSettings" + CloseBtn.Click + '/// Closing the opened application document. + printlog "- Closing the opened application document." + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + call hCloseDocument + end if + 'Here the routine stops if the test dialog is not opening. + goto endsub + end if + ExportBrowseBtn.Click + '/// Press first "Browse"-button on the "Test XML Filter"-dialog. + printlog " +-Press first 'Browse'-button on the 'Test XML Filter'-dialog." + sleep(2) + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(1) then + call Dialogtest (OeffnenDlg) + OeffnenDlg.Cancel + '/// Closing 'FileOpen'-Dialog. + printlog " +- Closing 'FileOpen'-Dialog." + sleep(3) + else + warnlog sErrorPointerTextForResultfile & "File Open dialog did not occoured?!" + end if + Kontext "TestXMLFilter" + '/// If the application is Writer (because the default XSLT stylesheets are only Writer filter). + '///+<ul><li>Clicking on "Current Document"-button.</li></ul> + if gApplication = "WRITER" then + printlog " +- Clicking on 'Current Document'-button." + CurrentDocument.Click + sleep(3) + '/// If Java is not [correctly] installed a messagebox will be shown and the test of the filter will be canceled! + Kontext "Messagebox" + if MessageBox.Exists(2) then + warnlog Messagebox.GetText + try + Messagebox.Cancel + catch + Messagebox.OK + endcatch + else + try + Kontext "XMLFilterOutput" + if XMLFilterOutput.Exists(1) then + '/// "XML Filter Output"-dialog should be visible. + printlog " +- 'XML Filter Output'-dialog should be visible." + call Dialogtest(XMLFilterOutput) + '/// Clicking "Validate"-button. + printlog " +- Clicking 'Validate'-button." + Validate.Click + sleep(2) + '/// Checking that the validate output control is visible inside the window. + printlog " +- Checking that the validate output control is visible inside the window." + if NOT ValidateOutput.isVisible then + warnlog " +- Validate output is not visible!" + end if + '/// Closing "XML Filter Output"-dialog. + printlog " +- Closing 'XML Filter Output'-dialog." + XMLFilterOutput.Close + sleep(2) + else + warnlog sErrorPointerTextForResultfile & "XML Filter Ouput dialog did not occoured." + end if + catch + warnlog "Testing of XSLTs does not work." + endcatch + end if + else + Kontext "TestXMLFilter" + printlog " +- 'Current Document'-button should not be enabled if no !" + if CurrentDocument.IsEnabled then + Kontext "DocumentWriter" + try + DocumentWriter.TypeKeys "A writer document exists!" + catch + QAErrorLog "'Current Document'-button is enabled but a 'Writer' XML filter has been selected! If there's no Writer document (may be in the background) also opened it would be a bug!" + endcatch + end if + end if + end if + printlog "+- I M P O R T" + Kontext "TestXMLFilter" + '/// Clicking "Browse"-button (Import). + printlog " +- Clicking 'Browse'-button (Import)." + ImportBrowseBtn.Click + sleep(2) + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(1) then + call Dialogtest (OeffnenDlg) + '/// Closing "FileOpen"-dialog. + printlog " +- Closing 'FileOpen'-dialog." + OeffnenDlg.Cancel + sleep(3) + else + warnlog sErrorPointerTextForResultfile & "File Open dialog did not occoured?!" + end if + Kontext "TestXMLFilter" + '/// Checking if 'Display Source'-checkbox is checked (should not be!). + printlog " +- Checking if 'Display Source'-checkbox is checked (should not be!)." + if NOT DisplaySource.IsChecked then + DisplaySource.Check + else + warnlog " +- Display source should be NOT checked as default!" + end if + Kontext "TestXMLFilter" + select case sWhichFilterToUse + case "docbook" : '/// If DocBook XML is being tested use a DocBook XML file. + sDocXMLTestFile = ConvertPath(gTestToolPath & "global\input\xml_filter\docbook.xml") + case "word" : '/// If Word XML is being tested use a Word XML file. + sDocXMLTestFile = ConvertPath(gTestToolPath & "global\input\xml_filter\word.xml") + case "excel" : '/// If Excel XML is being tested use a Excel XML file. + sDocXMLTestFile = ConvertPath(gTestToolPath & "global\input\xml_filter\excel.xml") + case "xhtml" : '/// If XHTML is being tested that use a XHTML file. + sDocXMLTestFile = ConvertPath(gTestToolPath & "global\input\xml_filter\xhtml.xhtml") + case else : warnlog sErrorPointerTextForResultfile & "Wrong parameter has been used! Exiting" + Kontext "TestXMLFilter" + '/// Closing the "Test XML Filter"-dialog. + printlog " +- Closing the 'Test XML Filter'-dialog" + CloseBtn.Click + Kontext "XMLFilterSettings" + '/// Closing the "XML Filter Settings"-dialog. + printlog "+- Closing the 'XML Filter Settings'-dialog." + 'Deinstall the XSLT stylesheet if this routine has + 'added one at the beginning. + if bREMOVEXSLT = TRUE then + call sRemoveXSLTFilter + end if + Kontext "XMLFilterSettings" + CloseBtn.Click + '/// Closing the opened application document. + printlog "- Closing the opened application document." + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + Call hCloseDocument + end if + goto endsub + end select + '/// Clicking "Browse"-button (Import) again to test it with the XML file. + printlog " +- Clicking 'Browse'-button (Import) again to test it the XML file." + ImportBrowseBtn.Click + sleep(2) + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(1) then + call Dialogtest (OeffnenDlg) + Dateiname.SetText sDocXMLTestFile + sleep(3) + Oeffnen.Click + sleep(3) + try + ' If Java is not [correctly] installed a messagebox will be shown and the test of the filter will be canceled! + Kontext "Messagebox" + if Messagebox.Exists(2) then + for iCountMsgBox = 1 to 5 + Kontext "Messagebox" + if MessageBox.Exists(2) then + if MessageBox.GetRT = 304 then + if iCountMsgBox = 1 then + warnlog sErrorPointerTextForResultfile & "No output window was visible! Exiting routine!" + endif + QAErrorLog "Dialog (" & iCountMsgBox & "): " & Messagebox.GetText + Messagebox.OK + bJavaBroken = TRUE + if iCountMsgBox > 3 then + warnlog "Instead of 3 times the missing Java RT box will be shown " & iCountMsgBox & " times." + endif + end if + else + exit for + endif + next iCountMsgBox + endif + Kontext "XMLFilterOutput" + if XMLFilterOutput.Exists(3) then + '/// "XML Filter Output"-dialog should be visible. + printlog " +- 'XML Filter Output'-dialog should be visible." + call Dialogtest(XMLFilterOutput) + '/// Clicking "Validate"-button. + printlog " +- Clicking 'Validate'-button." + Validate.Click + sleep(2) + Kontext "Messagebox" + if Messagebox.Exists(2) then + if bJavaBroken then + Messagebox.OK + else + warnlog Messagebox.GetText + Messagebox.OK + endif + endif + '/// Checking that the validate output control is visible inside the window. + printlog " +- Checking that the validate output control is visible inside the window." + Kontext "XMLFilterOutput" + if NOT ValidateOutput.isVisible then + warnlog " +- Validate output is not visible!" + end if + '/// Closing "XML Filter Output"-dialog. + printlog " +- Closing 'XML Filter Output'-dialog." + Kontext "XMLFilterOutput" + XMLFilterOutput.Close + sleep(1) + else + warnlog sErrorPointerTextForResultfile & "No output window was visible! Exiting routine!" + Kontext "TestXMLFilter" + '/// Closing the "Test XML Filter"-dialog. + printlog " +- Closing the 'Test XML Filter'-dialog" + CloseBtn.Click + Kontext "XMLFilterSettings" + '/// Closing the "XML Filter Settings"-dialog. + printlog "+- Closing the 'XML Filter Settings'-dialog." + 'Deinstall the XSLT stylesheet if this routine has + 'added one at the beginning. + if bREMOVEXSLT = TRUE then + call sRemoveXSLTFilter + end if + Kontext "XMLFilterSettings" + CloseBtn.Click + '/// Closing the opened application document. + printlog "- Closing the opened application document." + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + call hCloseDocument + end if + 'Here the routine stops if there is no Java installed or the output was not visible. + goto endsub + end if + catch + '/// If Java is not [correctly] installed a messagebox will be shown and the test of the filter will be canceled! + Kontext "Messagebox" + if MessageBox.Exists(2) then + warnlog Messagebox.GetText + Messagebox.OK + warnlog sErrorPointerTextForResultfile & "Java is not usable! Exiting routine!" + Kontext "TestXMLFilter" + '/// Closing the "Test XML Filter"-dialog. + printlog " +- Closing the 'Test XML Filter'-dialog" + CloseBtn.Click + Kontext "XMLFilterSettings" + '/// Closing the "XML Filter Settings"-dialog. + printlog "+- Closing the 'XML Filter Settings'-dialog." + 'Deinstall the XSLT stylesheet if this routine has + 'added one at the beginning. + if bREMOVEXSLT = TRUE then + call sRemoveXSLTFilter + end if + Kontext "XMLFilterSettings" + CloseBtn.Click + '/// Closing the opened application document. + printlog "- Closing the opened application document." + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + call hCloseDocument + end if + goto endsub + end if + endcatch + else + warnlog sErrorPointerTextForResultfile & "File Open dialog missing! Not able to load test documents. Exiting routine!" + Kontext "TestXMLFilter" + '/// Closing the "Test XML Filter"-dialog. + printlog " +- Closing the 'Test XML Filter'-dialog" + CloseBtn.Click + Kontext "XMLFilterSettings" + '/// Closing the "XML Filter Settings"-dialog. + printlog "+- Closing the 'XML Filter Settings'-dialog." + 'Deinstall the XSLT stylesheet if this routine has + 'added one at the beginning. + if bREMOVEXSLT = TRUE then + call sRemoveXSLTFilter + end if + Kontext "XMLFilterSettings" + CloseBtn.Click + '/// Closing the opened application document. + printlog "- Closing the opened application document." + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + call hCloseDocument + end if + goto endsub + end if + '/// Closing the tested XML document + printlog " +- Closing the tested XML document" + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + call hCloseDocument + else + QAErrorLog "#i27370# Normaly there should be a second document but there is none!" + end if + sleep(1) + Kontext "TestXMLFilter" + if bJavaBroken = FALSE then + '/// Clicking on "Recent File"-Button. + printlog " +- Clicking on 'Recent File'-Button." + RecentFile.Click + Kontext "XMLFilterOutput" + '/// "XML Filter Output"-dialog should be visible. + printlog " +- 'XML Filter Output'-dialog should be visible." + Kontext "XMLFilterOutput" + '/// Closing "XML Filter Output"-dialog. + printlog " +- Closing 'XML Filter Output'-dialog." + XMLFilterOutput.Close + sleep(1) + '/// Closing the tested XML document + printlog " +- Closing the tested XML document" + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + call hCloseDocument + else + QAErrorLog "#i27370# Normaly there should be a second document but there is none!" + end if + sleep(1) + Kontext "TestXMLFilter" + '/// Closing the "Test XML Filter"-dialog. + printlog " +- Closing the 'Test XML Filter'-dialog" + endif + CloseBtn.Click + Kontext "XMLFilterSettings" + '/// Clicking "Delete"-button. + printlog " +- Clicking 'Delete'-button" + DeleteBtn.Click + Kontext + if Active.Exists(1) then + if Active.GetRT = 304 then + Active.No + end if + end if + Kontext "XMLFilterSettings" + '/// Clicking 'Save to Package'-button. + printlog " +- Clicking 'Save to Package'-button." + SaveToPackage.Click + sleep(2) + Kontext "SpeichernDlg" + if SpeichernDlg.Exists(1) then + call Dialogtest(SpeichernDlg) + SpeichernDlg.Cancel + '/// Closing 'File Save As'-Dialog. + printlog " +- Closing 'File Save As'-Dialog." + else + warnlog sErrorPointerTextForResultfile & "Save As dialog missing!" + end if + Kontext "XMLFilterSettings" + '/// Clicking 'Open Package'-button. + printlog " +- Clicking 'Open Package'-button." + OpenPackage.Click + sleep(2) + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(1) then + call Dialogtest(OeffnenDlg) + OeffnenDlg.Cancel + '/// Closing 'FileOpen'-Dialog. + printlog " +- Closing 'FileOpen'-Dialog." + else + warnlog sErrorPointerTextForResultfile & "File open dialog missing!" + end if + Kontext "XMLFilterSettings" + '/// Closing the "XML Filter Settings"-dialog. + printlog "+- Closing the 'XML Filter Settings'-dialog." + 'Deinstall the XSLT stylesheet if this routine has + 'added one at the beginning. + if bREMOVEXSLT = TRUE then + call sRemoveXSLTFilter + end if + Kontext "XMLFilterSettings" + CloseBtn.Click + '/// Closing the opened application document. + printlog "- Closing the opened application document." + '/// ...if there is more than 1 document opened. + if GetDocumentCount > 1 then + call hCloseDocument + else + QAErrorLog "#i27370# Normaly there should be a second document but there is none!" + end if +endcase + +'------------------------------------------------------------------------- + +sub fInitialXMLSetting( sXMLFilterType as string ) as boolean +'/// This small function adds the latest and greatest XSLT stylesheet +'///+ to the office.<br> +'///+ The result is TRUE if the packages are already available or if they +'///+ have been installed successfully in this routine. +'/// <u>Input</u>: excel, word, docbook, xhtml +'/// <u>Output</u>: TRUE or FALSE + Dim iCountOfDefaultXSLTStyles as integer + Dim iSecondCountOfDefaultXSLTStyles as integer + Dim sFilterPackagePath as string + Dim sTempReadFilterName as string + Dim ia as integer + + 'Setting boolean to FALSE + fInitialXMLSetting = FALSE + '/// Opening new document. + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: Opening new " & gApplication & " document." + call hNewDocument + '/// Calling the menu item <i>Tools -> XML Filter Settings</i> + ToolsXMLFilterSettings + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: Opening the XML Filter Settings dialog." + Kontext "XMLFilterSettings" + call Dialogtest (XMLFilterSettings) + '/// Checking if there are any XSLT stylesheets available. + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: Checking if there are any XSLT stylesheets available." + iCountOfDefaultXSLTStyles = FilterList.GetItemCount + ' printlog "DEBUG (a): " & iCountOfDefaultXSLTStyles + if iCountOfDefaultXSLTStyles <> 0 then + '/// Check if the same filter already exists. + 'Using lowercased input parameter. + sXMLFilterType = lcase(sXMLFilterType) + for ia = 1 to iCountOfDefaultXSLTStyles + Kontext "XMLFilterSettings" + 'read the filter names from the dialog. + sTempReadFilterName = FilterList.GetItemText(ia) + ' printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: DEBUG: (" & ia & ") " & sTempReadFilterName + 'lower case comparison! + sTempReadFilterName = lcase(sTempReadFilterName) + 'if a _part_ of the filtername matches the readed filter name the criteria is true! + if InStr(sTempReadFilterName , sXMLFilterType) <> 0 then + fInitialXMLSetting = TRUE + Kontext "XMLFilterSettings" + CloseBtn.Click + Call hCloseDocument + exit sub + end if + next ia + 'if no filter name maches the for...next loop will be left + 'and the same routine as used for 0 filter installed will + 'be used to install a filter package. + end if + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: The XML filter is not available: Adding the " & sXMLFilterType & " XML filter." + '///+ The packages will be used from "qatesttool/global/input/xslt_stylesheets/*.jar" + ' printlog "DEBUG: " & sXMLFilterType + select case sXMLFilterType + case "excel" : sFilterPackagePath = ConvertPath(gTestToolPath & "global\input\xslt_stylesheets\excel.jar") + case "word" : sFilterPackagePath = ConvertPath(gTestToolPath & "global\input\xslt_stylesheets\word.jar") + case "docbook" : sFilterPackagePath = ConvertPath(gTestToolPath & "global\input\xslt_stylesheets\docbook.jar") + case "xhtml" : sFilterPackagePath = ConvertPath(gTestToolPath & "global\input\xslt_stylesheets\xhtml.jar") + end select + OpenPackage.Click + Kontext "OeffnenDlg" + call Dialogtest (OeffnenDlg) + Dateiname.SetText sFilterPackagePath + sleep(3) + Oeffnen.Click + sleep(3) + Kontext + if Active.Exists(3) then + if Active.GetRT = 304 then + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: " & Active.GetText + Active.OK + Kontext "XMLFilterSettings" + iSecondCountOfDefaultXSLTStyles = FilterList.GetItemCount + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: Checking again the count of installed XSLT stylesheets." + if iSecondCountOfDefaultXSLTStyles <> (iCountOfDefaultXSLTStyles+1) then + warnlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: It was not possible to add " & sXMLFilterType & "-XML filter!" + warnlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: Test aborted!" + exit sub + else + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: XML filter has been installed!" + fInitialXMLSetting = TRUE + end if + end if + end if + Kontext "XMLFilterSettings" + '/// Closing the XML Filter Settings-dialog. + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: Closing the 'XML Filter Settings'-dialog." + CloseBtn.Click + '/// Closing the opened application document. + printlog "global::tools::inc::t_xml_filter1,inc::fInitialXMLSetting: Closing the opened application document." + call hCloseDocument +end sub + +'------------------------------------------------------------------------- + +sub sRemoveXSLTFilter + Dim sXMLFilterType as string + Dim iCountOfDefaultXSLTStyles as integer + Dim ia as integer + Dim sTempReadFilterName as string + Kontext "XMLFilterSettings" + select case lcase(gApplication) + case "calc" : sXMLFilterType = "excel" + case "writer" : sXMLFilterType = "word" + case else : sXMLFilterType = "docbook" + end select + iCountOfDefaultXSLTStyles = FilterList.GetItemCount + if iCountOfDefaultXSLTStyles <> 0 then + '/// Search for the filter in filter list. + 'Using lowercased input parameter. + for ia = 1 to iCountOfDefaultXSLTStyles + Kontext "XMLFilterSettings" + 'read the filter names from the dialog. + sTempReadFilterName = FilterList.GetItemText(ia) + 'lower case comparison! + if InStr(sTempReadFilterName , sXMLFilterType) <> 0 then + '/// If the filter has been found delete it. + FilterList.TypeKeys "<HOME>" + sleep(1) + FilterList.TypeKeys "<DOWN>" , (ia-1) + sleep(1) + DeleteBtn.Click + Kontext + if Active.Exists(1) then + if Active.GetRT = 304 then + Active.Yes + end if + end if + exit sub + end if + next ia + else + warnlog "The count of XML filters has to be >0! Problem?" + end if +end sub + diff --git a/testautomation/global/tools/includes/required/t_dir.inc b/testautomation/global/tools/includes/required/t_dir.inc new file mode 100755 index 000000000000..7d140961bd7e --- /dev/null +++ b/testautomation/global/tools/includes/required/t_dir.inc @@ -0,0 +1,396 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_dir.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : functions for directories and files; execution happens in the office +'* +'****************************************************************** +' #1 hFileExists +' #1 hDirectoryExists +' #1 hKillFile +' #1 DirNameList +' #1 GetFileNameList +' #1 GetFileList +' #1 GetDirList +' #1 GetAllDirList +' #1 GetAllFileList +' #1 KillFileList +' #1 KillDirList +' #1 PfadExtract +' #1 hPfadname +' #1 DateiExtract +' #1 DateiOhneExt +' #1 GetExtention +'\************************************************************************ + +function hFileExists ( Dat as String ) as Boolean +'/// Checks if a file exists +'/// <u>Input</u>: Filename with complete path +'/// <u>Return</u>: TRUE or FALSE if the file exists. + if app.Dir ( Dat ) = "" then + hFileExists = FALSE + else + hFileExists = TRUE + end if +end function +' +'------------------------------------------------------------------------------- +' +function hDirectoryExists ( Verz as String ) as Boolean +'/// Checks if a directory exists +'/// <u>Input</u>: Directory with complete path +'/// <u>Return</u>: TRUE or FALSE if the directory exists. + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + if right ( Verz, 1 ) <> gPathSigne then Verz = Verz + gPathsigne + if app.Dir ( Verz, 16 ) = "" then + hDirectoryExists = FALSE + else + hDirectoryExists = TRUE + end if +end function +' +'------------------------------------------------------------------------------- +' +function hKillFile ( Dat as String ) as Boolean +'/// Delete a file +'/// <u>Input</u>: File with complete path +'/// <u>Return</u>: TRUE or FALSE success on deleting? + if app.Dir ( Dat ) <> "" then + try + app.kill ( Dat ) + catch + endcatch + if app.Dir ( Dat ) <> "" then + hKillFile = FALSE + else + hKillFile = TRUE + end if + else + hKillFile = TRUE + end if +end function +' +'------------------------------------------------------------------------------- +' +function DirNameList (ByVal sPfad$ , lsDirName() as String ) as Integer +'/// seperate a path in its parts +'/// <u>Input</u>: Path to seperate; Empty list, because it get's reset in this function!; +'/// <u>Return</u>: Number on entries in the list; list with entries + Dim i% : Dim Pos% + lsDirName(0) = 0 + do + Pos% = InStr(1, sPfad$, gPathsigne ) ' got a part of teh path + i% = Val(lsDirName(0) ) + 1 + lsDirName(0) = i% + lsDirName( i% ) = Left( sPfad$, Pos% ) ' .. put into list + sPfad = Mid( sPfad$, Pos% + 1 ) ' ...cut off + loop while Pos%>0 + lsDirName( i% ) = sPfad$ + DirNameList = i% ' count of +end function +' +'------------------------------------------------------------------------------- +' +function GetFileNameList ( sPath$, sMatch$ ,lsFile() as String ) as integer +'/// Get files from a directory that match the pattern and append them to a list (without path) +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; List +'/// <u>Return</u>: count of appended entries; updated list + Dim Count% : Dim Datname as String + Dim i as Integer + Count% = 0 + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne + Datname = app.Dir( sPath$ + sMatch$ , 0) ' 0: normal files + for i=1 to 5 + if Right ( Datname, 1 ) = "." then + Datname = app.Dir + else + i=10 + end if + next i + + do until Len(Datname) = 0 + Count% = Count% + 1 + lsFile(Count%) = Datname ' append + lsFile(0) = Count% + Datname = app.Dir + loop + + GetFileNameList = Count% ' All files +end function +' +'------------------------------------------------------------------------------- +' +function GetFileList ( sPath$, sMatch$ ,lsFile() as String ) as integer +'/// Get files from a directory that match the pattern and append them to a list (<b>with</b> path) +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; List +'/// <u>Return</u>: count of appended entries; updated list + Dim Count% : Dim Datname as String + Dim i as Integer + Count% = 0 + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne + Datname = app.Dir( sPath$ + sMatch$ , 0) + for i=1 to 5 + if Right ( Datname, 1 ) = "." then + Datname = app.Dir + else + i=10 + end if + next i + + do until Len(Datname) = 0 + lsFile(0) = Val(lsFile(0)) + 1 + lsFile( lsFile(0) ) =sPath$ + Datname + Count% = Count% + 1 + + ' if the number of files in the directory exceeds the arraysize do not + ' crash but try to handle the situation gracefully. Of course this + ' makes the testresults worthless... + if ( Count% = ubound( lsFile() ) ) then + warnlog ( "List of files exceeds bounds of array." ) + printlog( "Processing of this directory will be discontinued." ) + printlog( "Last processed file was: " & Datname ) + printlog( "Arraysize is: " & ubound( lsFile() ) ) + Datname = "" + else + Datname = app.Dir + endif + loop + GetFileList = Count% +end function +' +'------------------------------------------------------------------------------- +' +function GetDirList ( sPath$, sMatch$ ,lsFile() as String ) as integer +'/// Get Subdirectories from a directory and append them to a list (<b>with</b> path) +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *; List +'/// <u>Return</u>: count of appended entries; updated list + Dim Count% + Dim i as Integer + Dim Verzeichnis as String + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne + Verzeichnis = app.Dir( sPath$ + sMatch$ , 16) + Count% = 0 + + do until Len(Verzeichnis) = 0 + if Verzeichnis <> "." AND Verzeichnis <> ".." then + lsFile(0) = Val(lsFile(0)) + 1 + lsFile( lsFile(0) ) = sPath$ + Verzeichnis + gPathSigne + Count% = Count% + 1 + end if + Verzeichnis = app.Dir + loop + GetDirList = Count% +end function +' +'------------------------------------------------------------------------------- +' +function GetAllDirList ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer +'/// Get all directorys recursiv that match the pattern and append them to a list +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *; Empty list, because it get's reset in this function!; +'/// <u>Return</u>: Count of appended entries (1. entry is the whole path); updated list + Dim Count% : Dim DirCount% + + DirCount% = 1 ' dummy + Count% = 1 + lsFile(0) = 1 'new list + lsFile(1) = sPath$ 'first path is the called path + + do until Count%>Val(lsFile(0)) ' get count of 1.generation + DirCount% = GetDirList( lsFile(Count%) , sMatch$, lsFile() ) ' append all subdirectories + Count% = Count% +1 + loop + + GetAllDirList = Count% - 1 ' count of... +end function +' +'------------------------------------------------------------------------------- +' +function GetAllFileList ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer +'/// Get all Files recursiv (including in subdirectories) that match the pattern and append them to a list +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; Empty list, because it get's reset in this function!; +'/// <u>Return</u>: Count of appended entries (1. entry is the whole path); updated list + Dim DirCount% : Dim FileCount% : Dim Count% + Dim lsDir(1000) as String + + DirCount% = GetAllDirList( sPath$, "*", lsDir() ) ' erstmal _alle_ Verzeichnisse + FileCount% = 0 + lsFile(0) = 1 + lsFile(1) = sPath$ + + For Count% = 1 to Val( lsDir(0) ) + FileCount% = FileCount% + GetFileList( lsDir( Count% ), sMatch$, lsFile() ) + next Count% + + GetAllFileList = FileCount% ' Anzahl aller Dateien +end function +' +'------------------------------------------------------------------------------- +' +function KillFileList ( lsList() as String ) as Boolean +'/// Delete all files in the list +'/// <u>Input</u>: List with files +'/// <u>Return</u>: TRUE or FALSE if files are killed; modified list with not deleted files. + Dim i as Integer + Dim FehlerListe ( 1000 ) as String + + FehlerListe ( 0 ) = 0 + for i=1 to ListCount ( lsList() ) + try + app.kill ( lsList(i) ) + catch + ListAppend ( FehlerListe (), lsList(i) ) + endcatch + next i + + lsList(0) = 0 ' delete old list + KillFileList = TRUE + for i=1 to ListCount ( FehlerListe () ) + KillFileList = FALSE + ListAppend ( lsList(), FehlerListe (i) ) + next i +end function +' +'------------------------------------------------------------------------------- +' +function KillDirList ( lsList() as String ) as Boolean +'/// Delete all directories in the list +'/// <u>Input</u>: List with directories +'/// <u>Return</u>: TRUE or FALSE if directories are killed; modified list with not deleted directories. + Dim i as Integer + Dim FehlerListe ( 1000 ) as String + + FehlerListe ( 0 ) = 0 + for i=1 to ListCount ( lsList() ) + try + app.rmDir ( lsList(i) ) + catch + ListAppend ( FehlerListe (), lsList(i) ) + endcatch + next i + + lsList(0) = 0 ' delete old list + KillDirList = TRUE + for i=1 to ListCount ( FehlerListe () ) + KillDirList = FALSE + ListAppend ( lsList(), FehlerListe (i) ) + next i +end function +' +'------------------------------------------------------------------------------- +' +function PfadExtract ( sFiledat$ ) as string +'/// Get the path from a file +'/// <u>Input</u>: file with path +'/// <u>Return</u>: path without the filename + Dim s$ : Dim i% : Dim k% + dim ls(25) as String + + s$ = "" + i% = DirNameList( sFileDat$, ls() ) + k% = 2 + do until K%>=i% + ls( 1 ) = ls( 1 ) + ls(k%) + k% = k% +1 + loop + PfadExtract = Left( ls(1), Len(ls( 1 ))-1) +end function +' +'------------------------------------------------------------------------------- +' +function hPfadname (Dateipfad$) as string +'/// Get the path from a file +'/// <u>Input</u>: file with path +'/// <u>Return</u>: path without the filename + dim wh as integer + + for wh = len(Dateipfad$) to 1 step -1 + if mid(Dateipfad$,wh,1) = gPathSigne then + hpfadname = left(Dateipfad$,wh) + exit for + else + hpfadname = Dateipfad$ + end if + next wh +end function +' +'------------------------------------------------------------------------------- +' +function DateiExtract ( sFileDat$ ) +'/// Get the filename from a path +'/// <u>Input</u>: path with file +'/// <u>Return</u>: filename without the path + Dim i% + dim ls(20) as String + + i% = DirNameList( sFileDat$, ls() ) + DateiExtract = ls(i%) +end function +' +'------------------------------------------------------------------------------- +' +function DateiOhneExt (Datei$) as String +'/// Get the filename without the extension +'/// <u>Input</u>: filename +'/// <u>Return</u>: filename without the extension + Dim wh as Integer + Dim dummy as String + + dummy = Datei$ + for wh = 1 to len(dummy) + if mid(dummy,wh,1) = "." then + dummy = left(dummy,wh - 1) + wh = len(dummy) + 1 + else + dummy = dummy + end if + next wh + DateiOhneExt = dummy +end function +' +'------------------------------------------------------------------------------- +' +function GetExtention ( Datei as String ) as string +'/// Get the extension from a file +'/// <u>Input</u>: filename +'/// <u>Return</u>: extension of the file + Dim i% + for i% = 1 to len ( Datei ) + if mid(Datei,i%,1) = "." then Datei = right( Datei, len(Datei)-i%) + next i% + GetExtention = Datei +end function + diff --git a/testautomation/global/tools/includes/required/t_dirloc.inc b/testautomation/global/tools/includes/required/t_dirloc.inc new file mode 100755 index 000000000000..79a17525615e --- /dev/null +++ b/testautomation/global/tools/includes/required/t_dirloc.inc @@ -0,0 +1,307 @@ +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_dirloc.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : functions for directories and files; execution happens in the testtool +'* +'************************************************************************* +' #1 hFileExistsLocal +' #1 hDirectoryExistsLocal +' #1 hKillFileLocal +' #1 DirNameListLocal +' #1 GetFileNameListLocal +' #1 GetFileListLocal +' #1 GetDirListLocal +' #1 GetAllDirListLocal +' #1 GetAllFileListLocal +' #1 KillFileListLocal +' #1 KillDirListLocal +' #1 GetFileSizesLocal +'\************************************************************************ + +function hFileExistsLocal ( Dat as String ) as Boolean +'/// Checks if a file exists +'/// <u>Input</u>: Filename with complete path +'/// <u>Return</u>: TRUE or FALSE if the file exists. + if Dir ( Dat ) = "" then + hFileExistsLocal = FALSE + else + hFileExistsLocal = TRUE + end if +end function +' +'------------------------------------------------------------------------------- +' +function hDirectoryExistsLocal ( Verz as String ) as Boolean +'/// Checks if a directory exists +'/// <u>Input</u>: Directory with complete path +'/// <u>Return</u>: TRUE or FALSE if the directory exists. + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + if right ( Verz, 1 ) <> gPathSigne then Verz = Verz + gPathSigne + if Dir ( Verz, 16 ) = "" then + hDirectoryExistsLocal = FALSE + else + hDirectoryExistsLocal = TRUE + end if +end function +' +'------------------------------------------------------------------------------- +' +function hKillFileLocal ( Dat as String ) as Boolean +'/// Delete a file +'/// <u>Input</u>: File with complete path +'/// <u>Return</u>: TRUE or FALSE success on deleting? + if Dir ( Dat ) <> "" then + try + kill ( Dat ) + catch + endcatch + if Dir ( Dat ) <> "" then + hKillFileLocal = FALSE + else + hKillFileLocal = TRUE + end if + else + hKillFileLocal = TRUE + end if +end function +' +'------------------------------------------------------------------------------- +' +function DirNameListLocal (ByVal sPfad$ , lsDirName() as String ) as Integer +'/// seperate a path in its parts +'/// <u>Input</u>: Path to seperate; Empty list, because it get's reset in this function!; +'/// <u>Return</u>: Number on entries in the list; list with entries + Dim i% + Dim Pos% + + lsDirName(0) = 0 + do + Pos% = InStr(1, sPfad$, "\") ' got a path + i% = Val(lsDirName(0) ) + 1 + lsDirName(0) = i% + lsDirName( i% ) = Left( sPfad$, Pos% ) ' .. put in list + sPfad = Mid( sPfad$, Pos% + 1 ) ' ...cut off + loop while Pos%>0 + lsDirName( i% ) = sPfad$ + DirNameListLocal = i% ' count of +end function +' +'------------------------------------------------------------------------------- +' +function GetFileNameListLocal ( sPath$, sMatch$ ,lsFile() as String ) as integer +'/// Get files from a directory that match the pattern and append them to a list (without path) +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; List +'/// <u>Return</u>: count of appended entries; updated list + Dim Count% + Dim Datname as String + + Count% = 0 + + if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + Datname = Dir( sPath$ + sMatch$ , 0) + + do until Len(Datname) = 0 + Count% = Count% + 1 + lsFile(Count%) = Datname ' append + lsFile(0) = Count% + Datname = Dir + loop + + GetFileNameListLocal = Count% ' all files +end function +' +'------------------------------------------------------------------------------- +' +function GetFileListLocal ( sPath$, sMatch$ ,lsFile() as String ) as integer +'/// Get files from a directory that match the pattern and append them to a list (<b>with</b> path) +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; List +'/// <u>Return</u>: count of appended entries; updated list + Dim Count% + Dim Datname as String + + Count% = 0 + + if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + Datname = Dir( sPath$ + sMatch$ , 0) + + do until Len(Datname) = 0 + lsFile(0) = Val(lsFile(0)) + 1 + lsFile( lsFile(0) ) =sPath$ + Datname + Count% = Count% + 1 + Datname = Dir + loop + GetFileListLocal = Count% +end function +' +'------------------------------------------------------------------------------- +' +function GetDirListLocal ( sPath$, sMatch$ ,lsFile() as String ) as integer +'/// Get Subdirectories from a directory and append them to a list (<b>with</b> path) +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *; List +'/// <u>Return</u>: count of appended entries; updated list + Dim Count% + Dim Verzeichnis as String + + if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne + ' at the end of the string has to be teh path seperator, else the dir-command doesn't work + Verzeichnis = Dir( sPath$ + sMatch$ , 16) + Count% = 0 + + do until Len(Verzeichnis) = 0 + if Verzeichnis <>"." AND Verzeichnis <> ".." then + lsFile(0) = Val(lsFile(0)) + 1 + lsFile( lsFile(0) ) = sPath$ + Verzeichnis + gPathSigne + Count% = Count% + 1 + end if + Verzeichnis = Dir + loop + + GetDirListLocal = Count% +end function +' +'------------------------------------------------------------------------------- +' +function GetAllDirListLocal ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer +'/// Get all directorys recursiv that match the pattern and append them to a list +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *; Empty list, because it get's reset in this function!; +'/// <u>Return</u>: Count of appended entries (1. entry is the whole path); updated list + Dim Count% : Dim DirCount% + + DirCount% = 1 ' dummy + Count% = 1 + lsFile(0) = 1 'new list + lsFile(1) = sPath$ 'first path is the calling path + + do until Count%>Val(lsFile(0)) ' get first generation + DirCount% = GetDirListLocal ( lsFile(Count%) , sMatch$, lsFile() ) ' append all subdirectories + Count% = Count% +1 + loop + + GetAllDirListLocal = Count% - 1 ' count of listelements +end function +' +'------------------------------------------------------------------------------- +' +function GetAllFileListLocal ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer +'/// Get all Files recursiv (including in subdirectories) that match the pattern and append them to a list +'/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; Empty list, because it get's reset in this function!; +'/// <u>Return</u>: Count of appended entries (1. entry is the whole path); updated list + Dim DirCount% : Dim FileCount% : Dim Count% + Dim lsDir(1000) as String + + DirCount% = GetAllDirListLocal ( sPath$, "*", lsDir() ) ' just all directories + FileCount% = 0 + lsFile(0) = 1 + lsFile(1) = sPath$ + + For Count% = 1 to Val( lsDir(0) ) + FileCount% = FileCount% + GetFileListLocal ( lsDir( Count% ), sMatch$, lsFile() ) + next Count% + + GetAllFileListLocal = FileCount% ' count of files +end function +' +'------------------------------------------------------------------------------- +' +function KillFileListLocal ( lsList() as String ) as Boolean +'/// Delete all files in the list +'/// <u>Input</u>: List with files +'/// <u>Return</u>: TRUE or FALSE if files are killed; modified list with not deleted files. + Dim i as Integer + Dim FehlerListe ( 1000 ) as String + + FehlerListe ( 0 ) = 0 + for i=1 to ListCount ( lsList() ) + try + kill ( lsList(i) ) + catch + ListAppend ( FehlerListe (), lsList(i) ) + endcatch + next i + + lsList(0) = 0 ' delete old list + KillFileListLocal = TRUE + for i=1 to ListCount ( FehlerListe () ) + KillFileListLocal = FALSE + ListAppend ( lsList(), FehlerListe (i) ) + next i +end function +' +'------------------------------------------------------------------------------- +' +function KillDirListLocal ( lsList() as String ) as Boolean +'/// Delete all directories in the list +'/// <u>Input</u>: List with directories +'/// <u>Return</u>: TRUE or FALSE if directories are killed; modified list with not deleted directories. + Dim i as Integer + Dim FehlerListe ( 1000 ) as String + + FehlerListe ( 0 ) = 0 + for i=1 to ListCount ( lsList() ) + try + rmDir ( lsList(i) ) + catch + ListAppend ( FehlerListe (), lsList(i) ) + endcatch + next i + + lsList(0) = 0 ' delete old list + KillDirListLocal = TRUE + for i=1 to ListCount ( FehlerListe () ) + KillDirListLocal = FALSE + ListAppend ( lsList(), FehlerListe (i) ) + next i +end function +' +'------------------------------------------------------------------------------- +' +function GetFileSizesLocal ( lsList() as String ) as long +'/// Computes the total Filesize of the files in the list +'/// <u>Input</u>: List with files +'/// <u>Return</u>: Filesize in bytes + Dim iSum + Dim i as Integer + + iSum = 0 + for i=1 to ListCount ( lsList() ) + try + iSum = iSum + FileLen ( lsList(i) ) + catch + endcatch + next i + + GetFileSizesLocal = iSum +end function diff --git a/testautomation/global/tools/includes/required/t_doc1.inc b/testautomation/global/tools/includes/required/t_doc1.inc new file mode 100755 index 000000000000..f21c28b520b9 --- /dev/null +++ b/testautomation/global/tools/includes/required/t_doc1.inc @@ -0,0 +1,611 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_doc1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Global Routines for Document Handling +'* +'*************************************************************************************** +' #1 hCloseAndLooseDocument 'wrn:0|err:0 'Closes a document and accepts the loose of content. +' #1 hOpenFileAndIgnoreMacroWarning +' #1 hCreateLabels +' #1 hCreateBusinessCards +' #1 hNewDocument +' #1 hCloseDocument +' #1 hCloseAndLooseDocument +' #1 gMouseClick +' #1 gMouseDoubleClick +' #1 gMouseMove +' #1 gMouseDown +' #1 gMouseMove2 +' #1 gMouseUp +' #1 hTypeKeys +'\************************************************************************************* + +sub hNewDocument ( optional bANewDoc ) +'/// hNewDocument : open a new document dependent on 'gApplication' ///' + dim sTemp as string + gApplication = Ucase ( gApplication ) + + if IsMissing ( bANewDoc ) <> TRUE then + if bANewDoc = TRUE then + gNoNewDoc = FALSE + else + gNoNewDoc = TRUE + end if + end if + + select case gApplication + case "WRITER", "TEXTDOKUMENT" : Kontext "DocumentWriter" + if gNoNewDoc = TRUE then + FileOpen "FileName", "private:factory/swriter", "SynchronMode", TRUE + else + FileOpen "FileName", "private:factory/swriter", "FrameName", "_default", "SynchronMode", TRUE + end if + case "CALC", "TABELLENDOKUMENT" : Kontext "DocumentCalc" + if gNoNewDoc = TRUE then + FileOpen "FileName", "private:factory/scalc", "SynchronMode", TRUE + else + FileOpen "FileName", "private:factory/scalc", "FrameName", "_default", "SynchronMode", TRUE + end if + case "IMPRESS", "PRAESENTATION" : Kontext "DocumentImpress" + if gNoNewDoc = TRUE then + FileOpen "FileName", "private:factory/simpress", "SynchronMode", TRUE + else + FileOpen "FileName", "private:factory/simpress", "FrameName", "_default", "SynchronMode", TRUE + Kontext "AutoPilotPraesentation1" + if AutoPilotPraesentation1.Exists (2) then + Printlog "------------------------------The Impress-Autopilot was active------------------" + Startwithwizard.Check ' opposite of the checkboxs' title + AutoPilotPraesentation1.OK + Sleep 2 + Kontext "SeitenLayout" + SeitenLayout.Cancel + end if + Kontext "DocumentImpress" + Sleep 2 + end if + case "DRAW", "ZEICHNUNG" : Kontext "DocumentDraw" + if gNoNewDoc = TRUE then + FileOpen "FileName", "private:factory/sdraw", "SynchronMode", TRUE + else + FileOpen "FileName", "private:factory/sdraw", "FrameName", "_default", "SynchronMode", TRUE + end if + case "MASTERDOC", "GLOBALDOKUMENT", "GLOBALDOC" : + Kontext "DocumentMasterDoc" + if gNoNewDoc = TRUE then + FileOpen "FileName", "private:factory/swriter/GlobalDocument", "SynchronMode", TRUE + else + FileOpen "FileName", "private:factory/swriter/GlobalDocument", "FrameName", "_default", "SynchronMode", TRUE + end if + Kontext "Navigator" + sleep (1) + if Navigator.Exists(5) then Navigator.Close + Kontext "DocumentMasterDoc" + case "MATH", "FORMEL" : Kontext "DocumentMath" + if gNoNewDoc = TRUE then + FileOpen "FileName", "private:factory/smath", "SynchronMode", TRUE + else +' FileOpen "FileName", "private:factory/smath", "FrameName", "_blank" + FileOpen "FileName", "private:factory/smath", "FrameName", "_default", "SynchronMode", TRUE + end if + Kontext "DocumentMath" + case "HTML", "HTMLDOKUMENT" : Kontext "DocumentWriterWeb" + if gNoNewDoc = TRUE then + FileOpen "FileName", "private:factory/swriter/web", "SynchronMode", TRUE + else + FileOpen "FileName", "private:factory/swriter/web", "FrameName", "_default", "SynchronMode", TRUE + end if + Kontext "DocumentWriterWeb" + case "BASE", "INSIGHT" : FileOpen "FileName", "private:factory/sdatabase?Interactive", "FrameName", "_default", "SynchronMode", TRUE + Kontext "DatabaseWizard" + if DatabaseWizard.exists(5) then + FinishBtn.click + kontext "SpeichernDlg" + if SpeichernDlg.exists(5) then + if (Dateiname.getSelText = "") then + sTemp = convertPath(gOfficePath + "user/work/hNewDocument.odb") + if fileExists(sTemp) then + app.kill(sTemp) + endif + qaErrorlog "## lost default filename" + Dateiname.setText "hNewDocument" + endif + Speichern.click + Kontext "Insight" + else + warnlog "t_doc1.inc::hNewDocument():: Can't create Database Document 2" + endif + else + warnlog "t_doc1.inc::hNewDocument():: Can't create Database Document 1" + endif + case "BASIC" : ToolsMacroMacro + kontext "makro" + if makro.exists(5) then + MakroAus.typeKeys "<home>" + sTemp = "" + while (NOT bearbeiten.isEnabled) AND (sTemp <> MakroAus.getSelText) + sTemp = MakroAus.getSelText + MakroAus.typeKeys "<down>+" + wend + if (bearbeiten.isEnabled) then + bearbeiten.click + else + qaErrorlog "Can't edit document." + endif + else + warnlog "Can't open Basic IDE." + endif + case else : WarnLog "hNewDocument: No Applikation named '" + gApplication + "' exists in this routine!" + end select + Sleep 2 +end sub +' +'------------------------------------------------------------------------------- +' +function hCreateLabels() as Boolean +'/// hCreateLabels : open the tab-dialog for making a new lable (file/new/lable) ///' + FileOpen "FileName", "private:factory/swriter?slot=21051", "FrameName", "_default", "SynchronMode", TRUE + Sleep (2) + Kontext + Active.Setpage TabEtiketten + Kontext "TabEtiketten" + if Not TabEtiketten.Exists then + Warnlog "Dialog for Labels is not up!" + hCreateLabels = False + else + hCreateLabels = True + endif + Sleep (2) +end function +' +'------------------------------------------------------------------------------- +' +function hCreateBusinessCards() as Boolean +'/// hCreateBusinessCards : open the tab-dialog for making a new business card (file/new/business cards) ///' + FileOpen "FileName", "private:factory/swriter?slot=21052", "FrameName", "_default", "SynchronMode", TRUE + Sleep (2) + Kontext + Active.Setpage TabEtikettenMedium + Kontext "TabEtikettenMedium" + if Not TabEtikettenMedium.Exists then + Warnlog "Dialog for BusinessCards is not up!" + hCreateBusinessCards = False + else + hCreateBusinessCards = True + endif + Sleep (2) +end function +' +'------------------------------------------------------------------------------- +' +sub hCloseDocument ( optional bANewDoc ) +'/// hCloseDocument : close a document without saving ///' +'///+ all documents will be closed without saving ///' + Dim sFehler$ + + if IsMissing ( bANewDoc ) <> TRUE then + if bANewDoc = TRUE then + gNoNewDoc = FALSE + else + gNoNewDoc = TRUE + end if + end if + + ' if no new document was created, it isn't closed + if gNoNewDoc = TRUE then + exit sub + end if + + Sleep 3 + try + FileClose + catch + Exceptlog + exit sub + endcatch + + Sleep 1 + Kontext "Active" + if Active.Exists(2) then + try + Active.No + catch + Active.Click ( 202 ) + endcatch + end if + Sleep (2) +end sub +' +'------------------------------------------------------------------------------- +' +sub hCloseAndLooseDocument +'/// <i>hCloseAndLooseDocument</i> +'///+ Closes a (modified) document and the verify dialog will be answered +'///+ with yes. That means you want to loose format information or you want +'///+ to loose the document! + Dim sFehler$ + + try + FileClose + catch + Exceptlog + exit sub + endcatch + sleep (2) + Kontext + if Active.Exists(2) then Active.Yes +end sub +' +'------------------------------------------------------------------------------- +' +sub gMouseClick ( X%, Y%, optional mb% ) + '/// gMouseClick ( x_Position, y-Position ) : make a mouseclick on the document (dependent on 'gApplication') ///' + '/// default left mousebutton will be used otherwise you can optionally give the mousebutton to press + '/// 1 = left mouse button + '/// 2 = left mouse button + '/// 3 = left mouse button + + gApplication = UCase ( gApplication ) + + if IsMissing(mb%) then mb% = 1 + + select case gApplication + case "DESKTOP" : + Kontext "Desktop" + autoexecute = false + Desktop.MouseDown ( X%, Y%, mb% ) + Desktop.MouseUp ( X%, Y%, mb% ) + autoexecute = true + case "CALC" : + Kontext "DocumentCalc" + autoexecute = false + DocumentCalc.MouseDown ( X%, Y%, mb% ) + DocumentCalc.MouseUp ( X%, Y%, mb% ) + autoexecute = true + case "DRAW" : + Kontext "DocumentDraw" + autoexecute=false + DocumentDraw.MouseDown ( X%, Y%, mb% ) + DocumentDraw.MouseUp ( X%, Y%, mb% ) + autoexecute=true + case "WRITER" : + Kontext "DocumentWriter" + autoexecute=false + DocumentWriter.MouseDown ( X%, Y%, mb% ) + DocumentWriter.MouseUp ( X%, Y%, mb% ) + autoexecute=true + case "HTMLDOKUMENT" : + Kontext "DocumentWriterWeb" + autoexecute=false + DocumentWriterWeb.MouseDown ( X%, Y%, mb% ) + DocumentWriterWeb.MouseUp ( X%, Y%, mb% ) + autoexecute=true + case "MASTERDOC" : + Kontext "DocumentMasterDoc" + autoexecute=false + DocumentMasterDoc.MouseDown ( X%, Y%, mb% ) + DocumentMasterDoc.MouseUp ( X%, Y%, mb% ) + autoexecute=true + case "IMPRESS" : + Kontext "DocumentImpress" + autoexecute=false + DocumentImpress.MouseDown ( X%, Y%, mb% ) + DocumentImpress.MouseUp ( X%, Y%, mb% ) + autoexecute=true + case "MATH" : + Kontext "DocumentMath" + autoexecute=false + DocumentMath.MouseDown ( X%, Y%, mb% ) + DocumentMath.MouseDown ( X%, Y%, mb% ) + autoexecute=true + case "CHART" : + Kontext "DocumentChart" + autoexecute=false + DocumentChart.MouseDown ( X%, Y%, mb% ) + DocumentChart.MouseUp ( X%, Y%, mb% ) + autoexecute=true + end select + sleep (2) +end sub +' +'------------------------------------------------------------------------------- +' +sub gMouseDoubleClick ( X%, Y% ) +'/// gMouseDoubleClick ( x_Position, y-Position ) : make a mouse-doubleclick on the document ( dependent on 'gApplication' ) ///' + gApplication = UCase ( gApplication ) + + select case gApplication + case "CALC" : + Kontext "DocumentCalc" + DocumentCalc.MouseDoubleClick ( X%, Y% ) + case "DRAW" : + Kontext "DocumentDraw" + DocumentDraw.MouseDoubleClick ( X%, Y% ) + case "DESKTOP" : + Kontext "Desktop" + Desktop.MouseDoubleClick ( X%, Y% ) + case "WRITER" : + Kontext "DocumentWriter" + DocumentWriter.MouseDoubleClick ( X%, Y% ) + case "HTMLDOKUMENT" : + Kontext "DocumentWriterWeb" + DocumentWriterWeb.MouseDoubleClick ( X%, Y% ) + case "MASTERDOC" : + Kontext "DocumentMasterDoc" + DocumentMasterDoc.MouseDoubleClick ( X%, Y% ) + case "IMPRESS" : + Kontext "DocumentImpress" + DocumentImpress.MouseDoubleClick ( X%, Y% ) + case "MATH" : + Kontext "DocumentMath" + DocumentMath.MouseDoubleClick ( X%, Y% ) + end select + Sleep (2) +end sub +' +'------------------------------------------------------------------------------- +' +sub gMouseMove ( BeginX%, BeginY%, EndX%, EndY% ) +'/// gMouseMove ( BeginX, BeginY, EndX, EndY ) : make a mousemove trom Bx,By to Ex,Ey on the document ( dependent on 'gApplication' ) ///' + gApplication = UCase ( gApplication ) + + select case gApplication + case "CALC" : + Kontext "DocumentCalc" + DocumentCalc.MouseDown ( BeginX%, BeginY% ) + DocumentCalc.MouseMove ( EndX%, EndY%) + DocumentCalc.MouseUp ( EndX%, EndY% ) + case "DRAW" : + Kontext "DocumentDraw" + DocumentDraw.MouseDown ( BeginX%, BeginY% ) + DocumentDraw.MouseMove ( EndX%, EndY% ) + DocumentDraw.MouseUp ( EndX%, EndY% ) + case "WRITER" : + Kontext "DocumentWriter" + DocumentWriter.MouseDown ( BeginX%, BeginY% ) + DocumentWriter.MouseMove ( EndX%, EndY%) + DocumentWriter.MouseUp ( EndX%, EndY% ) + case "HTMLDOKUMENT" : + Kontext "DocumentWriterWeb" + DocumentWriterWeb.MouseDown ( BeginX%, BeginY% ) + DocumentWriterWeb.MouseMove ( EndX%, EndY%) + DocumentWriterWeb.MouseUp ( EndX%, EndY% ) + case "MASTERDOC" : + Kontext "DocumentMasterDoc" + DocumentMasterDoc.MouseDown ( BeginX%, BeginY% ) + DocumentMasterDoc.MouseMove ( EndX%, EndY%) + DocumentMasterDoc.MouseUp ( EndX%, EndY% ) + case "IMPRESS" : + Kontext "DocumentImpress" + DocumentImpress.MouseDown ( BeginX%, BeginY% ) + DocumentImpress.MouseMove ( EndX%, EndY%) + DocumentImpress.MouseUp ( EndX%, EndY% ) + case "MATH" : + Kontext "DocumentMath" + DocumentMath.MouseDown ( BeginX%, BeginY% ) + DocumentMath.MouseMove ( EndX%, EndY%) + DocumentMath.MouseDown ( EndX%, EndY% ) + end select + Sleep (2) +end sub +' +'------------------------------------------------------------------------------- +' +sub gMouseDown ( BeginX%, BeginY% ) +'/// gMouseDown ( x_Position, y-Position ) : make a mousedown on the document (dependent on 'gApplication') ///' +'///+ DON'T FORGETT to call gMouseUp ! ///' + gApplication = UCase ( gApplication ) + + select case gApplication + case "CALC" : + Kontext "DocumentCalc" + DocumentCalc.MouseDown ( BeginX%, BeginY% ) + case "DRAW" : + Kontext "DocumentDraw" + DocumentDraw.MouseDown ( BeginX%, BeginY% ) + case "WRITER" : + Kontext "DocumentWriter" + DocumentWriter.MouseDown ( BeginX%, BeginY% ) + case "HTMLDOKUMENT" : + Kontext "DocumentWriterWeb" + DocumentWriterWeb.MouseDown ( BeginX%, BeginY% ) + case "MASTERDOC" : + Kontext "DocumentMasterDoc" + DocumentMasterDoc.MouseDown ( BeginX%, BeginY% ) + case "IMPRESS" : + Kontext "DocumentImpress" + DocumentImpress.MouseDown ( BeginX%, BeginY% ) + case "MATH" : + Kontext "DocumentMath" + DocumentMath.MouseDown ( BeginX%, BeginY% ) + end select + Sleep (2) +end sub +' +'------------------------------------------------------------------------------- +' +sub gMouseMove2 ( EndX%, EndY% ) +'/// gMouseMove2 ( x_Position, y-Position ) : move the pointer to position on the document (dependent on 'gApplication') ///' + gApplication = UCase ( gApplication ) + + select case gApplication + case "CALC" : + Kontext "DocumentCalc" + DocumentCalc.MouseMove ( EndX%, EndY%) + case "DRAW" : + Kontext "DocumentDraw" + DocumentDraw.MouseMove ( EndX%, EndY% ) + case "WRITER" : + Kontext "DocumentWriter" + DocumentWriter.MouseMove ( EndX%, EndY%) + case "HTMLDOKUMENT" : + Kontext "DocumentWriterWeb" + DocumentWriterWeb.MouseMove ( EndX%, EndY%) + case "MASTERDOC" : + Kontext "DocumentMasterDoc" + DocumentMasterDoc.MouseMove ( EndX%, EndY%) + case "IMPRESS" : + Kontext "DocumentImpress" + DocumentImpress.MouseMove ( EndX%, EndY%) + case "MATH" : + Kontext "DocumentMath" + DocumentMath.MouseMove ( EndX%, EndY%) + end select + Sleep (2) +end sub +' +'------------------------------------------------------------------------------- +' +sub gMouseUp ( EndX%, EndY% ) +'/// gMouseUp ( x_Position, y-Position ) : make a release button on the document (dependent on 'gApplication') ///' + gApplication = UCase ( gApplication ) + + select case gApplication + case "CALC" : + Kontext "DocumentCalc" + DocumentCalc.MouseUp ( EndX%, EndY% ) + case "DRAW" : + Kontext "DocumentDraw" + DocumentDraw.MouseUp ( EndX%, EndY% ) + case "WRITER" : + Kontext "DocumentWriter" + DocumentWriter.MouseUp ( EndX%, EndY% ) + case "HTMLDOKUMENT" : + Kontext "DocumentWriterWeb" + DocumentWriterWeb.MouseUp ( EndX%, EndY% ) + case "MASTERDOC" : + Kontext "DocumentMasterDoc" + DocumentMasterDoc.MouseUp ( EndX%, EndY% ) + case "IMPRESS" : + Kontext "DocumentImpress" + DocumentImpress.MouseUp ( EndX%, EndY% ) + case "MATH" : + Kontext "DocumentMath" + DocumentMath.MouseUp ( EndX%, EndY% ) + end select + Sleep (2) +end sub +' +'------------------------------------------------------------------------------- +' +sub hTypeKeys ( OutputText , optional iLoop as Integer ) +'/// hTypeKeys ( OutputText , optional iLoop as Integer ): type the keys in 'outputtext' 'iLoop' times ///' + Dim i as integer + + If IsMissing(iLoop) = True then iLoop = 1 + For i = 1 to iLoop + Select Case Ucase(gApplication) + Case "WRITER" + Kontext "DocumentWriter" + DocumentWriter.TypeKeys OutputText + Case "MASTERDOC" + Kontext "DocumentMasterDoc" + DocumentMasterDoc.TypeKeys OutputText + Case "HTMLDOKUMENT" + Kontext "DocumentWriterWeb" + DocumentWriterWeb.TypeKeys OutputText + case "CALC" : + Kontext "DocumentCalc" + DocumentCalc.TypeKeys OutputText + case "DRAW" + Kontext "DocumentDraw" + DocumentDraw.TypeKeys OutputText + case "IMPRESS" + Kontext "DocumentImpress" + DocumentImpress.TypeKeys OutputText + case "MATH" : + Kontext "DocumentMath" + DocumentMath.TypeKeys OutputText + end select + wait 500 + next i +end sub +' +'------------------------------------------------------------------------------- +' +function hOpenFileAndIgnoreMacroWarning (sDocName as string, optional IgnoreW) as Boolean +'/// Loading a (known) document with macro security warning. +'/// If the OPTIONAL parameter is used a PRINTLOG will be written into the result file otherwise a wrning. + Dim i as integer + + 'ConvertPath: Be sure that the path seperators has been set correctly (/ or \). + sDocName = ConvertPath(sDocName) + + hOpenFileAndIgnoreMacroWarning = FALSE + + if hFileExists(sDocName) = FALSE then + warnlog "global::tools::inc::t_doc1.inc::hOpenFileAndIgnoreMacroWarning: '" & sDocName & "' does not exists!" + 'Setting the function to FALSE because file has not been found. + exit function + else + FileOpen + sleep (1) + Kontext "OeffnenDlg" + Dateiname.SetText sDocName + sleep (3) + Oeffnen.Click + sleep(2) + for i = 1 to 2 + ' Since SRC680m?? we have TWO Security Warnings for + ' StarBasic and JavaScript; So this routine needs to + ' run twice. + Kontext "SecurityWarning" + if SecurityWarning.Exists(2) then + if IsMissing(IgnoreW) = FALSE then + printLog "global::tools::inc::t_doc1.inc::hOpenFileAndIgnoreMacroWarning: Securitywarning dialog is visible." + else + warnlog "global::tools::inc::t_doc1.inc::hOpenFileAndIgnoreMacroWarning: Securitywarning dialog is visible" + end if + SecurityWarning.OK + else + if i <> 2 then + QAErrorLog "global::tools::inc::t_doc1.inc::hOpenFileAndIgnoreMacroWarning: No Security warning dialog occured! Document loading aborted." + hOpenFileAndIgnoreMacroWarning = FALSE + exit function + end if + end if + next i + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(1) then + OeffnenDlg.Cancel + warnlog "global::tools::inc::t_doc1.inc::hOpenFileAndIgnoreMacroWarning: The 'FileOpen'-Dialog is open!" + else + ' After the external routine IsItLoaded has been run the return value of this function should be set to TRUE. + if IsItLoaded = TRUE then + hOpenFileAndIgnoreMacroWarning = TRUE + end if + end if + end if +end function + diff --git a/testautomation/global/tools/includes/required/t_doc2.inc b/testautomation/global/tools/includes/required/t_doc2.inc new file mode 100755 index 000000000000..ceb2889b7552 --- /dev/null +++ b/testautomation/global/tools/includes/required/t_doc2.inc @@ -0,0 +1,296 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_doc2.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Global Routines for Document Handling; Part two +'* +'************************************************************************ +' #1 hTabelleEinfuegen +' #1 ZellenMarkieren +' #1 hRechteckErstellen +' #1 hTextrahmenErstellen +' #1 SchreibenInMathdok +' #1 sMakeReadOnlyDocumentEditable +' #1 fSelectFirstOLE 'Selecting the first OLE object +'\*********************************************************************** + +sub hTabelleEinfuegen +'/// <b>WRITER only </b>///' +'/// hTabelleEinfuegen hInsertTable ///' +'/// insert a dummy table in writer/writerweb/masterdocument ///' + TableInsertTable + sleep(2) + Kontext "TabelleEinfuegenWriter" + wait 500 + TabelleEinfuegenWriter.OK + sleep(1) + + Kontext "TableObjectbar" + sleep(1) + if TableObjectbar.NotExists then + Kontext "TextObjectbar" + TextObjectbar.SetNextToolBox + end if + + Select Case gApplication + Case "WRITER" + Kontext "DocumentWriter" + Case "MASTERDOC" + Kontext "DocumentMasterDoc" + Case "HTMLDOKUMENT" + Kontext "DocumentWriterWeb" + end select + sleep(1) +end sub +' +'------------------------------------------------------------------------------- +' +sub ZellenMarkieren ( Down%, Right% ) +'/// <b>CALC only</b> ///' +'/// ZellenMarkieren ( Down%, Right% ) : mark the cells ///' + Dim Anzahl as Integer + + Kontext "DocumentCalc" + Anzahl = Right% - 1 + DocumentCalc.TypeKeys "<Shift Right>", Anzahl + Anzahl = Down% - 1 + DocumentCalc.TypeKeys "<Shift Down>", Anzahl +end sub +' +'------------------------------------------------------------------------------- +' +sub hRechteckErstellen ( BeginX%, BeginY%, EndX%, EndY% ) +'/// <b>IMPRESS/DRAW only</b> ///' +'/// hRechteckErstellen ( BeginX, BeginY, EndX, EndY ) : create a rectangle ///' + WL_DRAW_Rechteck + gMouseMove ( BeginX%, BeginY%, EndX%, EndY% ) +end sub +' +'------------------------------------------------------------------------------- +' +sub hTextrahmenErstellen ( TextEingabe$, BeginX%, BeginY%, EndX%, EndY% ) +'/// <b>IMPRESS/DRAW only</b> ///' +'/// hTextrahmenErstellen ( String, BeginX, BeginY, EndX, EndY ) : create a textbox with a textstring ///' + WL_SD_TextEinfuegenDraw + gMouseMove ( BeginX%, BeginY%, EndX%, EndY% ) + hTypeKeys TextEingabe$ +end sub +' +'------------------------------------------------------------------------------- +' +sub SchreibenInMathdok ( Eingabe as String ) +'/// <b>MATH only</b> ///' +'/// SchreibenInMathDok ( String ) : write text in a mathdocument ( with clipboard ) ///' + if Eingabe <> "Unsinn" then + SetClipboard Eingabe + else + SetClipboard "NROOT <?> <?><over b==<?>" + endif + if (GetClipboard() <> Eingabe) then + warnlog "--No Clipboard available :-(--" + printlog "---ClipTest--- should: "+Eingabe +", is: "+GetClipboard + endif + EditPaste + sleep(3) +end sub +' +'------------------------------------------------------------------------------- +' +sub sMakeReadOnlyDocumentEditable + If IsItLoaded() then + '/// After the document has been loaded... + Kontext "Standardbar" + if Bearbeiten.IsEnabled then + '/// ...check if the button is enabled. + if Bearbeiten.getState(2) = 0 then + '/// Check if the document has been loaded read-only and if yes + Bearbeiten.Click() + '/// click on the 'Edit'-button + sleep (2) + Kontext + if Active.Exists(5) then + '/// If there is a messagebox coming up, click on Yes/OK + Active.Yes + end if + sleep (2) + Kontext + if Active.Exists(1) then + ' Sometimes an messagebox will be opened that the file does + ' not exists. + QAErrorLog Active.GetText + Active.OK + end if + sleep (2) + end if + else + printlog "Document opened with write access." + end if + else + warnlog "The document has not been loaded correctly." + end if +end sub +' +'------------------------------------------------------------------------------- +' +function fSelectFirstOLE() as integer +'Select first visible OLE object using Navigator +'Returns error-code: +'+ 0 := Sucess +'- 1 := unknown application + + dim bNavigatorWasVisible as boolean + bNavigatorWasVisible = FALSE + dim iIndex + + fSelectFirstOLE = -1 + + select case lcase(gApplication) + case "calc" : Kontext "NavigatorCalc" + 'First check if Navigator is visible and remember result + if NavigatorCalc.exists (10) then + bNavigatorWasVisible = TRUE + else + try + 'Invoke Navigator if not visible + EditNavigator + catch + 'If inside chart or elsewhere the call + 'will fail. Again trying the slot after + 'switching to the document. + Kontext "DocumentCalc" + DocumentCalc.TypeKeys "<Escape>" + EditNavigator + endcatch + end if + Kontext "NavigatorCalc" + if NavigatorCalc.exists (10) then + 'Select first OLE in list + Liste.TypeKeys "<HOME>" + for iIndex = 1 to 8 + Liste.TypeKeys "-<DOWN>" + next iIndex + Liste.select(6) + Liste.TypeKeys "+<DOWN><RETURN>" + fSelectFirstOLE = 0 + else + QAErrorLog "Navigator did not occoured!" + end if + case "draw" , "impress" : Kontext "NavigatorDraw" + if NavigatorDraw.Exists(10) then + bNavigatorWasVisible = TRUE + else + try + 'Invoke Navigator if not visible + EditNavigator + catch + 'If inside chart or elsewhere the call + 'will fail. Again trying the slot after + 'switching to the document. + Kontext "DocumentDraw" + DocumentDraw.TypeKeys "<Escape>" + EditNavigator + endcatch + Kontext "NavigatorDraw" + if NavigatorDraw.exists(10) then + 'Select first OLE in list + Liste.TypeKeys "<HOME>" + Liste.select(1) + Liste.TypeKeys "+<DOWN><RETURN>" + fSelectFirstOLE = 0 + else + QAErrorLog "Navigator did not occoured!" + end if + end if + + case "writer" , "htmldokument" , "masterdoc" : + select case lcase(gApplication) + case "masterdoc" : Kontext "NavigatorGlobalDoc" + if NavigatorGlobalDoc.Exists(10) then + bNavigatorWasVisible = TRUE + else + EditNavigator + end if + wait 500 + Kontext "NavigatorGlobalDoc" + if Liste.IsVisible then + Kontext "GlobaldokumentToolbox" + Umschalten.Click + endif + case else : Kontext "NavigatorWriter" + 'First check if Navigator is visible and remember result + if NavigatorWriter.Exists (10) then + bNavigatorWasVisible = TRUE + else + try + 'Invoke Navigator if not visible + EditNavigator + catch + 'If inside chart or elsewhere the call + 'will fail. Again trying the slot after + 'switching to the document. + Kontext "DocumentWriter" + call gMouseclick (99,99) + call gMouseclick (50,50) + EditNavigator + endcatch + end if + end select + Kontext "NavigatorWriter" + if NavigatorWriter.Exists(10) then + 'Select first OLE in list + Auswahlliste.TypeKeys "<HOME>" + for iIndex = 1 to 13 + Auswahlliste.TypeKeys "-<DOWN>" + next iIndex + Auswahlliste.select(5) + Auswahlliste.TypeKeys "+<DOWN><RETURN>" + fSelectFirstOLE = 0 + else + QAErrorLog "Navigator did not occoured!" + end if + case else : QAErrorLog "Application not supported" + end select + + 'Close navigator if it was invisible by entering the routine + if bNavigatorWasVisible = TRUE then + printlog "Leaving navigator open as initially found" + else + if fSelectFirstOLE = 0 then + EditNavigator + printlog "Closing navigator as initially found" + else + printlog "Closing navigator not needed. It was not possible to open it." + end if + end if +end function diff --git a/testautomation/global/tools/includes/required/t_files.inc b/testautomation/global/tools/includes/required/t_files.inc new file mode 100755 index 000000000000..4c02ab9fb917 --- /dev/null +++ b/testautomation/global/tools/includes/required/t_files.inc @@ -0,0 +1,948 @@ +'encoding UTF-8 Do not remove or change this line! +'******************************************************************************* +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_files.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/****************************************************************************** +'* +'* Owner : thorsten.bosbach@sun.com +'* +'* short description : Global routines for loading, saving, printing, export +'* +'\****************************************************************************** + +private const C_INFO = TRUE ' Set this to TRUE to increase verbosity of some functions + +function hHandleAlienWarning( sFilterName as string ) as boolean + + dim bAlienNotAllowed as boolean + bAlienNotAllowed = false + + const CFN = "global::toolls::inc:t_files.inc::hHandleAlienWarning()" + + + if ( C_INFO ) then printlog( CFN & "Testing for Alien Warning" ) + + Kontext "AlienWarning" + if AlienWarning.Exists() then + + ' Verifying the default filter with the used filter and if it is the same and + ' the Alien Warning dialog occured return a warning. + + select case lcase(gApplication) + case "writer", "textdokument" : + if sFilterName = gWriterFilter then bAlienNotAllowed = TRUE + case "calc", "tabellendokument" : + if sFilterName = gCalcFilter then bAlienNotAllowed = TRUE + case "impress", "praesentation" : + if sFilterName = gImpressFilter then bAlienNotAllowed = TRUE + case "draw", "zeichnung" : + if sFilterName = gDrawFilter then bAlienNotAllowed = TRUE + case "masterdoc", "globaldokument", "globaldoc" : + if sFilterName = gMasterDocFilter then bAlienNotAllowed = TRUE + case "math", "formel" : + if sFilterName = gMathFilter then bAlienNotAllowed = TRUE + case "html", "htmldokument" : + if sFilterName = gHTMLFilter then bAlienNotAllowed = TRUE + end select + + if ( bAlienNotAllowed ) then + warnlog( CFN & "No alien warning expected for this documenttype" ) + endif + + AlienWarning.OK + + endif + + hHandleAlienWarning() = bAlienNotAllowed + +end function +' +'------------------------------------------------------------------------------- +' +function hGrafikEinfuegen ( Grafik$ ) as Boolean + '/// hGrafikEinfuegen hGraphicInsert + '/// A graphic will be inserted (not linked). + '/// <u>Input</u>: Filename with complete path + '/// <u>Return</u>: TRUE or FALSE if the graphic could be inserted or not. + + Dim DieDatei as String + Dim IsActive as Boolean + + DieDatei = ConvertPath ( Grafik$ ) + + InsertGraphicsFromFile + WaitSlot() + + Kontext + If Active.Exists(1) then + warnlog " Hinweis: " & Active.GetText + Active.Ok + End If + + + Kontext "GrafikEinfuegenDlg" + if ( GrafikEinfuegenDlg.exists( 2 ) ) then + + Vorschau.Uncheck + if gApplication <> "HTMLDOKUMENT" AND gApplication <> "HTML" then + Verknuepfen.UnCheck + end if + + Dateiname.SetText DieDatei + DateiTyp.Select 1 ' set the filter to 'all formats' + Oeffnen.Click + + Kontext "Active" + if Active.Exists(2) then + Warnlog " Hinweis: " & Active.GetText + try + Active.OK + catch + try + Active.Yes + catch + Active.Cancel + endcatch + endcatch + Kontext "GrafikEinfuegenDlg" + if GrafikEinfuegenDlg.Exists then + GrafikEinfuegenDlg.Cancel + endif + else + hGrafikEinfuegen = IsImageLoaded + end if + else + 'GrafikEinfuegeDlg not open + endif +end function +' +'------------------------------------------------------------------------------- +' +function hGrafikVerknuepftEinfuegen ( Grafik$ ) as Boolean + '/// hGrafikEinfuegenEinfuegen hGraphicInsertLinked + '/// A graphic will be inserted <b>LINKED</b> + '/// <u>Input</u>: Filename with complete path + '/// <u>Return</u>: TRUE or FALSE if the graphic could be inserted or not. + Dim DieDatei as String + Dim IsActive as Boolean + + DieDatei = ConvertPath ( Grafik$ ) + + InsertGraphicsFromFile + WaitSlot() + + Kontext + If Active.Exists(1) then + warnlog " Hinweis: " & Active.GetText + Active.Ok + End If + Kontext "GrafikEinfuegenDlg" + if ( GrafikEinfuegenDlg.exists( 1 ) ) then + + Vorschau.UnCheck + if gApplication <> "HTMLDOKUMENT" AND gApplication <> "HTML" then + Verknuepfen.Check + end if + + Dateiname.SetText DieDatei + DateiTyp.Select 1 ' set the filter to 'all formats' + Oeffnen.Click + + Kontext "Active" + if Active.Exists(2) then + Warnlog " Hinweis: " + Active.GetText + try + Active.OK + catch + Active.Yes + endcatch + Kontext "GrafikEinfuegenDlg" + if GrafikEinfuegenDlg.Exists then + GrafikEinfuegenDlg.Cancel + endif + else + hGrafikVerknuepftEinfuegen = IsImageLoaded + end if + else + 'GrafikEinfuegenDlg not open + endif +end function +' +'------------------------------------------------------------------------------- +' +function IsItSaved as boolean + '/// IsItSaved + '/// Wait until document is saved. + Dim iLoop as integer + + IsItSaved = FALSE + sleep(3) + for iLoop =1 to 20 + try + 'Calling slot 'IsDocSaving' + IsItSaved = IsDocSaving + catch + IsItSaved = FALSE + endcatch + + if IsItSaved = TRUE then + exit for + end if + sleep(1) + next iLoop + sleep(2) +end function +' +'------------------------------------------------------------------------------- +' +function IsItLoaded as boolean + '/// IsItLoaded + '/// Wait until document is loaded + Dim iLoop as integer + + IsItLoaded = FALSE + sleep(3) + for iLoop =1 to 20 + try + 'Calling slot 'IsDocLoading' + IsItLoaded = IsDocLoading + catch + IsItLoaded = FALSE + endcatch + + if IsItLoaded = TRUE then + exit for + end if + sleep(1) + next iLoop + sleep(2) +end function +' +'------------------------------------------------------------------------------- +' +function hIsNamedDocLoaded (ShouldFile as String, optional bSilent as boolean) as Boolean + dim sTemp as string + '/// hIsNamedDocLoaded ///' + '/// !fails always if a template is loaded, because you have to set a new filename in the save-dialog -> not usable in this case ! ///' + '/// Input: name of loaded file; Output: True/False ///' + '///+' if a doc got loaded, the filename in a 'SaveAs' Dlg is different from "" /// + '///+' usually the file name of the loaded document with an changed extension chosen from SO /// + + if (isMissing(bSilent)) then + bSilent = False + endif + + hIsNamedDocLoaded = False ' Let's start WorstCase :-( + FileSaveAs + Kontext "SpeichernDlg" + If DateiOhneExt(DateiExtract(Dateiname.GetSelText)) = DateiOhneExt(DateiExtract(ShouldFile)) Then + hIsNamedDocLoaded = True + Else + sTemp = left(right(ShouldFile,2),1) ' get the 2nd last character ' vor;dot;sti;pot;std;xlt + if (((sTemp="o") or (sTemp="t") or (sTemp="l")) and (left(right(ShouldFile,4),1)=".")) then + hIsNamedDocLoaded = True ' exception! for linux! and MS-Office Templates + else + if ((Dateiname.GetSeltext = "") and not bSilent) then + Warnlog "Default filename is empty!"+left(right(ShouldFile,3),1) + endif + endif + End If + SpeichernDlg.Cancel +end function +' +'------------------------------------------------------------------------------- +' +function IsImageLoaded + '/// IsImageLoaded + '/// Wait until images in document are loaded + Dim i% : Dim Herbert as Boolean + + Sleep 3 + for i%=1 to 20 + try + Herbert = IsDocImageLoading + catch + Herbert = FALSE + endcatch + if Herbert = TRUE then + i%=100 + endif + Sleep (1) + next i% + if i<100 then + IsImageLoaded = FALSE + else + IsImageLoaded = TRUE + end if +end function +' +'------------------------------------------------------------------------------- +' +sub hIsWebPageLoaded as boolean + 'Author: Joerg Sievers + '/// If a document in StarOffice Writer is loaded all 9 items in the + '///+ statusbar are visible otherwise not. + '///+ This sub checks the state of these items. + Dim i as integer + Dim iGibtdenStatusraus as integer + printlog "- global::tools::inc::tfiles.inc::hIsWebPageLoaded" + hIsWebPageLoaded = FALSE + for i = 1 to 20 + Kontext "DocumentWriter" + if DocumentWriter.Exists(3) then + 'Count the items on the status bar. + iGibtdenStatusraus = DocumentWriter.StatusGetItemCount + 'There are nine items on the status bar if the web page has been loaded. + if iGibtdenStatusraus = 9 then + hIsWebPageLoaded = TRUE + exit for + end If + end if + WaitSlot( 3000 ) + next i +end sub +' +'------------------------------------------------------------------------------- +' +sub hSys2IntDlg + '/// Change from system to StarOffice-internal file-dialog (only for Win32) + if gPlatgroup <> "unx" then + Call hhSysToInt ( TRUE ) + endif + gUseSysDlg = FALSE +end sub +' +'------------------------------------------------------------------------------- +' +sub hInt2SysDlg + '/// Change from StarOffice-internal to system file-dialog (only for Win32) + if gPlatgroup <> "unx" then + Call hhSysToInt ( FALSE ) + endif + gUseSysDlg = TRUE +end sub +' +'------------------------------------------------------------------------------- +' +sub hhSysToInt ( bwhats as Boolean ) + '/// subroutine for <i>hSys2IntDlg</i> and </i>hInt2SysDlg</i> + ToolsOptions + hToolsOptions ( "StarOffice", "General" ) + if bwhats = TRUE then + StarOfficeDialogeBenutzen.Check + else + StarOfficeDialogeBenutzen.Uncheck + end if + Sleep 1 + Kontext "OptionenDlg" + OptionenDlg.OK + WaitSlot( 3000 ) +end sub +' +'------------------------------------------------------------------------------- +' +function hGetUsedFilter () as string + '/// Get used filter for loaded file. + try + FileSaveAs + Kontext "SpeichernDlg" + hGetUsedFilter = dateityp.getseltext + SpeichernDlg.Cancel + catch + hGetUsedFilter = "Not possible; try/catch fail in function" + endcatch +end function +' +'------------------------------------------------------------------------------- +' +function hFileExport (sName as string, sFilter as string) as boolean + '/// Wrapper function to simplify the use of the export functions, just give a filename and export format. + '///+ INPUT:<ul><li>sName: filename</li><li>sFilter: "PDF": call export for PDF</li></ul> + '///+ RETURN: execution success? + select case sFilter + case "PDF" : '/// use the function 'hExportAsPDF' with RECOMMENDED values /// ' + hFileExport = hExportAsPDFmulti (3, TRUE, sName, FALSE, TRUE, 1, 1) + end select + kontext + if active.exists(5) then + try + printlog active.getText + active.ok + warnLog "i26820 - errormessage about saving" + catch + printlog "pdf unexpected error in hFileExport()" + endcatch + endif +end function +' +'------------------------------------------------------------------------------- +' +function hExportAsPDFmulti (iTypeOfCall as integer, bExecute as boolean, sFileName as string, bAutoExtension as boolean, bOverwriteFile as boolean, iRange as integer, iConpression as integer, optional sRange as string) as boolean + '/// Export a document to PDF with various options. + '///+ INPUT + '///+<ul><li>iTypeOfCall</li><ul><li>1: via the icon in the functionbar (no options selectable, since only file dialog comes up!)</li> + '///+<li>2: via File->Send->Document As PDF Attachment... (makes no sense either, because after the mail window comes up... (you can't handle by the testtool))</li> + '///+<li>3 via File->Export As PDF... (RECOMMENDED)</li></ul> + '///+<li>bExecute: Shall all dialogs left with OK? TRUE (RECOMMENDED) / FALSE</li> + '///+<li>sFileName: Filename to use</li> + '///+<li>bAutoExtension: Shall the file extension be chosen by StarOffice? TRUE / FALSE (RECOMMENDED)</li> + '///+<li>bOverwriteFile: If filename already exists should it be overwritten? TRUE (RECOMMENDED) / FALSE</li> + '///+<li>iRange:</li><ol><li>1: All (RECOMMENDED)</li> + '///+<li>2: Pages: The range is set in the optional parameter 'sRange' at the end</li> + '///+<li>3: Selection</li></ol> + '///+<li>iConpression:</li><ol><li>1: JpegCompression check and ReduceImageResolution check</li> + '///+<li>2: JpegCompression check and ReduceImageResolution uncheck</li> + '///+<li>3: LosslessCompression check and ReduceImageResolution uncheck</li></ol> + '///+<li>sRange: Optional parameter only used for iRange=2; takes the page range as text</li> + '///+<li>RETURN: Any Errors? TRUE / FALSE</li></ul> + dim sPDF as string + dim sTemp as string + dim iTemp as integer + dim sTFileName as string + dim iCount as integer + + sPDF = "PDF - Portable Document Format (.pdf)" + hExportAsPDFmulti = TRUE ' optimistic + iTemp = 0 + + select case (iTypeOfCall) + case 1 : '/// click the button 'Export Directly as PDF' on the Functionbar ///' + kontext "Standardbar" + try + ExportAsPDF.click + catch + Warnlog "Button 'Export directly as PDF' not accessible!" + hExportAsPDFmulti = FALSE + exit function + endcatch + case 2 : '/// File->Send->Document As PDF Attachment... ///' + try + FileSendDocumentAsPDF + catch + Warnlog "'Export as PDF' not accessible!" + hExportAsPDFmulti = FALSE + exit function + endcatch + case 3 : '/// File->Export As PDF... ///' + try + FileExportAsPDF ' works in draw/impress, too but is not 'legal' in the UI :-) + catch + Warnlog "Button 'Export as PDF' not accessible!" + hExportAsPDFmulti = FALSE + exit function + endcatch + end select + + ' only if the type is 1 OR 3 then the File Save dialog appear + ' just kept here for compatibility reasons - has to get removed around july 2007 + if (iTypeOfCall = 1 OR iTypeOfCall = 3) then + kontext "ExportAsPDFDlg" + if ExportAsPDFDlg.exists(5) then + try + Dateityp.Select sPDF + catch + Warnlog "Unable to select filter: '" + sPDF + "'" + ExportAsPDFDlg.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + + sTemp = Dateityp.GetSelText + if (sTemp <> sPDF) then + Warnlog "filter for PDF export is missing :-( '" + sPDF + "'" + end if + '/// set Textbox 'File name' ///' + Dateiname.SetText sFileName + 'if the file has no pdf extension then add the extension + if (lCase(right(sFileName, 4))=".pdf") then + sTFileName = sFileName + else + sTFileName = sFileName + ".pdf" + endif + '/// click on the button 'Export...' ///' + if (bExecute) then + Export.Click + kontext "AlienWarning" + if AlienWarning.exists(5) then + warnlog "#i41983# Alien Warning on export not allowed." + AlienWarning.OK + endif + if (iTypeOfCall = 1) then + ''Export Directly as PDF' + endif + iCount = 0 + ' wait until file exists for max 5 minutes + while ((dir(sTFileName)="") AND (iCount < 30)) + sleep 10 + inc iCount + wEnd + endif + else + 'ExportAsPDFDlg.Cancel + end if + + ' if file exists, there is a message... + kontext "PDFOptions" + if NOT PDFOptions.exists then + Kontext + if messagebox.exists (5) then + if (bOverwriteFile) then + messagebox.Yes + else + messagebox.No + kontext "ExportAsPDFDlg" + ExportAsPDFDlg.Cancel + hExportAsPDFmulti = FALSE + end if + end if + end if + end if + + + ' only if the type is 2 OR 3 then the PDF option dialog appear + if (iTypeOfCall = 2 OR iTypeOfCall = 3) then + kontext "PDFOptions" + select case (iRange) + case 1 : '/// check radiobutton 'All' ///' + try + RangeAll.Check + catch + Warnlog "Radiobutton 'All' not accessible!" + PDFOptions.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + case 2 : '/// check radiobutton 'Pages' ///' + try + RangePages.Check + catch + Warnlog "Radiobutton 'Range' not accessible!" + PDFOptions.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + if isMissing(sRange) then + Warnlog "parameter 'sRange' in function 'hExportAsPDFmulti' is not optional if 'iRange' = 2" + hExportAsPDFmulti = FALSE + else + '/// set range textbox the given value ///' + RangePagesEdit.SetText sRange + end if + case 3 : '/// check radiobutton 'Selection' (not enabled in math!) ///' + try + if (RangeSelection.IsEnabled <> TRUE)then + Warnlog "RangeSelection is disabled :-(" + else + RangeSelection.Check + end if + catch + Warnlog "Radiobutton 'Selection' not accessible!" + PDFOptions.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + end select + + select case (iConpression) + case 1 : '/// JpegCompression check and ReduceImageResolution check///' + try + JpegCompression.Check + ReduceImageResolution.Check + catch + Warnlog "Radiobutton 'Reduce Image Resolution' not accessible!" + PDFOptions.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + case 2 : '/// JpegCompression check and ReduceImageResolution uncheck ///' + try + JpegCompression.Check + ReduceImageResolution.UnCheck + catch + Warnlog "Radiobutton 'Jpeg Compression' not accessible!" + PDFOptions.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + case 3 : '/// LosslessCompression check and ReduceImageResolution uncheck ///' + try + LosslessCompression.Check + ReduceImageResolution.UnCheck + catch + Warnlog "Radiobutton 'Lossless Compression' not accessible!" + PDFOptions.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + end select + if (bExecute) then + try + PDFOptions.OK + catch + qaErrorlog "ImprovementOfSave: PDF export loops?" + endcatch + else + PDFOptions.Cancel + end if + end if + ' only if the type is 1 OR 3 then the File Save dialog appear + if (iTypeOfCall = 1 OR iTypeOfCall = 3) then + kontext "ExportierenDLG" + if ExportierenDLG.exists(5) then + try + Dateityp.Select sPDF + catch + Warnlog "Unable to select filter: '" + sPDF + "'" + ExportierenDLG.Cancel + hExportAsPDFmulti = FALSE + exit function + endcatch + + sTemp = Dateityp.GetSelText + if (sTemp <> sPDF) then + Warnlog "filter for PDF export is missing :-( '" + sPDF + "'" + end if + '/// set Textbox 'File name' ///' + Dateiname.SetText sFileName + 'if the file has no pdf extension then add the extension + if (lCase(right(sFileName, 4))=".pdf") then + sTFileName = sFileName + else + sTFileName = sFileName + ".pdf" + endif + '/// click on the button 'Export...' ///' + if (bExecute) then + Speichern.Click + kontext "AlienWarning" + if AlienWarning.exists(5) then + warnlog "#i41983# Alien Warning on export not allowed." + AlienWarning.OK + endif + if (iTypeOfCall = 1) then + ''Export Directly as PDF' + endif + iCount = 0 + ' wait until file exists for max 5 minutes + while ((dir(sTFileName)="") AND (iCount < 30)) + sleep 10 + inc iCount + wEnd + endif + else + ExportierenDLG.Cancel + end if + + ' if file exists, there is a message... + kontext "PDFOptions" + if NOT PDFOptions.exists then + Kontext + if messagebox.exists (5) then + if (bOverwriteFile) then + messagebox.Yes + else + messagebox.No + kontext "ExportierenDLG" + ExportierenDLG.Cancel + hExportAsPDFmulti = FALSE + end if + end if + end if + end if + +end function +' +'------------------------------------------------------------------------------- +' +function hFileOpen( cFile as string, optional bLinks as boolean ) as boolean + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_fileopen.inc::hFileOpen():" + + dim bHandleLinkDialog as boolean + + if ( IsMissing( bLinks ) ) then + bHandleLinkDialog = FALSE + else + bHandleLinkDialog = bLinks + endif + + if ( C_INFO ) then printlog( "Load: " & sFile ) + FileOpen( "URL", sFile, "FrameName", "_default" ) + hFileWait() + + if ( bHandleLinkDialog ) then + kontext "Active" + if ( Active.exists( 2 ) ) then + Active.yes() + hFileOpen() = true + else + warnlog( CFN & "Expected link dialog is missing" ) + hFileOpen() = false + endif + else + hFileOpen() = true + endif + +end function +' +'------------------------------------------------------------------------------- +' +function hFileOpenSpecial( cFile as string, cFlag as string ) as boolean + + ' Open a file with some special options + ' cFlag = "ReadOnly" opens file read-onlx + ' cFlag = "AsTemplate" opens file as templat + ' cFlag = <Any other string> treats string as password + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_fileopen.inc::hFileOpenSpecial():" + if ( C_INFO ) then printlog( "Load (Flag): " & sFile & " (" & cFlag & ")" ) + + select case( lcase( cFlag ) ) + case "readonly" + printlog( "Load file read-only: " & sFile ) + FileOpen( "URL", sFile, "FrameName", "_default", "ReadOnly", TRUE) + case "astemplate" + printlog( "Load file as template: " & sFile ) + FileOpen( "URL", sFile, "FrameName", "_default", "AsTemplate" , TRUE ) + case else + printlog( "Load file with password: " & sFile ) + FileOpen( "URL", sFile, "FrameName", "_default", "Password" , cFlag ) + end select + + hFileWait() + hFileOpenSpecial() = true + + '///</ul> + +end function +' +'------------------------------------------------------------------------------- +' +function hFileOpenWithFilter( cFile as string, cFilter as string, optional bLinks as boolean ) + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_fileopen.inc::hFileOpenWithFilter():" + + dim bHandleLinkDialog as boolean + + if ( IsMissing( bLinks ) ) then + bHandleLinkDialog = FALSE + else + bHandleLinkDialog = bLinks + endif + + if ( C_INFO ) then printlog( "Load (Filter): " & sFile & " (" & cFilter & ")" ) + + FileOpen( "URL", sFile, "FrameName", "_default", "FilterName", cFilter ) + hFileWait() + + Kontext "AsciiFilterOptionen" + if ( AsciiFilterOptionen.exists() ) then + printlog( CFN & "ASCII filter dialog is open" ) + AsciiFilterOptionen.ok() + endif + + if ( bHandleLinkDialog ) then + kontext "Active" + if ( Active.exists( 2 ) ) then + Active.yes() + hFileOpenWithFilter() = true + else + warnlog( CFN & "Expected link dialog is missing" ) + hFileOpenWithFilter() = false + endif + else + hFileOpenWithFilter() = true + endif + +end function +' +'------------------------------------------------------------------------------- +' +function hFileSave() as boolean + + const CFN = "global::tools::inc::t_filesave.inc::hFileSave():" + hFileSave() = FALSE + if ( C_INFO ) then printlog( "Save file." ) + FileSave + if ( hFileWait() >= 0 ) then hFileSave() = TRUE + +end function +' +'------------------------------------------------------------------------------- +' +function hFileSaveAs( cFile as string ) as boolean + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_filesave.inc::hFileSaveAs():" + hFileSaveAs() = FALSE + if ( C_INFO ) then printlog( "Save: " & sFile ) + FileSaveAs( "URL", sFile, "Overwrite", FALSE ) + if ( hFileWait() >= 0 ) then hFileSaveAs() = TRUE + +end function +' +'------------------------------------------------------------------------------- +' +function hFileSaveAsKill( cFile as string ) as boolean + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_filesave.inc::hFileSaveAsKill():" + hFileSaveAsKill() = FALSE + if ( C_INFO ) then printlog( "Save, replacing: " & sFile ) + FileSaveAs( "URL", sFile, "Overwrite", TRUE ) + if ( hFileWait() >= 0 ) then hFileSaveAsKill() = TRUE + +end function +' +'------------------------------------------------------------------------------- +' +function hFileSaveAsKillWithPassword( cFile as string, cPassword as string ) as boolean + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_filesave.inc::hFileSaveAsKillWithPassword():" + hFileSaveAsKillWithPassword() = FALSE + if ( C_INFO ) then printlog( "Save with password, replacing: " & sFile & "::" & cPassword ) + FileSaveAs( "URL", sFile, "Overwrite", TRUE, "Password", cPassword ) + if ( hFileWait() >= 0 ) then hFileSaveAsKillWithPassword() = TRUE + +end function +' +'------------------------------------------------------------------------------- +' +function hFileSaveAsWithFilter( cFile as string, cFilter as string ) as boolean + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_filesave.inc::hFileSaveAsWithFilter():" + hFileSaveAsWithFilter() = FALSE + if ( C_INFO ) then printlog( "Save with filter: " & sFile & "::" & cFilter ) + FileSaveAs( "URL", sFile, "FilterName", cFilter, "Overwrite", FALSE ) + if ( hFileWait() >= 0 ) then hFileSaveAsWithFilter() = TRUE + +end function +' +'------------------------------------------------------------------------------- +' +function hFileSaveAsWithFilterKill( cFile as string, cFilter as string ) as boolean + + dim sFile as string : sFile = convertToURL( convertpath( cFile ) ) + const CFN = "global::tools::inc::t_filesave.inc::hFileSaveAsWithFilterKill():" + hFileSaveAsWithFilterKill() = FALSE + if ( C_INFO ) then printlog( "Save with filter, replacing: " & sFile & "::" & cFilter ) + FileSaveAs( "URL", sFile, "FilterName", cFilter, "Overwrite", TRUE ) + if ( hFileWait() >= 0 ) then hFileSaveAsWithFilterKill() = TRUE + +end function +' +'------------------------------------------------------------------------------- +' +function hFileWait() as integer + + ' Wait max 10 seconds for the FileOpen/FileSave slot to finish + ' Returns the time it took the slot to finish + ' Negaitve returnvalues are given on timeout or any blocking dialog + + const CFN = "hFileWait()::" + const MAX_WAIT = 10 + dim iWait as integer : iWait = 0 + + do while( WaitSlot() <> WSFinished ) + + iWait = iWait + 1 + + ' This is the timeout + if ( iWait = MAX_WAIT ) then + iWait = -1 + exit do + endif + + ' LOAD: Security warning prevents slot from finishing + kontext "SecurityWarning" + if ( SecurityWarning.exists() ) then + iWait = -2 + exit do + endif + + ' LOAD: Password dialog + kontext "PasswordFileOpen" + if ( PasswordFileOpen.exists() ) then + iWait = -4 + exit do + endif + + ' LOAD: ASCII Filter Options dialog + kontext "ASCIIFilterOptionen" + if AsciiFilterOptionen.Exists() then + iWait = -7 + exit do + end if + + + ' SAVE: Password dialog + kontext "PasswordDlg" + if ( PasswordDlg.exists() ) then + iWait = -5 + exit do + endif + + ' LOAD: Filter selection dialog + Kontext "Filterauswahl" + if ( FilterAuswahl.exists() ) then + iWait = -6 + exit do + endif + + ' LOAD/SAVE: Some other dialogs that may interrupt file I/O + kontext "Active" + if ( Active.exists() ) then + printlog( Active.getText() ) + iWait = -3 + exit do + endif + + loop + + if ( C_INFO ) then + select case iWait + case -1 : printlog( CFN & "Timeout reached, continuing" ) + case -2 : printlog( CFN & "Macro security warning displayed, continuing" ) + case -3 : printlog( CFN & "Dialog boxes are in the way, continuing" ) + case -4 : printlog( CFN & "Password dialog (load) displayed, continuing" ) + case -5 : printlog( CFN & "Password dialog (save) displayed, continuing" ) + case -6 : printlog( CFN & "Filter Selection dialog displayed, continuing" ) + case -7 : printlog( CFN & "ASCII filter options dialog displayed, continuing" ) + case else : printlog( CFN & "File I/O completed in " & iWait & " seconds" ) + end select + endif + hFileWait() = iWait + +end function + diff --git a/testautomation/global/tools/includes/required/t_filters.inc b/testautomation/global/tools/includes/required/t_filters.inc new file mode 100755 index 000000000000..e66e5271a069 --- /dev/null +++ b/testautomation/global/tools/includes/required/t_filters.inc @@ -0,0 +1,517 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_filters.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/****************************************************************************** +'* +'* owner : joerg.skottke@sun.com +'* +'* short description : Retrieve and set filternames and suffixes +'* +'******************************************************************************* +'** +' #1 hGetSuffix ' get the suffix for a specified build-id +' #1 hGetFilter ' get the filtername for a specified build-id +' #0 hSelectUIFilter ' Select a filter in the UI by API filter name +' #0 hFindFilterPosition ' Find the index of the filter in the file open dialog +' #0 hGetFilterGroup ' Speedier approach to hGetUIFilternames() +' #1 GetDefaultFilterNames ' read the default filternames from a reference list +' #1 CreateFilterNamesList ' write the default filternames to the reference list +' #1 hGetValueForKeyAsString ' find key in list, return value as string +' #1 hGetValueForPairAsString ' find value in list, return key and value as string +' #1 hGetKeyForPairAsString ' get key from a key=value string as string +' #1 hGetDataFileSection ' read a section from a datafile into a list +' #1 hGetFileData ' return value for key from file directly (ignores sections) +' #1 hGetStartOfSection ' identify beginning of new section in datafile +' #1 hGetEndOfSection ' identify end of section in datafile +' #1 hGetSection ' retrieve list of strings from section +'** +'\****************************************************************************** + +private const LENGTH_OF_FILTERFILE = 100 +private const FILE_DATA_SIZE = 300 + +function hGetSuffix( optional cBuildId as string ) as string + + ' This function retrieves the suffix depending on the build id (e.g. 680) + ' for a known gApplication from the program configuration. + + ' Currently known Build-IDs are: + ' No parameter = current + ' "" (empty string) = current + ' 300 = StarOffice 9 / OpenOffice.org 3.x + ' 680 = StarOffice 8 / OpenOffice.org 2.x + ' 645 = StarOffice 7 / OpenOffice.org 1.x + ' 641 = StarOffice 6 (XML format) + ' 569 = StarOffice 5 (Binary format) + + dim sMatchingFile as string + dim sFilterArray( 100 ) as string + dim sFilterConfigName as string + dim sSuffix( 10 ) as string + + if ( IsMissing( cBuildId ) ) then cBuildId = "current" + if ( cBuildId = "" ) then cBuildId = "current" + + sMatchingFile = gTesttoolPath & "global\input\filters\" + sMatchingFile = sMatchingFile & "build_to_suffix.txt" + sMatchingFile = convertpath( sMatchingFile ) + + 'printlog( "DEBUG: SUFFIX: Build-ID: " & cBuildId ) + hGetDataFileSection( sMatchingFile, sFilterArray(), cBuildId, "", "" ) + sFilterConfigName = hGetValueForKeyAsString( sFilterArray(), gApplication ) + 'printlog( "DEBUG: SUFFIX: Config name: " & sFilterConfigName ) + sSuffix() = hGetFilterNameExtension( sFilterConfigName ) + 'printlog( "DEBUG: SUFFIX: " & sSuffix( 0 ) ) + hGetSuffix() = "." & sSuffix( 0 ) + +end function + +'******************************************************************************* + +function hGetFilter( optional cBuildId as string ) as string + + '///<h1>Get the Filtername for a specified Build-ID</h1> + + ' Currently known Build-IDs are: + ' No parameter = current + ' "" (empty string) = current + ' 300 = StarOffice 9 / OpenOffice.org 3.x + ' 680 = StarOffice 8 / OpenOffice.org 2.x + ' 645 = StarOffice 7 / OpenOffice.org 1.x + ' 641 = StarOffice 6 (XML format) + ' 569 = StarOffice 5 (Binary format) + + dim clTemp( LENGTH_OF_FILTERFILE ) as string ' cFilterFile is stored here + + dim sMatchingFile as string + dim sFilterArray( 100 ) as string + dim sFilterConfigName as string + dim sFilter as string + + if ( IsMissing( cBuildId ) ) then cBuildId = "current" + if ( cBuildId = "" ) then cBuildId = "current" + + sMatchingFile = gTesttoolPath & "global\input\filters\" + sMatchingFile = sMatchingFile & "build_to_filter.txt" + sMatchingFile = convertpath( sMatchingFile ) + + 'printlog( "DEBUG: FILTER: Filter-ID: " & cBuildId ) + hGetDataFileSection( sMatchingFile, sFilterArray(), cBuildId, "", "" ) + sFilterConfigName = hGetValueForKeyAsString( sFilterArray(), gApplication ) + 'printlog( "DEBUG: FILTER: Config name: " & sFilterConfigName ) + sFilter = hGetUIFilterName( sFilterConfigName ) + 'printlog( "DEBUG: FILTER: " & sFilter ) + hGetFilter() = sFilter + +end function + +'******************************************************************************* + +function hSelectUIfilter( cAPIFilter as string ) as boolean + + ' Wrapper for hFindFilterPosition() which also selects the filter + dim irc as integer + + irc = hFindFilterPosition( cAPIFilter ) + if ( irc > 0 ) then + DateiTyp.select( irc ) + hSelectUIfilter() = true + else + hSelectUIfilter() = false + endif + +end function + +'******************************************************************************* + +function hFindFilterPosition( cFilter as string ) as integer + + ' This function takes a filter as provided by the office API and tries to find + ' this filter within the File Save dialogs file type list. + ' The file types have a suffix appended like " (.odt)" which is not present + ' in the API's filter name so it is not possible to select the file + ' type directly and we do not have an exact match either. + ' To ensure that we not accidentially select the template a bracket is + ' appended to the string. + + dim iCurrentFilter as integer + dim cCurrentFilter as string + dim cUniqueFilter as string + cUniqueFilter = cFilter & " (" + + const CFN = "global::tools::inc::hFindFilterPosition::" + + for iCurrentFilter = 1 to DateiTyp.getItemCount() + + cCurrentFilter = DateiTyp.getItemText( iCurrentFilter ) + + if ( cFilter = cCurrentFilter ) then + 'printlog( CFN & "Exact match - this is a UI filter name, not API" ) + 'printlog( CFN & "The filter is at pos. " & iCurrentFilter ) + hFindFilterPosition() = iCurrentFilter + exit function + endif + + if ( instr( cCurrentFilter, cUniqueFilter ) > 0 ) then + 'printlog( CFN & "Filter found at pos. " & iCurrentFilter ) + hFindFilterPosition() = iCurrentFilter + exit function + endif + + next iCurrentFilter + + warnlog( CFN & "Filter not found: " & cFilter ) + warnlog( CFN & "Refer to global::input:.filters::api_filters.txt for a complete list of available filters" ) + + hFindFilterPosition() = 0 + +end function + +'******************************************************************************* + +function hGetFilterGroup( api_filters() as string, ui_filters() as string ) + + ' This is a function designed to deliver a massive speed improvement + ' compared to multiple calls to hGetUIFiltername() which establish a fresh + ' UNO connection on each call. This function establishes only one connection + ' and works with a list of API filter names which are matched to UI filter + ' names. This function does not wrap the UNO calls in a try...catch block + ' which means that if the function fails, it fails hard. Extra hard, that is. + ' There is no errorhandling. This function is intended for internal use only. + ' No returnvalue is defined at this time. + + const CFN = "global::tools::inc::t_filters.inc::hGetFilterGroup:" + + dim oUno as object + dim oService as object + dim oFilter as object + + dim iCurrentFilter as integer + + dim iFilterCount as integer + iFilterCount = ubound( api_filters() ) + + dim iAPIfilterList as integer + + oUno = hGetUNOService( true ) + oService = oUno.createInstance("com.sun.star.document.FilterFactory") + + for iCurrentFilter = 1 to iFilterCount + + oFilter = oService.getByName( api_filters( iCurrentFilter ) ) + + for iAPIFilterList = 0 to ubound( oFilter ) + + if ( oFilter( iAPIFilterList ).Name = "UIName" ) then + ui_filters( iCurrentFilter ) = oFilter( iAPIFilterList ).Value() + 'printlog( CFN & "DEBUG: Index (iCurrentFilter): " & iCurrentFilter ) + 'printlog( CFN & "DEBUG: API Filter: " & api_filters( iCurrentFilter ) ) + 'printlog( CFN & "DEBUG: UI Filter.: " & ui_filters( iCurrentFilter ) ) + endif + + next iAPIFilterList + + next iCurrentFilter + +end function + +'******************************************************************************* + +sub GetDefaultFilterNames() + + dim sMatchingFile as string + dim sFilterArray( 100 ) as string + + const APPLICATION_COUNT = 7 + dim cUIFilters( APPLICATION_COUNT ) as string + dim cAPIFilters( APPLICATION_COUNT ) as string + + sMatchingFile = gTesttoolPath & "global\input\filters\" + sMatchingFile = sMatchingFile & "build_to_filter.txt" + sMatchingFile = convertpath( sMatchingFile ) + + hGetDataFileSection( sMatchingFile, sFilterArray(), "Current", "", "" ) + + cAPIFilters( 1 ) = hGetValueForKeyAsString( sFilterArray(), "WRITER" ) + cAPIFilters( 2 ) = hGetValueForKeyAsString( sFilterArray(), "CALC" ) + cAPIFilters( 3 ) = hGetValueForKeyAsString( sFilterArray(), "IMPRESS" ) + cAPIFilters( 4 ) = hGetValueForKeyAsString( sFilterArray(), "MASTERDOC" ) + cAPIFilters( 5 ) = hGetValueForKeyAsString( sFilterArray(), "MATH" ) + cAPIFilters( 6 ) = hGetValueForKeyAsString( sFilterArray(), "DRAW" ) + cAPIFilters( 7 ) = hGetValueForKeyAsString( sFilterArray(), "HTML" ) + + hGetFilterGroup( cAPIFilters(), cUIFilters() ) + + gWriterFilter = cUIFilters( 1 ) + gCalcFilter = cUIFilters( 2 ) + gImpressFilter = cUIFilters( 3 ) + gMasterDocFilter = cUIFilters( 4 ) + gMathFilter = cUIFilters( 5 ) + gDrawFilter = cUIFilters( 6 ) + gHTMLFilter = cUIFilters( 7 ) + +end sub + +'******************************************************************************* + +function hGetValueForKeyAsString( lsList() as string, sKey as string ) as string + + '/// This function returns the value of a key as string. + '///+ The form of the input strings is 'key=value', the list is parsed + '///+ The Value for the first occurrence of sKey is returned + + dim iItem as integer + dim cComp as string + + hGetValueForKeyAsString() = "Error: No matching VALUE found for key: " & sKey + + ' Scan through the list and look for sKey. If found, return the Value + ' (everything to the right of the '=') + + for iItem = 1 to listcount( lsList() ) + + if( instr( lsList( iItem ) , sKey ) <> 0 ) then + + cComp = hGetKeyforPairAsString( lsList( iItem ) ) + + if( sKey = cComp ) then + hGetValueForKeyAsString() = hGetValueForPairAsString( lsList( iItem ) ) + iItem = listcount( lsList() ) + 1 + end if + + end if + + next iItem + +end function + +'******************************************************************************* + +function hGetValueForPairAsString( cLine as string ) as string + + '/// This function takes a string that (hopefully) contains one '=' + '///+ and returns the substringstring to the right from the '=' char. + + dim iCharPos as integer + + iCharPos = instr( cLine , "=" ) + iCharPos = len( cLine ) - iCharPos + hGetValueForPairAsString() = right( cLine , iCharPos ) + +end function + +'******************************************************************************* + +function hGetKeyForPairAsString( cLine as string ) as string + + '/// This function returns the string to the left of the '=' + + dim iCharPos as integer + + iCharPos = instr( cLine , "=" ) + + ' get the string to the left of the = char + + if ( iCharPos > 0 ) then + hGetKeyForPairAsString() = left( cLine , iCharPos -1 ) + else + warnlog( "Invalid string passed to hGetKeyForPairAsString: " & cLine ) + end if + +end function + +'******************************************************************************* + +function hGetDataFileSection( cFile as string, lsList() as string, cSection as string , cComment as string, cPrint as string ) as integer + + const CFN = "hGetDataFileSection:" + + '/// This function reads a datafile into a list. + '///+ Comments (lines beginning with #) are removed from the list. + '///+ A comment can be passed to the log. + '///+ Furthermore a section in the source-file can be specified. Only + '///+ lines within the section are returned then. The delimiter for a + '///+ section is [section-name] <> [ ...] (or EOF) + '///+ <ul>NOTES:<li>Instead of lsList() a temporary list should be used that is big + '///+ enough to hold all the data from the datafile.</li> + '///+ <li> this function does - basically the same as getinivalue(...) but + '///+ is easier to debug and returns a list not the key.</li></ul> + + dim sFile as string + + dim iSectionBegin as integer + dim iSectionEnd as integer + dim iSectionItems as integer + + ' verify that the sourcefile exists, otherwise warn and abort + if ( dir( cFile ) = "" ) then + warnlog( CFN & "File not found: " & cFile ) + hGetDataFileSection() = 0 + exit function + end if + + ' print a comment to the logfile. Non optional parameter but might be "" + if ( cComment <> "" ) then + printlog( "" ) + printlog( CFN & cComment & " : " & cFile ) + printlog( "" ) + end if + + ' read the list from the file + listread( lsList() , cFile , "utf8" ) + + ' remove comments ( lines containing # ) + hListClearPattern( lsList() , "#" ) + + ' remove all blank lines + hListClearBlank( lsList() ) + + ' honor the section, if given. Non-optional parameter that can be "" + if ( cSection <> "" ) then + iSectionBegin = hGetStartOfSection( lsList() , cSection ) + iSectionEnd = hGetEndOfSection( lsList() , iSectionBegin ) + iSectionItems = hGetSection( lsList() , iSectionBegin , iSectionEnd ) + end if + + ' print the current list - if desired. + if ( lcase( cPrint ) <> "" ) then + hListPrint( lsList(), "Parent function: " & CFN ) + end if + + ' return the number of items + hGetDataFileSection() = listcount( lsList() ) + +end function + +'******************************************************************************* + +function hGetFileData( sFile as string , sKey as string ) as string + + dim sList( FILE_DATA_SIZE ) as string + dim iArraySize as integer + + ' This function reads a file and returns the first line containing sKey + iArraySize = hGetDataFileSection( sFile, sList(), "", "", "" ) + hGetFileData() = hGetValueForKeyAsString( sList() , sKey ) + +end function + +'******************************************************************************* + +function hGetStartOfSection( lsList() as string , _section as string ) as integer + + const CFN = "hGetStartOfSection::" + + '/// This function takes a list and looks for a string of the type [_section]. + '///+ The position of this successful hit is returned. + '///+ On error the returnvalue defaults to 0. + + dim iThisString as integer + dim cThisString as string + dim iListSize as integer + dim cSection as string + + iThisString = 0 + cSection = lcase ( "[" & _section & "]" ) + iListSize = listcount( lsList() ) + + do while ( iThisString <= iListSize ) + + iThisString = iThisString + 1 + cThisString = lcase( lsList( iThisString ) ) + + if ( instr( cThisString , cSection ) ) then + hGetStartOfSection() = iThisString + 1 + iThisString = iListSize + 5 + end if + + loop + + if ( iThisString = ( iListSize + 1 ) ) then + warnlog( CFN & "Section not found or empty: " & _section ) + hGetStartOfSection = 0 + end if + +end function + +'******************************************************************************* + +function hGetEndOfSection( lsList() as string , iOffset as integer ) as integer + + dim iThisString as integer + dim cThisString as string + dim iListSize as integer + + iThisString = iOffset + iListSize = listcount( lsList() ) + + do while ( iThisString <= iListSize ) + cThisString = lsList( iThisString ) + + if ( ( instr( cThisString , "[" ) > 0 ) and ( instr( cThisString , "]" ) > 0 ) )then + hGetEndOfSection() = iThisString - 1 + iThisString = iListSize + 5 + else + iThisString = iThisString + 1 + end if + + loop + + if ( iThisString = ( iListSize + 1 ) ) then + hGetEndOfSection() = iListSize + end if + +end function + +'******************************************************************************* + +function hGetSection( lsList() as string , iSectionBegin as integer , iSectionEnd as integer ) as integer + + dim iArraySize as integer + dim iThisString as integer + + iArraySize = ubound( lsList() ) + + dim lsTempList( iArraySize ) as string + listcopy( lsList() , lsTempList() ) + listalldelete( lsList() ) + + for iThisString = iSectionBegin to iSectionEnd + + listappend( lsList() , lsTempList( iThisString ) ) + + next iThisString + + hGetSection() = listcount( lsList() ) + +end function + + diff --git a/testautomation/global/tools/includes/required/t_lists.inc b/testautomation/global/tools/includes/required/t_lists.inc new file mode 100755 index 000000000000..32216f91771b --- /dev/null +++ b/testautomation/global/tools/includes/required/t_lists.inc @@ -0,0 +1,654 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_lists.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : general routines to work with lists (arrays) +'* +'******************************************************************* +'* general information : +'* - entry 0 of the list is the counter +'* - you have to start loops everytime with 1 .. n +'* +' #1 ListCount ' Returns the number of list entries +' #1 ListCopy ' Copies one list to another (OrgList(), CopyList()) +' #1 ListAllDelete ' Deletes the complete list +' #1 ListInsert ' Inserts a string into a list at a special number +' #1 ListAppend ' Appends an entry to a list +' #1 ListDelete ' Deletes the n'th entry out of the list (lsList(), EntryNumber) +' #1 ListDeleteString ' Deletes a string out of the list (the first found string) +' #1 ListSort ' Sorts a list with quicksort method, if the 2. parameter is FALSE => downward, else => upward +' #1 ListRead ' Reads a file into a list (row for row) +' #1 ListReadAppend ' Reads a file into a list and append it onto another existed list +' #1 ListWrite ' Writes a list into a file (each entry is a row) => the file will be created new +' #1 ListWriteAppend ' Writes a list into a file, but append all entries to the file +' #1 gCompare2Lists ' Compare two lists with each other +' #1 hListPrint ' print a list to the log with comment +' #1 hListClearPattern ' find pattern in list and replace with blanks +' #1 hListClearBlank ' find and remove blank listentries, update list +' #1 hListIntegrityTest ' extensible function to test array integrity +'* +'\****************************************************************** + +function ListCount ( lsList() as String ) as Integer + 'Author: tz + '///Returns the number of list entries. + '///+<u>Input</u>: The list (only string lists are possible) + '///+<u>Return</u>: The number of entries + ListCount = Val(lsList(0)) +end function + +'------------------------------------------------------------------------- + +function ListCopy ( lsList1() as String, lsList2() as String ) as Boolean + 'Author: tz + '///Copies all entries out of one list into another list. + '///+<u>Input</u>:<ol><lo>list which should be copied</li><li>An empty list</li></ol>After this function the 2nd list is a copy of the 1st list. + '///+<u>Return</u>: If copy of the list is correct this function returns TRUE otherweise FALSE + + Dim ii as Integer + + ListAllDelete ( lsList2() ) + for ii=1 to ListCount ( lsList1() ) + ListAppend ( lsList2(), lsList1(ii) ) + next ii + + if ListCount ( lsList1() ) = ListCount ( lsList2 () ) then + ListCopy = TRUE + else + ListCopy = FALSE + end if +end function + +'------------------------------------------------------------------------- + +sub ListAllDelete ( lsList() as String ) + 'Author: tz + '///Deletes a complete list. + '///+<u>Input</u>: The list (only string lists are possible) + lsList(0) = "0" +end sub + +'------------------------------------------------------------------------- + +sub ListAppend ( lsList() as String, sNewEntry as String ) + 'Author: tz + '///Appends a new entry at the end of the list. + '///+<u>Input</u>: <ol><li>the list (only string lists are possible)</li><li>The new entry</li></ol> + lsList(0) = Val(lsList(0)) + 1 + lsList( lsList(0) ) = sNewEntry +end sub + +'------------------------------------------------------------------------- + +function ListDelete ( lsList() as String, iNr as Integer ) as Boolean + 'Author: tz + '///Deletes an entry out of the list on a defined position (iNr). + '///+<u>Input</u>: <ol><li>The list (only string lists are possible)</li><li>The position of the entry</li></ol> + '///+<u>Return</u>: TRUE if the entry was deleted otherweise FALSE + + + Dim i%, ListenAnzahl as Integer + + ListenAnzahl = listcount( lsList() ) + + if iNr > ListenAnzahl then + ListDelete = FALSE + Exit Function + end if + + for i% = iNr to ListenAnzahl + lsList( i% ) = lsList( i% + 1 ) + next i% + + lsList(0) = ListenAnzahl - 1 + + ListDelete = TRUE +end function + +'------------------------------------------------------------------------- + +function ListDeleteString ( lsList() as String, sText as String ) as Boolean + 'Author: tz + '///Deletes the 1st string in the list which is equal to the input string. + '///+<u>Input</u>: <ol><li>The list (only string lists are possible)</li><li>The string</li></ol> + '///+<u>Return</u>: TRUE if the entry was deleted otherwise FALSE + Dim i as Integer : Dim EintragsNr as Integer : Dim ListenAnzahl as Integer + + ListenAnzahl = Val(lsList(0)) + EintragsNr = 0 + for i = 1 to ListenAnzahl + if lsList(i) = sText then + EintragsNr = i + i = ListenAnzahl + 1 + end if + next i + if EintragsNr = 0 then + ListDeleteString = FALSE + else + ListDeleteString = ListDelete ( lsList(), EintragsNr ) + end if +end function + +'------------------------------------------------------------------------- + +function ListInsert ( lsList() as String, ZeileNr%, sWert$ ) as Boolean + 'Author: tz + '///Inserts a string at a defined position in the list. + '///+<u>Input</u>: <ol><li>The list (only string lists are possible)</li><li>The position</li><li>The string</li></ol> + '///+<u>Return</u>: TRUE if the entry was inserted otherwise FALSE + Dim i% : Dim ListenAnzahl as Integer + + ListenAnzahl = Val(lsList(0)) + if ZeileNr% > ListenAnzahl then + ListInsert = FALSE + Exit Function + end if + + ' Nach hinten verschieben, hinten beginnend + for i% = ListenAnzahl to ZeileNr% step -1 + lsList( i%+1 ) = lsList( i% ) + next i% + + ' Einfuegen + lsList( ZeileNr% ) = sWert$ + lsFile(0) = ListenAnzahl + 1 + ListInsert = TRUE + +end function + +'------------------------------------------------------------------------- + +function ListRead ( lsList() as String, Datei$, optional sEncode as String ) as Boolean + 'Author: tz + '///+Opens a file and insert all rows into a list (row for row). + '///+<u>Input</u>: <ol><li>The list (old list entries will be deleted)</li><li>The file</li><li><b>optional</b>: The encoding "UTF8"</li></ol> + '///+<u>Return</u>: TRUE or FALSE if this routine can read the file. + Dim bUTF8 as Boolean + Dim i% + Dim CompareList(15000) as String + + if Dir( Datei$ ) = "" then + Warnlog "ListRead: " + Datei$ + " is missing!" + ListRead = FALSE + exit function + end if + + if IsMissing ( sEncode ) = TRUE then + bUTF8 = FALSE + else + if UCASE ( sEncode ) = "UFT8" OR UCASE ( sEncode ) = "UTF8" then + bUTF8 = TRUE + else + Warnlog "ListRead :" + sEncode + " - Encoding is unkown!" + bUTF8 = FALSE + end if + end if + + ListAllDelete ( lsList() ) ' clean up the list + + if bUTF8 = TRUE then + Dim textin as object, sfa as object, xInput as object ' for UTF-8-input-routines + Dim iC as Integer + + textin = createUnoService( "com.sun.star.io.TextInputStream" ) ' uno-handling to input an UFT-8-File + textin.setEncoding("utf8") ' + sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" ) ' + xInput = sfa.openFileRead( Datei$ ) ' + textin.setInputStream( xInput ) ' + + do until textin.isEOF() ' + i% = Val(lsList(0)) + 1 + lsList(0) = i% + lsList( i% ) = textin.readLine() ' + loop + xInput.closeInput ' uno-file-close + + 'INFO: (TZ) Only to workaround a problem with UNIX-Files... + if Right ( lsList(i%), 1 ) = Chr(10) then + lsList(i%) = Left ( lsList(i%), Len ( lsList(i%) ) - 1 ) + end if + 'INFO: (TBO) Remove the BOM http://www.unicode.org/versions/Unicode4.0.0/ch15.pdf + if (left(lsList(1), 1) = chr(&HFEFF)) then + lsList(1) = right(lsList(1), Len(lsList(1)) - 1) + end if + else + Dim FileNum% + + FileNum% = FreeFile + Open Datei$ for input as #FileNum% + + do until EOF(#FileNum%) ' all from LIS-file + i% = Val(lsList(0)) + 1 + lsList(0) = i% + Line Input #FileNum%, lsList( i% ) + loop + Close #FileNum% + end if + ListRead = TRUE +end function + +'------------------------------------------------------------------------- + +function ListWrite ( lsList() as String, Datei$, optional sEncode as String) as Boolean + 'Author: tz + '///+Writes a list into a file (an existing file will be deleted before) + '///+<u>Input</u>: <ol><li>The list</li><li>The file</li><li><b>optional</b>: The encoding "UTF8"</li></ol> + '///+<u>return</u>: TRUE or FALSE if this routine can read the file. + + Dim bUTF8 as Boolean + Dim i% + + if Dir (Datei$) <> "" then + Kill(Datei$) ' the file must be deleted if you use 'UTF8' + endif + + if IsMissing ( sEncode ) = TRUE then + bUTF8 = FALSE + else + if UCASE ( sEncode ) = "UTF8" then + bUTF8 = TRUE + else + Warnlog "ListWrite :" + sEncode + " - Encoding is unkown!" + bUTF8 = FALSE + end if + end if + + if bUTF8 = TRUE then + Dim textout as object, sfa as object, xOutput as object ' for UTF-8-output-routines + + textout = createUnoService( "com.sun.star.io.TextOutputStream" ) ' uno-handling to output an UFT-8-File + textout.setEncoding("utf8") ' + sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" ) ' + xOutput = sfa.openFileWrite( Datei$ ) ' + textout.setOutputStream( xOutput ) ' + + for i%=1 to ListCount ( lsList() ) + textout.writeString( lsList( i% ) + Chr(13) + Chr(10) ) ' + next i% + xOutput.closeOutput ' uno-file-close + else + Dim FileNum% : Dim iLast% + + FileNum% = FreeFile + Open Datei$ for Output as #FileNum% + iLast% = Val(lsList(0)) + i%=1 + do while i% <= iLast% + Print #FileNum%, lsList(i%) + i% = i% +1 + loop + Close #FileNum% + endif + + ListWrite = TRUE +end function + +'------------------------------------------------------------------------- + +function ListReadAppend( lsList() as String , Datei$, optional sEncode as String ) as Boolean + 'Author: tz + '///+Appends a list into a file (If the file exists the file will be deleted before!). + '///+<u>Input</u>: <ol><li>The list</li><li>The file</li><li><b>optional</b>: The encoding "UTF8"</li></ol> + '///+<u>return</u>: TRUE or FALSE if this routine can read the file. + + Dim bUTF8 as Boolean + Dim i% + Dim CompareList() as String + Dim isCounter as Integer + Dim FileNum% + + if Dir( Datei$ ) = "" then + Warnlog "ListReadAppend : " + Datei$ + " is missing!" + ListReadAppend = FALSE + exit function + end if + + isCounter = ListCount ( lsList() ) + + if IsMissing ( sEncode ) = TRUE then + bUTF8 = FALSE + else + if UCASE ( sEncode ) = "UFT8" OR UCASE ( sEncode ) = "UTF8" then + bUTF8 = TRUE + else + Warnlog "ListRead : " + sEncode + " - Encoding is unkown!" + bUTF8 = FALSE + end if + end if + + if bUTF8 = TRUE then + Dim textin as object, sfa as object, xInput as object ' for UTF-8-input-routines + + textin = createUnoService( "com.sun.star.io.TextInputStream" ) ' uno-handling to input an UFT-8-File + textin.setEncoding("utf8") ' + sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" ) ' + xInput = sfa.openFileRead( Datei$ ) ' + textin.setInputStream( xInput ) ' + + do until textin.isEOF() ' + i% = Val(lsList(0)) + 1 + lsList(0) = i% + lsList( i% ) = textin.readLine() ' + loop + xInput.closeInput ' uno-file-close + + 'INFO: (TZ) Only to workaround a problem with UNIX-Files... + if Right ( lsList(i%), 1 ) = Chr(10) then + lsList(i%) = Left ( lsList(i%), Len ( lsList(i%) ) - 1 ) + end if + '... + else + FileNum% = FreeFile + Open Datei$ for input as #FileNum% + + do until EOF(FileNum%) ' All from LIST-file + i% = Val(lsList(0)) + 1 + lsList(0) = i% + Line Input #FileNum%, lsList( i% ) + loop + Close #FileNum% + end if + + ListReadAppend = TRUE + +end function + +'------------------------------------------------------------------------- + +function ListWriteAppend( lsList() as String, Datei$, optional sEncode as String ) as Boolean + 'Author: tz + '///+Writes a list into a file (If the files exist all entries will be appended). + '///+<u>Input</u>: <ol><li>The list</li><li>The file</li><li><b>optional</b>: The encoding "UTF8"</li></ol> + '///+<u>return</u>: TRUE or FALSE if this routine can read the file. + + Dim bUTF8 as Boolean + Dim i% + Dim DummyList ( 15000 ) as String + + if IsMissing ( sEncode ) = TRUE then + bUTF8 = FALSE + else + if UCASE ( sEncode ) = "UTF8" then + bUTF8 = TRUE + else + Warnlog "ListRead :" + sEncode + " - Encoding is unkown!" + bUTF8 = FALSE + end if + end if + + if bUTF8 = TRUE then + Dim sfa as object, xOutput as object, textout as object ' for UTF-8-output-routines + + ListRead ( DummyList(), Datei$, "utf8" ) ' read old file in another list + for i% = 1 to ListCount ( lsList() ) + ListAppend ( DummyList(), lsList(i%) ) ' add the new list at the old list + next i% + + textout = createUnoService( "com.sun.star.io.TextOutputStream" ) ' uno-handling to output an UFT-8-File + textout.setEncoding("utf8") ' + sfa = createUnoService( "com.sun.star.ucb.SimpleFileAccess" ) ' + xOutput = sfa.openFileWrite( Datei$ ) ' + textout.setOutputStream( xOutput ) ' + + for i%=1 to ListCount (DummyList()) + textout.writeString( DummyList( i% ) + Chr(13) + Chr(10 ) ' + next i% + xOutput.closeOutput ' uno-file-close + else + Dim FileNum% + + FileNum% = FreeFile + Open Datei$ for Append as #FileNum% + + for i% = 1 to Val(lsList(0)) + Print #FileNum%, lsList(i%) + next i% + + Close #FileNum% + end if + ListWriteAppend = TRUE + +end function + +'------------------------------------------------------------------------- + +sub ListSort ( lsList() as String, optional UpDown as Boolean ) + 'Author: tz + '///+Sorts a list upward per default or downward if optional parameter is FALSE with quicksort method. + '///+<u>Input</u>: Unsorted list + + Dim Listenanzahl as Integer, i as Integer, j as Integer + Dim Zwischenspeicher as String + + ListenAnzahl = Val(lsList(0)) + for i=ListenAnzahl-1 to 1 step -1 + for j=1 to i + if UpDown = FALSE then + ' upward sorting + if uCase ( lsList(j) ) < uCase ( lsList(j+1) ) then + Zwischenspeicher = lsList (j) ' invert value (i) with value (i+1) + lsList (j) = lsList(j+1) + lsList (j+1) = Zwischenspeicher + end if + else + ' Downward sorting + if uCase ( lsList(j) ) > uCase ( lsList(j+1) ) then + Zwischenspeicher = lsList (j) ' invert value (i) with value (i+1) + lsList (j) = lsList(j+1) + lsList (j+1) = Zwischenspeicher + end if + end if + next j + next i +end sub + +'******************************************************************************* + +function gCompare2Lists( aListOne() as String, aListTwo() as String ) as boolean + + const CFN = "global::tools::inc::t_list.inc::gCompare2Lists: " + + '///<h3>Compare two lists with each other, where <b>list TWO</b> is the reference</h3> + '///<ul> + + dim aOneOnlyList( ubound( aListOne() ) ) as string + dim aTwoOnlyList( ubound( aListTwo() ) ) as string + + dim iListOneIndex as integer + dim iListTwoIndex as integer + + dim bFound as boolean + dim brc as boolean ' returncode: true if lists are identical + brc = true + + '///+<li>Create a copy of list two so we do not change the original list</li> + ListCopy( aListTwo() , aTwoOnlyList() ) + + '///+<li>Step through each item in list one</li> + for iListOneIndex = 1 to ListCount( aListOne() ) + + bFound = false + + '///+<li>Compare it to each item in list two</li> + for iListTwoIndex = 1 to ListCount( aTwoOnlyList() ) + + '///+<li>If the entries match, delete it from the TwoOnly list</li> + if ( aListOne( iListOneIndex ) = aTwoOnlyList( iListTwoIndex ) ) then + + bFound = true + ListDelete( aTwoOnlyList() , iListTwoIndex ) + exit for + + end if + + next iListTwoIndex + + '///+<li>If there is no match, the item exists in list one only -> copy</li> + if ( not bFound ) then + ListAppend( aOneOnlyList() , aListOne( iListOneIndex ) ) + end if + + next iListOneIndex + + '///+<li>List all items that exist in List One only</li> + if ( ListCount( aOneOnlyList() ) > 0 ) then + warnlog( CFN & "Objects have been added to the list" ) + hListPrint( aOneOnlyList() , "Items found in list ONE only (NEW)" ) + brc = false + end if + + '///+<li>List all items that exist in List Two only</li> + if ( ListCount( aTwoOnlyList() ) > 0 ) then + warnlog( CFN & "Objects have been removed from the list" ) + hListPrint( aTwoOnlyList() , "Items found in list TWO only (MISSING)" ) + brc = false + end if + + gCompare2Lists() = brc + '///</ul> + +end function + +'******************************************************************************* + +function hListPrint( lsList() as string , optional cComment as string ) as integer + + const CFN = "global::tools::inc::t_list.inc::hListPrint: " + + '///<h3>Print the content of a list to the log with a heading comment</h3> + '///<ul> + + dim iListItem as integer + + '///+<li>If no comment is provided we print a qaerrorlog</li> + if ( ismissing( cComment ) ) then + qaerrorlog( CFN & "Please provide any string as second parameter." ) + cComment = "" + end if + + '///+<li>Print a comment if desired</li> + if ( cComment <> "" ) then + printlog( "" ) + printlog( CFN & cComment ) + printlog( "" ) + end if + + '///+<li>Print all items in the list to the log</li> + for iListItem = 1 to listcount( lsList() ) + printlog( "(" & iListItem & ") : " & lsList( iListItem ) ) + next iListItem + + '///+<li>Return the number of listitems to the calling function</li> + hListPrint() = listcount( lsList() ) + + '///</ul> + +end function + +'******************************************************************************* + +function hListClearPattern( lsList() as string, cPattern as string ) as integer + + '///<h3>Search a list for the occurrence of a special pattern.</h3> + '///+ If the pattern is found, the entries are deleted, the new size of the + '///+ array is returned. + + dim iCurItem as integer + iCurItem = 1 + + do while ( iCurItem <= listcount( lsList() ) ) + + if ( instr( lsList( iCurItem ) , cPattern ) <> 0 ) then + listdelete( lsList() , iCurItem ) + else + iCurItem = iCurItem + 1 + end if + + loop + + hListClearPattern() = listcount( lsList() ) + +end function + +'******************************************************************************* + +function hListClearBlank( lsList() as string ) as integer + + '///<h3>Search a list for blank lines and remove them.</h3> + + dim iCurItem as integer + iCurItem = 1 + + do while ( iCurItem <= listcount( lsList() ) ) + + if ( len( lsList( iCurItem ) ) = 0 ) then + listdelete( lsList() , iCurItem ) + else + iCurItem = iCurItem + 1 + end if + + loop + + hListClearBlank() = listcount( lsList() ) + +end function + +'******************************************************************************* + +function hListIntegrityTest( sList() as string ) as boolean + + const CFN = "global::tools::inc::t_list.inc::hListIntegrityTest:" + + '///<h3>Verify that listcount( array ) < ubound( array )</h3> + ' NOTE: some listfunctions fail if ubound = listcount + + dim iListCount as integer + dim iUbound as integer + + iListCount = listcount( sList() ) + iUbound = ubound( sList() ) + + if ( iListCount >= iUbound ) then + warnlog( CFN & "ListCount points beyond array boundary" ) + warnlog( CFN & "ListCount: " & iListCount ) + warnlog( CFN & "UBOUND...: " & iUbound ) + hListIntegrityTest() = false + exit function + end if + + hListIntegrityTest() = true + +end function + + diff --git a/testautomation/global/tools/includes/required/t_menu.inc b/testautomation/global/tools/includes/required/t_menu.inc new file mode 100755 index 000000000000..5d46d77e9449 --- /dev/null +++ b/testautomation/global/tools/includes/required/t_menu.inc @@ -0,0 +1,1036 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_menu.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* Owner : thorsten.bosbach@sun.com +'* +'* short description : wrappers for accessing menues (context-, bar-, button- menues) +'* +'*********************************************************************************** +' #1 hMenuItemGetCount +' #1 hMenuSelectNr +' #1 hMenuItemCheck +' #1 hMenuItemUnCheck +' #1 hMenuFindSelect +' #1 hMenuItemIsChecked +' #1 hMenuItemIsEnabled +' #1 hMenuItemGetText +' #1 hMenuItemGetTextMitTilde +' #1 hMenuGetTextList +' #1 hMenuGetTextListMitTilden +' #1 hMenuGetListOhneTilde +' #1 hMenuGetTildenList +' #1 hhEntferneTilde +' #1 hMenuGetItemCommand +' #1 hWindowGetCount +' #1 hWindowGetIndex +' #1 hWindowGetText +' #1 hWindowSelect +' #1 hUseMenu +' #1 hMenuClose +' #1 hOeffneNeuImMenue +' #1 hOeffneEinstellungenImMenue +' #1 hOeffneImMenue +' #1 hGetWindowCaption +' #1 fSplitWindowTitle +' #1 hMenuGetItemID +' #1 hOpenContextMenu +'\***************************************************************** + +function hMenuItemGetCount as Integer +'/// OUTPUT: number of entries in the activated menu (without seperators) ///' +'///+ menu left open ///' + Dim i, j, Ende, nID as Integer + Sleep 2 + + j=0 + for i=1 to MenuGetItemCount + if NOT MenuIsSeperator ( i ) then j=j+1 + next i + hMenuItemGetCount = j +end function + +'------------------------------------------------------------------------- + +function hMenuSelectNr ( EintragsNr as Integer ) as String +'/// Selects the given nr. of <b>enabled</b> menu entry. +'/// <u>Note</u>: If there are disabled menu items are included the routine ignores them! +'///INPUT : number of entry from the top (>=1) OR +'///INPUT : number of entry from the bottom (<=-1) +'///INPUT : 0 to close menu +'///+ OUTPUT: text of the entry + Dim i, j, RealEnd, Ende as Integer + Dim nID as long + Sleep 2 + + Ende = EintragsNr + RealEnd = MenuGetItemCount + If (Ende > 0) then + if Ende > RealEnd then + Warnlog "hMenuSelectNr canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=0 + for i=1 to Ende + if MenuIsSeperator ( i+j ) then j = j+1 + next i + else + if ((RealEnd + Ende) < 0) then + Warnlog "hMenuSelectNr canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=1 + for i=-1 to Ende step -1 + if MenuIsSeperator (RealEnd +i+j) then dec(j) + next i + j = j + RealEnd + endif + if EintragsNr = 0 then + hMenuClose + exit function + endif + nID = MenuGetItemID ( EintragsNr+j ) + hMenuSelectNr = MenuGetItemText ( nID ) + MenuSelect ( nID ) +end function + +function hMenuItemCheck ( EintragsNr as Integer ) as String +'/// check the menu item (if it is checked, it stays checked) ///' +'///+ INPUT : number of entry from the top (>=1)///' +'///+ OUTPUT: text of the entry ///' + Dim i as Integer, j as Integer, RealEnd as Integer, Ende as Integer, nID as Integer + + Ende = EintragsNr + RealEnd = hMenuItemGetCount + if Ende > RealEnd then + Warnlog "hMenuItemCheck canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=0 + for i=1 to Ende + if MenuIsSeperator ( i+j ) then j = j+1 + next i + nID = MenuGetItemID ( EintragsNr+j ) + hMenuItemCheck = MenuGetItemText ( nID ) + if NOT MenuIsItemChecked ( nID ) then + MenuSelect ( nID ) + else + hMenuClose + end if +end function + +function hMenuItemUnCheck ( EintragsNr as Integer ) as String +'/// UNcheck the menu item (if it is UNchecked, it stays UNchecked) ///' +'///+ INPUT : number of entry from the top (>=1)///' +'///+ OUTPUT: text of the entry ///' + Dim i, j, RealEnd, Ende, nID as Integer + + Ende = EintragsNr + RealEnd = hMenuItemGetCount + if Ende > RealEnd then + Warnlog "hMenuItemUnCheck canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=0 + for i=1 to Ende + if MenuIsSeperator ( i+j ) then j = j+1 + next i + nID = MenuGetItemID ( EintragsNr+j ) + hMenuItemUnCheck = MenuGetItemText ( nID ) + if MenuIsItemChecked ( nID ) then + MenuSelect ( nID ) + else + hMenuClose + end if +end function + +'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + +function hMenuFindSelect(MenuID as variant, SelectSlot as Boolean, ExpectedNr as integer, optional VerboseWrongPosition as Boolean) as Boolean +'/// Find specified MenuID in Menu, check if its found on the expected place, ///' +'/// if not - report the correct slot, and if specified to do so - Select the correct slot. ///' +'///+ INPUT: MenuID: the string-name of the menu-entry we are lookin for. ///' +'///+ INPUT: TRUE, if the slot should be called, ///' +'///+ FALSE, if the slot shouldn't be called. ///' +'///+ INPUT: Optional: TRUE, if errors should be reported. ///' +'///+ FALSE, silent mode for errors. ///' +'///+ INPUT: Optional: The Expected Number of entry from the top (>=1) ///' +'///+ OUTPUT: If not found at the expected place - the correct Entry-number is reported ///' + Dim i as Integer + Dim RealId as Integer + Dim RealPosition as Integer + Dim MenuIDAsNumber as integer + Dim MenuIDAsString as string + Dim RealEnd as Integer + Dim nID as string + Dim found as string + Dim StringType as Boolean + + '/// find out if we are going to search for an ID, or a string (.uno:) ///' + if IsNumeric(MenuID) then + MenuIDAsNumber = MenuID + StringType = FALSE + else + MenuIDAsString = MenuID + StringType = TRUE + end if + + RealEnd = MenuGetItemCount + if ExpectedNr > RealEnd then + Warnlog "Entry number "+ ExpectedNr +" is higher than the number of entries (" + RealEnd + ") in this menu! " + end if + + if StringType = FALSE then 'Search for the number. + + nID = MenuGetItemID ( ExpectedNr ) + if nID <> MenuID then + if VerboseWrongPosition = TRUE then + warnlog " the questioned ID (" + MenuID + ") were not found on position " + ExpectedNr + end if + Found = FALSE + for i=1 to RealEnd + nID = MenuGetItemID (i) + printlog "For the position '" + i + "', the ItemCommand was: " + MenuGetItemCommand (MenuGetItemID (i)) + " and the ID was: " + MenuGetItemID (i) + "." + if nID = MenuID then + Found = TRUE + RealID = MenuGetItemID (i) + RealPosition = i + if VerboseWrongPosition = TRUE then + warnlog "The real Position (Separators included) was: " + i + end if + i = RealEnd + end if + next i + else + Found = TRUE + RealPosition = ExpectedNr + RealId = MenuGetItemID (ExpectedNr) + end if + + if Found = TRUE then + if SelectSlot then + MenuSelect (RealID) + hMenuFindSelect = TRUE + else + printlog "the slot was found, but the tester had choosen NOT to open the slot" + hMenuFindSelect = TRUE + hMenuClose + end if + else + if VerboseWrongPosition = TRUE then + warnlog "The slot was NOT found. Has either been removed, or it's a bug." + end if + hMenuFindSelect = FALSE + hMenuClose + end if + + else 'StringType = TRUE : Seach for the .uno; -name. + nID = lCase(MenuGetItemCommand (MenuGetItemID (ExpectedNr))) + + if nID <> lCase(MenuID) then + if VerboseWrongPosition = TRUE then + warnlog " the questioned ID (" + MenuID + ") were not found on position " + ExpectedNr + end if + Found = FALSE + for i=1 to RealEnd + nID = MenuGetItemCommand (MenuGetItemID (i)) + printlog "For the position '" + i + "', the ItemCommand was: " + nID + " and the ID was: " + MenuGetItemID (i) + "." + if nID = MenuID then + Found = TRUE + RealID = MenuGetItemID (i) + RealPosition = i + if VerboseWrongPosition = TRUE then + warnlog "The real Position (Separators included) was: " + i + end if + i = RealEnd + end if + next i + else + Found = TRUE + RealPosition = ExpectedNr + RealId = MenuGetItemID (ExpectedNr) + end if + if Found = TRUE then + if SelectSlot then + MenuSelect (RealID) + hMenuFindSelect = TRUE + else + printlog "the slot was found, but the tester had choosen NOT to open the slot" + hMenuFindSelect = TRUE + hMenuClose + end if + else + if VerboseWrongPosition = TRUE then + warnlog "The slot was NOT found. Has either been removed, or it's a bug." + end if + hMenuFindSelect = FALSE + hMenuClose + end if + end if 'StringType = TRUE + wait 200 'Wait 0,2 seconds in case we just have called a Submenu. +end function + +'---------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------------- + +function hMenuItemIsChecked ( EintragsNr as Integer ) as Boolean +'/// is the the menu item checked ? ///' +'///+ INPUT : number of entry from the top (>=1)///' +'///+ OUTPUT: True = yes!, False = no! ///' + Dim i, j, Ende, RealEnd, nID as Integer + + Ende = EintragsNr + RealEnd = hMenuItemGetCount + if Ende > RealEnd then + Warnlog "hMenuItemIsChecked canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=0 + for i=1 to Ende + if MenuIsSeperator ( i+j ) then j = j+1 + next i + nID = MenuGetItemID ( EintragsNr + j ) + hMenuItemIsChecked = MenuIsItemChecked ( nID ) +end function + +function hMenuItemIsEnabled ( EintragsNr as Integer ) as Boolean +'/// is the the menu item enabled (not greyed out) ? ///' +'///+ INPUT : number of entry from the top (>=1)///' +'///+ OUTPUT: True = yes!, False = no! ///' +'///+ menu left open ///' + Dim i, j, Ende, RealEnd, nID as Integer + + Ende = EintragsNr + RealEnd = MenuGetItemCount + if Ende > RealEnd then + Warnlog "hMenuItemIsEnabled canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=0 + for i=1 to Ende + if MenuIsSeperator ( i+j ) then j = j+1 + next i + nID = MenuGetItemID ( EintragsNr + j ) + hMenuItemIsEnabled = MenuIsItemEnabled ( nID ) +end function + +function hMenuItemGetText ( EintragsNr as Integer ) as String +'///+ INPUT : number of entry from the top (>=1)///' +'///+ OUTPUT: text of item without tilde ///' +'///+ menu left open ///' + Dim i, j, RealEnd, Ende, nID as Integer + + Ende = EintragsNr + RealEnd = MenuGetItemCount + if Ende > RealEnd then + Warnlog "hMenuItemGetText canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=0 + for i=1 to Ende + if MenuIsSeperator ( i+j ) then j = j+1 + next i + nID = MenuGetItemID ( EintragsNr + j ) + hMenuItemGetText = hhEntferneTilde ( MenuGetItemText ( nID ) ) +end function + +function hMenuItemGetTextMitTilde ( EintragsNr as Integer ) as String +'/// INPUT : number of entry from the top (>=1)///' +'///+ OUTPUT: text of item with tilde (which indicates the shortcurt of the entry)///' +'///+ menu left open ///' + Dim i, j, RealEnd, Ende, nID as Integer + + Ende = EintragsNr + RealEnd = MenuGetItemCount + if Ende > RealEnd then + Warnlog "hMenuItemGetTextMitTilde canceled: Entry number "+ Ende +" does not exists, because there are only " + RealEnd + " entries! " + hMenuClose + exit function + end if + j=0 + for i=1 to Ende + if MenuIsSeperator ( i+j ) then j = j+1 + next i + nID = MenuGetItemID ( EintragsNr + j ) + hMenuItemGetTextMitTilde = MenuGetItemText ( nID ) +end function + +function hMenuGetTextList ( lsEintragsliste() as String ) as Integer +'/// INPUT : a 'list-variable' aka string array; ///' +'///+ OUTPUT: number of entries in the menue/list; the list-variable contains now the strings of the menu (withOUT tildes) ///' +'///+ menu left open ///' + Dim i, j, nID as Integer + Dim Eintrag as String + + lsEintragsListe(0) = 0 + j=0 + for i=1 to MenuGetItemCount + if NOT MenuIsSeperator ( i ) then + nID = MenuGetItemID ( i ) + Eintrag = hhEntferneTilde ( MenuGetItemText ( nID ) ) + ListAppend ( lsEintragsListe(), Eintrag ) + j=j+1 + end if + next i + hMenuGetTextList = j +end function + +function hMenuGetTextListMitTilden ( lsEintragsliste() as String ) as Integer +'/// INPUT : a 'list-variable' aka string array; ///' +'///+ OUTPUT: number of entries in the menue/list; the list-variable contains now the strings of the menu (with tildes) ///' +'///+ menu left open ///' + Dim i, j, nID as Integer + Dim Eintrag as String + + lsEintragsListe(0) = 0 + j=0 + for i=1 to MenuGetItemCount + if NOT MenuIsSeperator ( i ) then + nID = MenuGetItemID ( i ) + Eintrag = MenuGetItemText ( nID ) + ListAppend ( lsEintragsListe(), Eintrag ) + j=j+1 + end if + next i + hMenuGetTextListMitTilden = j +end function + +function hMenuGetListOhneTilde ( lsEintragsliste() as String ) as Integer +'/// put the entries of the menues in a list that don't have a tilde -> BUG ///' +'///+ INPUT : a 'list-variable' aka string array; ///' +'///+ OUTPUT: number of entries without a tilde; the list-variable contains now the strings of the menu without tildes ///' +'///+ menu left open ///' + Dim i, j, nID as Integer + Dim Eintrag as String + + lsEintragsListe(0) = 0 + j=0 + for i=1 to MenuGetItemCount + if NOT MenuIsSeperator ( i ) then + nID = MenuGetItemID ( i ) + Eintrag = MenuGetItemText ( nID ) + if Eintrag = ( hhEntferneTilde ( Eintrag ) ) then + ListAppend ( lsEintragsListe(), Eintrag ) + j=j+1 + end if + end if + next i + hMenuGetListOhneTilde = j +end function + +function hMenuGetTildenList ( lsEintragsliste() as String ) as Integer +'/// put the entries of the menues in a list that HAVE a tilde ///' +'///+ INPUT : a 'list-variable' aka string array; ///' +'///+ OUTPUT: number of entries a tilde; the list-variable contains now the strings of the menu with tildes ///' +'///+ menu left open ///' + Dim i, j, nID, Stelle as Integer + Dim Eintrag as String + + lsEintragsListe(0) = 0 + j=0 + for i=1 to MenuGetItemCount + if NOT MenuIsSeperator ( i ) then + nID = MenuGetItemID ( i ) + Eintrag = MenuGetItemText ( nID ) + " - " + Stelle = Instr ( 1, Eintrag, "~", 1 ) + if Stelle <> 0 then + Eintrag = Eintrag + Mid ( Eintrag, Stelle, 2 ) + end if + ListAppend ( lsEintragsListe(), Eintrag ) + j=j+1 + end if + next i + hMenuGetTildenList = j +end function + + +sub hMenuClose +'/// close menue ///' +'///+ after a hMenuClose you have to execute Kontext.UseMenu again +'///+ if you want to open any other menu. + MenuSelect ( 0 ) +end sub + +' *************************************************************************** +' ************ subroutines ***************** +' *************************************************************************** + +function hhEntferneTilde ( sEintrag as String ) as String +'///+ INPUT : string with tilde ///' +'///+ OUTPUT: string without tilde ///' + Dim i + i = Instr ( 1, sEintrag, "~", 1 ) + if i <> 0 then + hhEntferneTilde = Left ( sEintrag, i-1 ) + Right ( sEintrag, ( Len(sEintrag) - i ) ) + else + hhEntferneTilde = sEintrag + end if +end function + +sub hOeffneNeuImMenue +'/// open the entry 'new' in all languages in a menu ///' +'///+ menue has to be opened before! ///' + Dim SpracheNeu as string + Dim Treffer as string + Dim y, GrossesEnde, openID as integer + + select case iSprache + case 01 : SpracheNeu = "New" + case 03 : SpracheNeu = "Novo" + case 31 : SpracheNeu = "Nieuw" + case 33 : SpracheNeu = "Nouveau" + case 34 : SpracheNeu = "Nuevo" + case 39 : SpracheNeu = "Nuovo" + case 46 : SpracheNeu = "Nytt" + case 49 : SpracheNeu = "Neu" + case else : warnlog "Sprache nicht aufgenommen in hOeffneImMenue!!!!" + end select + GrossesEnde = MenuGetItemCount + + for y=1 to GrossesEnde-1 + Treffer = hMenuItemGetText ( y ) + if InStr ( Treffer , SpracheNeu ) > 0 then + Exit For + end if + next y + hMenuSelectNr ( y ) +end sub + +sub hOeffneEinstellungenImMenue +'/// open the entry 'Properties' in all languages in a menu ///' +'///+ menue has to be opened before! ///' + Dim SpracheEinstellungen as string + Dim Treffer as string + Dim y, GrossesEnde, openID as integer + + select case iSprache + + case 01 : SpracheEinstellungen = "Properties" + case 03 : SpracheEinstellungen = "Eigenschaften" + case 31 : SpracheEinstellungen = "Eigenschappen" + case 33 : SpracheEinstellungen = "Prop" + case 34 : SpracheEinstellungen = "Eigenschaften" + case 39 : SpracheEinstellungen = "Propriet" + case 46 : SpracheEinstellungen = "Egenskaper" + case 49 : SpracheEinstellungen = "Eigenschaften" + case else : warnlog "Sprache nicht aufgenommen in hOeffneEinstellungenImMenue!!!!" + + end select + GrossesEnde = MenuGetItemCount + + for y=1 to GrossesEnde-1 + Treffer = hMenuItemGetText ( y ) + if InStr ( Treffer , SpracheEinstellungen ) > 0 then + Exit For + end if + next y + hMenuSelectNr ( y ) +end sub + +sub hOeffneImMenue ( OeffneDas$ ) +'/// open an entry in in a menu ///' +'///+ INPUT: string of emntry to open ///' +'///+ menue has to be opened before! ///' +Dim Treffer as string + Dim y, GrossesEnde, openID as integer + GrossesEnde = MenuGetItemCount + + for y=1 to GrossesEnde-1 + Treffer = hMenuItemGetText ( y ) + if InStr ( Treffer , OeffneDas$ ) > 0 then + Exit For + end if + next y + hMenuSelectNr ( y ) + sleep(2) +end sub + +'------------------------------------------------------------------------- + +function hMenuGetItemCommand ( EintragsNr as Integer ) as String +'/// <u>hMenuGetItemCommand(Nr)</u> /// +'///+ To read the slot/UNO slot which is behind a menu item. /// +'///+ Seperators will be ignored for the input INTEGER! + Dim i as integer + Dim j as integer + Dim RealEnd as integer + Dim DasEnde as integer + Dim nID as Integer + DasEnde = EintragsNr + RealEnd = MenuGetItemCount + if DasEnde > RealEnd then + warnlog "Parameter (" & DasEnde & ") bigger than items in menu (" & RealEnd & ") , 'hMenuGetItemCommand' canceled." + else + j=0 + for i=1 to DasEnde + if MenuIsSeperator ( i+j ) then + j = j+1 + end if + next i + nID = MenuGetItemID ( EintragsNr+j ) + hMenuGetItemCommand = MenuGetItemCommand ( nID ) + end if +end function + +function hMenuGetItemId ( EintragsNr as Integer ) as integer +'///+ To read the Slot ID which is behind a menu item. /// +'///+ Seperators will be ignored for the input INTEGER! + Dim i as integer + Dim j as integer + Dim RealEnd as integer + Dim DasEnde as integer + DasEnde = EintragsNr + RealEnd = MenuGetItemCount + if DasEnde > RealEnd then + warnlog "Parameter (" & DasEnde & ") bigger than items in menu (" & RealEnd & ") , 'hMenuGetItemId' canceled." + else + j=0 + for i=1 to DasEnde + if MenuIsSeperator ( i+j ) then + j = j+1 + end if + next i + hMenuGetItemId = MenuGetItemID ( EintragsNr+j ) + end if +end function + +'------------------------------------------------------------------------- + + +'/// Functions for the lower part of the 'Window' Menu ///' +'///+ philosophie: you can't do any actions on the first document -> it get's the number 0 and it doesn't count ///' +'///+ so the first window you can work with gets the number 1 and counting starts with 1 ... ///' + +'///<b> function hUseMenu () </b>///' +'///+ very global function: depends on 'gApplication' just activates the menu-bar ///' + +'///<b> function hWindowGetCount () as integer </b>///' +'///+ returns the number of windows (all inclusive the first one!) ///' + +'///<b> function hWindowGetIndex () as integer </b>///' +'///+ returns the number of the active window ///' + +'///<b> function hWindowGetText (optional iWindow as integer) as string </b>///' +'///+ returns the text of the menu entry without the tilde: ///' +'///+ w/ calling parameter: the active window ///' +'///+ w/o calling parameter: the window i ///' + +'///<b> function hWindowSelect (iWindow as integer) </b>///' +'///+ switches to the window i ///' +'///+ calling parameter: id of the window to activate ///' + +'------------------------------------------------------------------------- + +function hWindowGetCount () as integer +'///<b> function hWindowGetCount () as integer </b>///' +'///+ returns the number of windows ///' + + 'uShort GetDocumentCount() ' testool command + hWindowGetCount = GetDocumentCount() +end function + +'------------------------------------------------------------------------- + +function hWindowGetIndex () as integer +'///<b> function hWindowGetIndex () as integer </b>///' +'///+ returns the number of the active window ///' + dim iMenues as integer ' takes the number of entries in the windows menue + dim iNotWindows as integer ' number of open windows + dim iKandidate as integer + dim i as integer + + iNotWindows = hWindowGetCount () + hUseMenu() + + iMenues = hMenuItemGetCount + hMenuSelectNr(iMenues-1) ' 'windows' ist usually the one before the last + wait 200 + iKandidate = 0 + iMenues = hMenuItemGetCount + for i = ((iMenues - iNotWindows) + 1) to iMenues + if (hMenuItemIsChecked (i)) then + if (iKandidate = 0) then + iKandidate = i + else + Warnlog "unexpected error 4711 - more than one window active??!! hWindowGetIndex () " + endif + endif + next i + iMenues = (iKandidate - (iMenues - iNotWindows) - 1) + hMenuClose + + hWindowGetIndex = iMenues +end function + +'------------------------------------------------------------------------- + +function hWindowGetText (optional iWindow as integer) as string +'///<b> function hWindowGetText (optional iWindow as integer) as string </b>///' +'///+ returns the text of the menu entry without the tilde: ///' +'///+ w/ calling parameter: the active window ///' +'///+ w/o calling parameter: the window i ///' + dim iMenues as integer ' takes the number of entries in the windows menue + dim iNotWindows as integer ' number of open windows + dim iUseWindow + + + if (isMissing(iWindow) = FALSE) then + iUseWindow = iWindow + else + iUseWindow = hWindowGetIndex() + endif + + iNotWindows = hWindowGetCount () + hUseMenu() + + iMenues = hMenuItemGetCount + hMenuSelectNr(iMenues-1) ' 'windows' ist usually the one before the last + wait 200 + iMenues = hMenuItemGetCount + hWindowGetText = hMenuItemGetTextMitTilde (iUseWindow + (iMenues - iNotWindows) + 1) + hWindowGetText = hhEntferneTilde(hWindowGetText) + hMenuClose +end function + +'------------------------------------------------------------------------- + +function hWindowSelect (iWindow as integer) +'///<b> function hWindowSelect (iWindow as integer) </b>///' +'///+ switches to the window i ///' +'///+ calling parameter: id of the window to activate ///' + dim iMenues as integer ' takes the number of entries in the windows menue + dim iNotWindows as integer ' number of open windows + + iNotWindows = hWindowGetCount () + hUseMenu() + + 'ActivateDocument iNumber as integer ' is a testtool command, but there is no system that stays behind iNumber :-[ + iMenues = hMenuItemGetCount + hMenuSelectNr(iMenues-1) ' 'windows' ist usually the one before the last + wait 200 + iMenues = hMenuItemGetCount + hMenuSelectNr (iWindow + 1 + (iMenues - iNotWindows)) +end function + +'------------------------------------------------------------------------- + +function hUseMenu () +'///<b> function hUseMenu () </b>///' +'///+ very global function: depends on 'gApplication' just activates the menu-bar ///' + Select Case Ucase(gApplication) + Case "WRITER" + Kontext "DocumentWriter" + DocumentWriter.UseMenu + + Case "MASTERDOC" + Kontext "DocumentMasterDoc" + DocumentMasterDoc.UseMenu + + Case "HTMLDOKUMENT" + Kontext "DocumentWriterWeb" + DocumentWriterWeb.UseMenu + + case "CALC" ' there are 2 entries over :-( usually only one, html 0 :-(((( + Kontext "DocumentCalc" + DocumentCalc.UseMenu + + case "DRAW" + Kontext "DocumentDraw" + DocumentDraw.UseMenu + + case "IMPRESS" + Kontext "DocumentImpress" + DocumentImpress.UseMenu + + case "MATH" : + Kontext "DocumentMath" + DocumentMath.UseMenu + + case "INSIGHT" : + Kontext "Insight" + Insight.UseMenu + + case "BASIC" : + Kontext "BasicIde" + BasicIde.UseMenu + + case "NONE" : + Kontext "DocumentBackground" + DocumentBackground.UseMenu + end select +end function + +'------------------------------------------------------------------------- + +function hOpenContextMenu() +'/// very global function: depends on 'gApplication' just opens the Context Menu ///' + Select Case Ucase(gApplication) + Case "WRITER" + Kontext "DocumentWriter" + DocumentWriter.openContextMenu + Case "MASTERDOC" + Kontext "DocumentMasterDoc" + DocumentMasterDoc.openContextMenu + Case "HTMLDOKUMENT" + Kontext "DocumentWriterWeb" + DocumentWriterWeb.openContextMenu + case "CALC" + Kontext "DocumentCalc" + DocumentCalc.openContextMenu + case "DRAW" + Kontext "DocumentDraw" + DocumentDraw.openContextMenu + case "IMPRESS" + Kontext "DocumentImpress" + DocumentImpress.openContextMenu + case "MATH" : + Kontext "DocumentMath" + DocumentMath.openContextMenu + end select +end function + +'------------------------------------------------------------------------- + +function hGetWindowCaption(sApplication as string, optional bAll as boolean) +'///<b> function hGetWindowCaption () </b>///' +'///+ just returns the string from the application main window ///' +'///+ If optional parameter = true, thenn go throught all applications and get caption; return array ///' + dim sTemp as string + dim aApplication() as string + dim aTemp(10) as string + dim iTimes as integer + dim i as integer + + aApplication = array("SWRITER","SGLOBAL","SWEB","SCALC","SDRAW","SIMPRESS","SMATH","BASIC","BACK") + if (isMissing(bAll) OR (NOT bAll)) then + iTimes = 0 + else + iTimes = uBound(aApplication()) + sApplication = aApplication(0) + endif + for i=0 to iTimes + Select Case Ucase(sApplication) + Case "SWRITER" + Kontext "DocumentWriter" + try + sTemp = DocumentWriter.caption + catch + endcatch + Case "SGLOBAL" + Kontext "DocumentMasterDoc" + try + sTemp = DocumentMasterDoc.caption + catch + endcatch + Case "SWEB" + Kontext "DocumentWriterWeb" + try + sTemp = DocumentWriterWeb.caption + catch + endcatch + case "SCALC" + Kontext "DocumentCalc" + try + sTemp = DocumentCalc.caption + catch + endcatch + case "SDRAW" + Kontext "DocumentDraw" + try + sTemp = DocumentDraw.caption + catch + endcatch + case "SIMPRESS" + Kontext "DocumentImpress" + try + sTemp = DocumentImpress.caption + catch + endcatch + case "SMATH" + Kontext "DocumentMath" + try + sTemp = DocumentMath.caption + catch + endcatch + Case "BASIC" + Kontext "BasicIDE" + try + sTemp = BasicIDE.caption + catch + endcatch + Case "BACK" + Kontext "DocumentBackground" + try + sTemp = DocumentBackground.caption + catch + endcatch + case else + qaErrorLog "sApplication not defined: '" + sApplication + "'" + sTemp = "" + end select + aTemp(i) = sTemp + try + sApplication=aApplication(i+1) + catch + endcatch + next i + if (iTimes > 0) then + hGetWindowCaption = aTemp() + else + hGetWindowCaption = sTemp + endif +end function + +'------------------------------------------------------------------------- + +function fSplitWindowTitle(sInString as string) + dim a, b, x, i as integer + dim sTemp() as string + dim sTempReturn(2) as string + dim sTempReturn2(3) as string + dim bTestToolCommunication as boolean + dim bDebugVersion as boolean ' aka 'nonpro' + dim bError as boolean + + ' a) 'Untitled2 - OpenOffice.org Draw' (2) + ' b) 'Untitled1 - OpenOffice.org Writer TTD :localhost[1034]' (4) + ' c) 'Untitled1 - StarOffice Writer [680m72(Build:8863)]' (3) + ' d) 'Untitled2 - StarOffice Draw [680m72(Build:8863)] TTD :localhost[1034]' (5) + + bTestToolCommunication = FALSE + bDebugVersion = FALSE + bError = FALSE + if (sInString <> "") then + ' ' - ' separates Filename from Vendor + a = instr(sInString, " - ") ' get Document file name or Untitledi + if (a > 1) then + if (instr(a+1,sInString, " - ") > a) then + qaErrorLog "Argh!" + bError = TRUE + endif + sTempReturn(0) = left(sInString, a-1) ' (0) Filename + else + sTempReturn(0) = "" + bError = TRUE + endif + + ' seperate second string by spaces + sTemp() = split(right(sInString, len(sInString)-(a+2)), " ") ' Parts are now separated by spaces + x = uBound(sTemp()) + + sTempReturn(1) = sTemp(1) ' (1) Application + sTempReturn(2) = sTemp(0) ' (2) Vendor + + ' if ']' at end... (b,c,d) + if (right(sInString,1) = "]") then + ' if ')' at second last position it is a nonpro! + if (right(sInString,2) = ")]") then + ' normal detection works with spaces... (c) + bDebugVersion = TRUE + else + ' remove TestTool communication string (b,d) + ' it is the last 2 space seperated parts! + bTestToolCommunication = TRUE + if (left(sTemp(2),1)="[") then + bDebugVersion = TRUE + endif + endif + else + ' normal detection with spaces works... (a) + endif + + ' sanity checks, to warn if assumptions are not met! + select case x + case 1: if ((bTestToolCommunication) OR (bDebugVersion)) then + qaErrorLog "t_menu.inc::fSplitWindowTitle: Unknown count of Window Title Strings! 1" + bError = TRUE + endif + case 2: if ((bTestToolCommunication) OR (NOT bDebugVersion)) then + qaErrorLog "t_menu.inc::fSplitWindowTitle: Unknown count of Window Title Strings! 2" + bError = TRUE + endif + case 3: if ((NOT bTestToolCommunication) OR (bDebugVersion)) then + qaErrorLog "t_menu.inc::fSplitWindowTitle: Unknown count of Window Title Strings! 3" + bError = TRUE + endif + case 4: if ((NOT bTestToolCommunication) OR (NOT bDebugVersion)) then + qaErrorLog "t_menu.inc::fSplitWindowTitle: Unknown count of Window Title Strings! 4" + bError = TRUE + endif + case else: qaErrorLog "t_menu.inc::fSplitWindowTitle: Unknown count of Window Title Strings! 0" + bError = TRUE + end select + + if bError then + printlog sInString + endif + + if (x > 1) then ' there is more to evaluate + ' save the current computed values + for i=0 to 2 + sTempReturn2(i) = sTempReturn(i) + next i + ' make return array bigger + redim sTempReturn(4) as string + ' copy data back + for i=0 to 2 + sTempReturn(i) = sTempReturn2(i) + next i + ' set remaining values, if exist + ' debug version string + if bDebugVersion then + sTempReturn(3) = mid(sTemp(2),2,len(sTemp(2))-2) ' optional (3) Debug Version + else + sTempReturn(3) = "" + endif + ' TestTool Communication string + if bTestToolCommunication then + ' if true, then always the two last strings + sTempReturn(4) = sTemp(x-1) + " " + sTemp(x) ' optional (4) TestTool Communication + else + sTempReturn(4) = "" + endif + endif + else + redim sTempReturn(0) as string + sTempReturn(0) = "" + endif + + fSplitWindowTitle = sTempReturn() +end function + diff --git a/testautomation/global/tools/includes/required/t_option.inc b/testautomation/global/tools/includes/required/t_option.inc new file mode 100755 index 000000000000..a23c19afeb1d --- /dev/null +++ b/testautomation/global/tools/includes/required/t_option.inc @@ -0,0 +1,588 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_option.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:10 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : General option test (sub-routines for options tests) +'* +'************************************************************************ +'* +' #1 hToolsOptions 'Select the correct page in Tools / Options +'* +'\*********************************************************************** + +function hToolsOptions ( Applicationname as string, Tabpagename as string, OPTIONAL bSilent as Boolean ) as Boolean + Dim bCorPage as Boolean + Dim bFirst as Boolean + Dim AnzahlEintraegeZu as Integer + Dim AnzahlEintraege as Integer + Dim i as Integer + Dim startpos as integer + +'///<i>hToolsOptions</i>: Routine to select the correct option page +'///+<u>input</u>: The groupname as string, name of optionpage as string +'///+<u>note</u>: The options dialog has to be opened +'///+<u>OPTIONAL</u>: TRUE as an additional parameter if you want a printlog instead of a warning if a page has not been found. + + if IsMissing(bSilent) then + bSilent = FALSE + end if + + Kontext "Active" + try + if Active.Exists(1) then Active.OK + catch + if Active.Exists(1) then Active.No + endcatch +'///Group names list: +'///+<ul><li>"StarOffice"</li> +'///+<li>"LoadSave"</li> +'///+<li>"LanguageSettings"</li> +'///+<li>"Internet"</li> +'///+<li>"Textdocument"</li> +'///+<li>"HTMLDocument"</li> +'///+<li>"Spreadsheet"</li> +'///+<li>"Presentation"</li> +'///+<li>"Drawing"</li> +'///+<li>"Formula"</li> +'///+<li>"Chart"</li> +'///+<li>"Datasource"</li></ul> + Kontext "ExtrasOptionenDlg" + + if ExtrasOptionenDlg.Exists then + Optionsliste.TypeKeys "<HOME>" + for i = 1 to 12+1 + Optionsliste.TypeKeys "-<DOWN>" + next i + 'Optionsliste.TypeKeys "<HOME>" + AnzahlEintraegeZu = Optionsliste.GetItemCount + select case Ucase$(Applicationname) + case "STAROFFICE" : startpos = 1 + case "LOADSAVE" : startpos = 2 + case "LANGUAGESETTINGS" : startpos = 3 + case "TEXTDOCUMENT" : if ((lcase(gApplication) = "writer")OR(lcase(gApplication) = "masterdoc")OR(lcase(gApplication) = "htmldokument")) then + startpos = 4 + else + qaErrorLog "please review your test; the OptionsSet '" + Applicationname + "' is not available for application '" + gApplication + "'" + exit function + endif + case "HTMLDOCUMENT" : if ((lcase(gApplication) = "writer")OR(lcase(gApplication) = "masterdoc")OR(lcase(gApplication) = "htmldokument")) then + startpos = 5 + else + qaErrorLog "please review your test; the OptionsSet '" + Applicationname + "' is not available for application '" + gApplication + "'" + exit function + endif + + case "SPREADSHEET" : if (lcase(gApplication) = "calc") then + startpos = 4 + else + qaErrorLog "please review your test; the OptionsSet '" + Applicationname + "' is not available for application '" + gApplication + "'" + exit function + endif + + case "PRESENTATION" : if ((lcase(gApplication) = "impress")OR(lcase(gApplication) = "draw")) then + startpos = 4 + else + qaErrorLog "please review your test; the OptionsSet '" + Applicationname + "' is not available for application '" + gApplication + "'" + exit function + endif + + case "DRAWING" : if ((lcase(gApplication) = "draw")OR(lcase(gApplication) = "impress")) then + startpos = 4 + else + qaErrorLog "please review your test; the OptionsSet '" + Applicationname + "' is not available for application '" + gApplication + "'" + exit function + endif + + case "FORMULA" : if (lcase(gApplication) = "math") then + startpos = 4 + else + qaErrorLog "please review your test; the OptionsSet '" + Applicationname + "' is not available for application '" + gApplication + "'" + exit function + endif + + case "DATASOURCES" : startpos = AnzahlEintraegeZu -2 + case "CHART" : startpos = AnzahlEintraegeZu -1 + case "INTERNET" : startpos = AnzahlEintraegeZu ' always the last one + case else : warnlog "hToolsOptions(): " + Applicationname + " / " + Tabpagename + " could not be found! Please review your testscript! '" + gApplication + "'" + exit function + end select + + Optionsliste.select Startpos + Optionsliste.typekeys "+" + AnzahlEintraege = Optionsliste.GetItemCount + bFirst = TRUE + for i = 1 to AnzahlEintraege - AnzahlEintraegeZu + bCorPage = FALSE + Kontext "ExtrasOptionenDlg" + Optionsliste.TypeKeys "<DOWN>" + sleep (1) + select case ucase$(Applicationname) + case "STAROFFICE" +'///Pages in group "StarOffice"are: +'///+<ul><li>"UserData"</li> +'///+<li>"General"</li> +'///+<li>"Memory"</li> +'///+<li>"View"</li> +'///+<li>"Print"</li> +'///+<li>"Paths"</li> +'///+<li>"Colors"</li> +'///+<li>"FontReplacement"</li> +'///+<li>"Security"</li> +'///+<li>"Appearence"</li> +'///+<li>"Accessibility"</li> +'///+<li>"Java"</li></ul> + select case ucase$(Tabpagename) + case "USERDATA" + Kontext "TabBenutzerdaten" + if TabBenutzerdaten.exists then bCorPage = TRUE + case "GENERAL" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabSonstigesAllgemein" + If TabSonstigesAllgemein.exists(2) then bCorPage = TRUE + case "MEMORY" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabMemory" + If TabMemory.exists(2) then bCorPage = TRUE + case "VIEW" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabAnsichtAllgemein" + If TabAnsichtAllgemein.exists(2) then bCorPage = TRUE + case "PRINT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 5 ) + bFirst = FALSE + Kontext "TabPrintStarOffice" + if TabPrintStarOffice.exists(2) then bCorPage = TRUE + case "PATHS" + if bFirst = TRUE then Optionsliste.Select ( startpos + 6 ) + bFirst = FALSE + Kontext "TabPfade" + If TabPfade.exists(2) then bCorPage = TRUE + case "COLORS" + if bFirst = TRUE then Optionsliste.Select ( startpos + 7 ) + bFirst = FALSE + Kontext "TabFarben" + If TabFarben.exists(4) then bCorPage = TRUE + case "FONTREPLACEMENT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 8 ) + bFirst = FALSE + Kontext "TabSchriftErsetzung" + If TabSchriftErsetzung.exists(2) then bCorPage = TRUE + case "SECURITY" + if bFirst = TRUE then Optionsliste.Select ( startpos + 9 ) + bFirst = FALSE + Kontext "TabSecurity" + If TabSecurity.exists(2) then bCorPage = TRUE + case "APPEARANCE" + if bFirst = TRUE then Optionsliste.Select ( startpos + 10 ) + bFirst = FALSE + Kontext "TabAppearance" + If TabAppearance.exists(2) then bCorPage = TRUE + case "ACCESSIBILITY" + if bFirst = TRUE then Optionsliste.Select ( startpos + 11 ) + bFirst = FALSE + Kontext "TabAccessibility" + If TabAccessibility.exists(2) then bCorPage = TRUE + case "JAVA" + if bFirst = TRUE then Optionsliste.Select ( startpos + 12 ) + bFirst = FALSE + Kontext "TabJava" + If TabJava.exists(2) then bCorPage = TRUE + case "ONLINEUPDATE" + if bFirst = TRUE then Optionsliste.Select ( startpos + 13 ) + bFirst = FALSE + Kontext "TabOnlineUpdate" + If TabOnlineUpdate.exists(2) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "LOADSAVE" +'///Pages in group "LoadSave"are: +'///+<ul><li>"General"</li> +'///+<li>"VBAProperties"</li> +'///+<li>"MicrosoftOffice"</li> +'///+<li>"HTMLCompatibility"</li></ul> + select case ucase$(Tabpagename) + case "GENERAL" + Kontext "TabSpeichern" + if TabSpeichern.exists then bCorPage = TRUE + case "VBAPROPERTIES" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabMicrosoftOffice97" + If WinwordBasicLaden.exists(4) then bCorPage = TRUE + case "MICROSOFTOFFICE" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabMicrosoftOffice2" + If Auswahl.exists(4) then bCorPage = TRUE + case "HTMLCOMPATIBILITY" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabHtml" + If TabHtml.exists(2) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "LANGUAGESETTINGS" +'///Pages in group "LanguageSettings"are: +'///+<ul><li>"Language"</li> +'///+<li>"WritingAids"</li> +'///+<li>"SearchingJapanese"</li> +'///+<li>"AsianLayout"</li></ul> +'///+<li>"Complex Text Layout"</li></ul> + Kontext "Active" + if Active.Exists then Active.OK + Kontext "ExtrasOptionenDlg" + select case ucase$(Tabpagename) + case "LANGUAGES" + Kontext "TabSprachen" + If TabSprachen.exists(2) then bCorPage = TRUE + case "WRITINGAIDS" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabLinguistik" + If TabLinguistik.exists(2) then bCorPage = TRUE + case "SEARCHINGINJAPANESE" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabJapaneseFind" + if TabJapaneseFind.exists(2) then bCorPage = TRUE + case "ASIANLAYOUT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabAsianLayoutOptions" + if TabAsianLayoutOptions.exists(2) then bCorPage = TRUE + case "COMPLEXTEXTLAYOUT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 5 ) + bFirst = FALSE + Kontext "TabComplexTextLayout" + if TabComplexTextLayout.exists(2) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "INTERNET" +'///Pages in group "Internet"are: +'///+<ul><li>"Proxy"</li> +'///+<li>"Search"</li></ul> + Kontext "Active" + if Active.Exists then Active.OK + Kontext "ExtrasOptionenDlg" + select case ucase$(Tabpagename) + case "PROXY" + Kontext "ProxyWarnung" + if ProxyWarnung.Exists then + NichtMehrAnzeigen.Check + ProxyWarnung.OK + end if + Kontext "TabProxyServer" + if TabProxyServer.exists(2) then bCorPage = TRUE + case "SEARCH" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabSuche" + If TabSuche.exists(2) then bCorPage = TRUE + case "EMAIL" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabEmail" + If TabEmail.exists(2) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "TEXTDOCUMENT" +'///Pages in group "TextDocument"are: +'///+<ul><li>"General"</li> +'///+<li>"View"</li> +'///+<li>"FormattinAids"</li> +'///+<li>"Grid"</li> +'///+<li>"BasicFonts"</li> +'///+<li>"BasicFontsAsian"</li> +'///+<li>"BasicFontsCTL"</li> +'///+<li>"Print"</li> +'///+<li>"Table"</li> +'///+<li>"Changes"</li></ul> + select case ucase$(Tabpagename) + case "GENERAL" + Kontext "TabLaden" + If TabLaden.exists then bCorPage = TRUE + case "VIEW" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabInhalteWriter" + If TabInhalteWriter.exists(2) then bCorPage = TRUE + case "FORMATTINGAIDS" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabDirektCursor" + If TabDirektCursor.exists(2) then bCorPage = TRUE + case "GRID" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabRaster" + If TabRaster.exists(2) then bCorPage = TRUE + case "BASICFONTS" + if bFirst = TRUE then Optionsliste.Select ( startpos + 5 ) + bFirst = FALSE + Kontext "TabGrundschriften" + If TabGrundschriften.exists(2) then bCorPage = TRUE + case "BASICFONTSASIAN" + if bFirst = TRUE then Optionsliste.Select ( startpos + 6 ) + bFirst = FALSE + Kontext "TabGrundschriftenASIAN" + If TabGrundschriftenASIAN.exists(2) then bCorPage = TRUE + case "BASICFONTSCTL" + if bFirst = TRUE then Optionsliste.Select ( startpos + 6 ) + bFirst = FALSE + Kontext "TabGrundschriftenCTL" + If TabGrundschriftenCTL.exists(2) then bCorPage = TRUE + case "PRINT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 6 ) + bFirst = FALSE + Kontext "TabDruckenWriter" + If TabDruckenWriter.exists(2) then bCorPage = TRUE + case "TABLE" + if bFirst = TRUE then Optionsliste.Select ( startpos + 7 ) + bFirst = FALSE + Kontext "TabTabelleOptionen" + If TabTabelleOptionen.exists(2) then bCorPage = TRUE + case "CHANGES" + if bFirst = TRUE then Optionsliste.Select ( startpos + 8 ) + bFirst = FALSE + Kontext "TabAenderungenWriter" + If TabAenderungenWriter.exists(2) then bCorPage = TRUE + case "COMPATIBILITY" + if bFirst = TRUE then Optionsliste.Select ( startpos + 9 ) + bFirst = FALSE + Kontext "TabCompatibility" + If TabCompatibility.exists(2) then bCorPage = TRUE + case "AUTOCAPTION" + if bFirst = TRUE then Optionsliste.Select ( startpos + 10 ) + bFirst = FALSE + Kontext "TabAutoCaption" + If TabAutoCaption.exists(2) then bCorPage = TRUE + case "MAILMERGEEMAIL" + if bFirst = TRUE then Optionsliste.Select ( startpos + 11 ) + bFirst = FALSE + Kontext "TabMailMergeEMail" + If TabMailMergeEMail.exists(2) then bCorPage = TRUE + + case else : bCorPage = FALSE + end select + case "HTMLDOCUMENT" +'///Pages in group "HTMLDocument"are: +'///+<ul><li>"General"</li> +'///+<li>"View"</li> +'///+<li>"Grid"</li> +'///+<li>"Print"</li> +'///+<li>"Table"</li> +'///+<li>"Source"</li> +'///+<li>"Background"</li></ul> + select case ucase$(Tabpagename) + case "VIEW" + Kontext "TabInhalteHTML" + If TabInhalteHTML.exists then bCorPage = TRUE + case "FORMATTINGAIDS" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabDirektCursor" + If TabDirektCursor.exists(2) then bCorPage = TRUE + case "GRID" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabRaster" + If TabRaster.exists(2) then bCorPage = TRUE + case "PRINT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabDruckenHTML" + If TabDruckenHTML.exists(2) then bCorPage = TRUE + case "TABLE" + if bFirst = TRUE then Optionsliste.Select ( startpos + 5 ) + bFirst = FALSE + Kontext "TabTabelleOptionen" + If TabTabelleOptionen.exists(2) then bCorPage = TRUE + case "BACKGROUND" + if bFirst = TRUE then Optionsliste.Select ( startpos + 6 ) + bFirst = FALSE + Kontext "TabHintergrund" + If TabHintergrund.exists then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "SPREADSHEET" +'///Pages in group "Spreadsheet"are: +'///+<ul><li>"General"</li> +'///+<li>"View"</li> +'///+<li>"Calculate"</li> +'///+<li>"Sortlists"</li> +'///+<li>"Changes"</li> +'///+<li>"Grid"</li> +'///+<li>"Print"</li></ul> + select case ucase$(Tabpagename) + case "GENERAL" + Kontext "TabLayoutCalc" + If TabLayoutCalc.exists(2) then bCorPage = TRUE + case "VIEW" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabInhaltCalc" + If TabInhaltCalc.exists(2) then bCorPage = TRUE + case "CALCULATE" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabBerechnen" + If TabBerechnen.exists(2) then bCorPage = TRUE + case "SORTLISTS" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabSortierlisten" + If TabSortierlisten.exists(2) then bCorPage = TRUE + case "CHANGES" + if bFirst = TRUE then Optionsliste.Select ( startpos + 5 ) + bFirst = FALSE + Kontext "TabAenderungenCalc" + If TabAenderungenCalc.exists(2) then bCorPage = TRUE + case "GRID" + if bFirst = TRUE then Optionsliste.Select ( startpos + 6 ) + bFirst = FALSE + Kontext "TabRaster" + If TabRaster.exists(2) then bCorPage = TRUE + case "PRINT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 7 ) + bFirst = FALSE + Kontext "TabPrintCalcOptions" + If TabPrintCalcOptions.exists(2) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "PRESENTATION" +'///Pages in group "Presentation"are: +'///+<ul><li>"General"</li> +'///+<li>"View"</li> +'///+<li>"Grid"</li> +'///+<li>"Print"</li></ul> + select case ucase$(Tabpagename) + case "GENERAL" + Kontext "TabSonstigesDraw" + If TabSonstigesDraw.exists then bCorPage = TRUE + case "VIEW" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabInhalteDraw" + If TabInhalteDraw.exists(2) then bCorPage = TRUE + case "GRID" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabRaster" + If TabRaster.exists(2) then bCorPage = TRUE + case "PRINT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabDruckenDraw" + If TabDruckenDraw.exists(2) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "DRAWING" +'///Pages in group "Drawing"are: +'///+<ul><li>"General"</li> +'///+<li>"View"</li> +'///+<li>"Grid"</li> +'///+<li>"Print"</li></ul> + select case ucase$(Tabpagename) + case "GENERAL" + Kontext "TabSonstigesDraw" + If TabSonstigesDraw.exists then bCorPage = TRUE + case "VIEW" + if bFirst = TRUE then Optionsliste.Select ( startpos + 2 ) + bFirst = FALSE + Kontext "TabInhalteDraw" + If TabInhalteDraw.exists(2) then bCorPage = TRUE + case "GRID" + if bFirst = TRUE then Optionsliste.Select ( startpos + 3 ) + bFirst = FALSE + Kontext "TabRaster" + If TabRaster.exists(2) then bCorPage = TRUE + case "PRINT" + if bFirst = TRUE then Optionsliste.Select ( startpos + 4 ) + bFirst = FALSE + Kontext "TabDruckenDraw" + If TabDruckenDraw.exists(2) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "FORMULA" +'///Page(s) in group "Formula"are: +'///+<ul><li>"Settings"</li></ul> + select case ucase$(Tabpagename) + case "SETTINGS" + Kontext "TabDruckenMath" + If TabDruckenMath.exists then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "CHART" +'///Pages in group "Chart"are: +'///+<ul><li>"DefaultColors"</li></ul> + select case ucase$(Tabpagename) + case "DEFAULTCOLORS" + Kontext "TabGrundfarben" + If TabGrundfarben.exists(4) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case "DATASOURCES" +'///Pages in group "Datasource"are: +'///+<ul><li>"Connetions"</li></ul> + select case ucase$(Tabpagename) + case "CONNECTIONS" + Kontext "TabConnections" + If TabConnections.exists(4) then bCorPage = TRUE + case "DATABASES" + Kontext "TabRegisteredDatabase" + If TabRegisteredDatabase.exists(4) then bCorPage = TRUE + case else : bCorPage = FALSE + end select + case else + bCorPage = False + end select + If bCorPage = TRUE then Exit for + next i + if bCorPage = FALSE then + if bSilent = FALSE then + warnlog "hToolsOptions(): "+ Applicationname + " / " + Tabpagename + " could not be found! Please review your test!" + else + printlog "hToolsOptions(): "+ Applicationname + " / " + Tabpagename + " should not be found!" + end if + end if + else + bCorPage = FALSE + warnlog "Please open the option-dialog with 'ToolsOptions' before you called this routine!" + end if + hToolsOptions = bCorPage +end function + diff --git a/testautomation/global/tools/includes/required/t_option2.inc b/testautomation/global/tools/includes/required/t_option2.inc new file mode 100644 index 000000000000..e0a62abf649c --- /dev/null +++ b/testautomation/global/tools/includes/required/t_option2.inc @@ -0,0 +1,504 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_option2.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:11 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Tools library for options testcases +'* +'************************************************************************ +'* +' #0 OptionTabPageZaehler ' Counting tab pages in Tools / Options +' #0 ToPosInOptionlist ' Jumping to the correct position in the options tree +' #0 DialogeFuerTypenKontrollieren 'Complete test for path-options +' #1 hSetMacroSecurity ' switch between security levels in Tools/Options +' #0 fGetSetMacroSecurityUNO ' switch between security levels in Tools/Options without using UI +' #1 hGetMacroSecurityAPI ' Retrieve the current macro security level using API +' #1 hSetMacroSecurityAPI ' Set the macro security level via API +'* +'\*********************************************************************** + +function OptionTabPageZaehler ( SollAnzahl as Integer, optional Ausnahme as Boolean ) +'parameter Ausnahme is depracted + Dim IstAnzahl + Kontext "ExtrasOptionenDlg" + IstAnzahl = Optionsliste.GetItemCount - iSectionNumber + if Ausnahme = FALSE then + if IstAnzahl <> SollAnzahl then WarnLog "Number of tabpages old : " + SollAnzahl + " new : " + IstAnzahl + end if + OptionTabPageZaehler = IstAnzahl +end function + +'------------------------------------------------------------------------- + +sub ToPosInOptionlist ( Sprung as Integer ) + Dim i as Integer + Kontext "OptionenDlg" + Optionsliste.TypeKeys "<HOME>" + for i = 1 to 12 + Optionsliste.TypeKeys "-<DOWN>" + next i + Optionsliste.Select Sprung + Optionsliste.TypeKeys "+" +end sub + +'------------------------------------------------------------------------- + +sub DialogeFuerTypenKontrollieren +' Complete test for path-options, for all entries the file-dialog or the path-dialog will be opened + Dim i as Integer + Dim iCount as Integer + Dim iErrorCount as integer + Kontext "TabPfade" + Typ.TypeKeys "<Down><Down><Home>" + iCount = 0 + iErrorCount = 0 + for i=1 to Typ.GetItemCount + if i<>1 then Typ.TypeKeys "<Down>" + printlog " "+typ.getText + if bAsianLan <> TRUE then + try + Bearbeiten.Click + kontext + if active.exists (3) then + iErrorCount = iErrorCount + 1 + if (iErrorCount > 1) then + Warnlog active.getText + endif + qaErrorlog "#i69014# gallery path doesn't exist: '" + active.getText + "'" + printlog active.getText + active.ok + endif + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(2) then + if Dateityp.IsVisible = TRUE then Warnlog "The normal FileOpen-Dialog is visible with the Filetype-Listbox => BUG!" + OeffnenDlg.Cancel + else + Kontext "PfadeAuswaehlen" + PfadeAuswaehlen.Cancel + end if + Sleep (1) + Kontext "TabPfade" + catch + Warnlog "Error on entry " & i & "!" + Exceptlog + endcatch + else + try + if Bearbeiten.IsEnabled = TRUE then + Bearbeiten.Click + kontext + if active.exists (3) then + iErrorCount = iErrorCount + 1 + if (iErrorCount > 1) then + Warnlog active.getText + endif + qaErrorlog "WorkAround for #109107# has to come up only once @'Add-Ins'! else BUG!" + active.ok + endif + Kontext "OeffnenDlg" + if OeffnenDlg.Exists(2) then + if Dateityp.IsVisible = TRUE then Warnlog "The normal FileOpen-Dialog is visible with the Filetype-Listbox => BUG!" + OeffnenDlg.Cancel + else + Kontext "PfadeAuswaehlen" + PfadeAuswaehlen.Cancel + end if + Sleep (1) + Kontext "TabPfade" + else + iCount = iCount + 1 + end if + catch + Warnlog "Error on entry " & i & "!" + Exceptlog + endcatch + end if + next i + if iCount > 3 then Warnlog "There are more than 3 entries are disabled!" + +end sub + +'------------------------------------------------------------------------- + +function hSetMacroSecurity( iLevel as integer ) as integer + + '///<h3>Set macro security level via GUI</h3> + '///<i>Set the macro security by accessing the Tools/Options-> + '///+ OpenOffice.org/Security::Macro... Tabpage</i><br><br> + + '///<u>Parameter(s):</u><br> + '///<ol> + + '///+<li>Desired macro security level (Integer). Following symbolic names are defined:</li> + '///<ul> + '///+<li>GC_MACRO_SECURITY_LEVEL_LOW (0) for low security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_MEDIUM (1) for medium security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_HIGH (2) for high security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_VERYHIGH (3) for very high security</li> + '///</ul> + + '///</ol> + + + '///<u>Returns:</u><br> + '///<ol> + '///+<li>Previous security level (Integer)</li> + '///<ul> + '///+<li>GC_MACRO_SECURITY_LEVEL_LOW (0) for low security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_MEDIUM (1) for medium security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_HIGH (2) for high security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_VERYHIGH (3) for very high security</li> + '///+<li>-1 on error</li> + '///</ul> + '///</ol> + + + + '///Switch between macro security levels in Tools/Options + '///<ul> + const CFN = "hSetMacroSecurity::" + dim iOldSecurityLevel as integer + + dim caLevel( 3 ) as string + caLevel( 0 ) = "low" + caLevel( 1 ) = "medium" + caLevel( 2 ) = "high" + caLevel( 3 ) = "very high" + + if ( ( iLevel < GC_MACRO_SECURITY_LEVEL_LOW ) or ( iLevel > GC_MACRO_SECURITY_LEVEL_VERYHIGH ) ) then + warnlog( CFN & "Invalid index (0...3) passed to function: " & ilevel ) + hSetMacroSecurity() = -1 + exit function + end if + + '///+<li>Open Tools/Options -> OpenOffice.org/Security</li> + ToolsOptions + hToolsOptions( "Staroffice" , "Security" ) + + '///+<li>Click on the macro security button</li> + Kontext "TabSecurity" + if ( MacroSecurity.exists( 2 ) ) then + MacroSecurity.click() + + '///+<li>Ensure we are on the Security Level page</li> + kontext "Active" + if ( Active.exists( 2 ) ) then + + Kontext + active.setpage TabSecurityLevel + + '///+<li>Get the current setting (=returnvalue)</li> + Kontext "TabSecurityLevel" + if ( TabSecurityLevel.exists( 2 ) ) then + if ( veryhigh.isChecked() ) then + iOldSecurityLevel = GC_MACRO_SECURITY_LEVEL_VERYHIGH + elseif( high.isChecked() ) then + iOldSecurityLevel = GC_MACRO_SECURITY_LEVEL_HIGH + elseif( medium.isChecked() ) then + iOldSecurityLevel = GC_MACRO_SECURITY_LEVEL_MEDIUM + elseif( low.isChecked() ) then + iOldSecurityLevel = GC_MACRO_SECURITY_LEVEL_LOW + end if + else + printlog( CFN & "Security Tabpage not available. Aborting." ) + kontext "OptionenDlg" + if ( OptionenDlg.exists( 2 ) ) then + OptionenDlg.cancel() + else + warnlog( CFN & "Unrecoverable error, status unknown." ) + endif + hSetMacroSecurity() = -1 + exit function + endif + + '///+<li>Set the new security level</li> + select case iLevel + case GC_MACRO_SECURITY_LEVEL_LOW : low.check() + case GC_MACRO_SECURITY_LEVEL_MEDIUM : medium.check() + case GC_MACRO_SECURITY_LEVEL_HIGH : high.check() + case GC_MACRO_SECURITY_LEVEL_VERYHIGH : veryhigh.check() + end select + + printlog( CFN & "Setting macro security level to " & caLevel( iLevel ) ) + + else + printlog( CFN & "Macro Security Dialog did not open. Aborting." ) + kontext "OptionenDlg" + if ( OptionenDlg.exists( 2 ) ) then + OptionenDlg.cancel() + else + warnlog( CFN & "Unrecoverable error, status unknown." ) + endif + hSetMacroSecurity() = -1 + exit function + endif + + '///+<li>Close Tools/Options</li> + TabSecurityLevel.ok() + else + warnlog( CFN & "The Macro Security Button is not available" ) + iOldSecurityLevel = -1 + end if + Kontext "OptionenDLG" + OptionenDLG.OK() + '///</ul> + hSetMacroSecurity() = iOldSecurityLevel +end function + +'------------------------------------------------------------------------- + +function fGetSetMacroSecurityUNO (optional iLevel as integer) as integer + ' Input : Security level where 0 = low and 3 = very high; empty: just return current value + ' Return : Previous security level, -1 on error + ' Changes: If iLevel is given, update global variable gMacroSecurityLevel to new level + ' NOTE : If possible use this function outside the testcase + '///Switch between macro security levels in Tools/Options without using the UI + Dim sFileFunction as string + Dim iOldSecurityLevel as integer + Dim oUnoOfficeConnection as object + Dim oUnoConfigurationAccess as object + Dim aPropertyValue(1) As new com.sun.star.beans.PropertyValue ' Array of pairs: Property with Value + Dim xViewRoot + Dim bOptional as boolean + + sFileFunction = "global::tools::inc::t_option2.inc::hSetMacroSecurity::" + bOptional = isMissing(iLevel) + iOldSecurityLevel = -1 + + ' Open OOo UNO-Port for communication + oUnoOfficeConnection=hGetUnoService(TRUE) + if (NOT isNull(oUnoOfficeConnection)) then + try + ' Open Configuration access + oUnoConfigurationAccess=oUnoOfficeConnection.createInstance("com.sun.star.configuration.ConfigurationProvider") + if (NOT isNull(oUnoConfigurationAccess)) then + ' Specifies the location of the view root in the configuration: + ' The value is the Path name of the configuration item to change. + aPropertyValue(0).Name="nodepath" + ' Controls how updates are handled in the cache: If false , the cache + ' must operate in write-through mode, where updates are written to + ' persistent storage at once - that is before ::commitChanges() returns. + aPropertyValue(1).Name="lazywrite" + aPropertyValue(1).Value=False + + '///Tools / Options / Security + '///Check which 'Macro Security Level' is set and put it into returnvalue. + aPropertyValue(0).Value="/org.openoffice.Office.Common/Security/Scripting" + xViewRoot=oUnoConfigurationAccess.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPropertyValue()) + iOldSecurityLevel = xViewRoot.getByName("MacroSecurityLevel") + ' If input is given, use it by setting the Security Level + if NOT bOptional then + xViewRoot.setPropertyValue("MacroSecurityLevel", iLevel) + xViewRoot.commitChanges() + ' Since we use lazywrite=false, the call to '.commitChanges()' returns if all data is written. + ' This call to ask for pending changes is just to convince me; + if xViewRoot.hasPendingChanges() then + qaErrorLog(sFileFunction+"Changes still pending...") + ' At this point there is no needed to think about what to do, if it doesn't work. + ' If it doesn't work, the change is performed in the UI via + ' global::system::inc::master.inc::mMakeGeneralOptions + end if + ' Update global value + gMacroSecurityLevel = iLevel + end if + ' Destroy, discard, dump, get rid of, put away, throw away, trash, the object: + xViewRoot.dispose() + else + qaErrorLog(sFileFunction+"Couldn't create Configuration access") + end if + catch + qaErrorLog(sFileFunction+"Failure during reading or setting Configuration Value") + endcatch + else + qaErrorLog(sFileFunction+"Couldn't get UNO service") + end if + fGetSetMacroSecurityUNO = iOldSecurityLevel +end function + + + +'******************************************************************************* + +function hGetMacroSecurityAPI() as integer + + + '///<h3>Retrieve the macro security level via API</h3> + '///<i>Use remote UNO to quickly retrieve the current macro security level. + '///+ This function runs silent unless an error is encountered.</i><br><br> + + '///<u>Parameter(s):</u><br> + '///<ol> + '///+<li>No input parameters</li> + '///</ol> + + + '///<u>Returns:</u><br> + '///<ol> + '///+<li>Macro Security Level (Integer)</li> + '///<ul> + '///+<li>GC_MACRO_SECURITY_LEVEL_LOW (0) for low security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_MEDIUM (1) for medium security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_HIGH (2) for high security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_VERYHIGH (3) for very high security</li> + '///+<li>-1 = Error</li> + '///</ul> + '///</ol> + + const CFN = "hGetMacroSecurityAPI::" + + dim oUnoOfficeConnection as object + dim oUnoConfigurationAccess as object + dim aPropertyValue( 1 ) As new com.sun.star.beans.PropertyValue + dim iLevel as integer + dim xViewRoot + + try + + oUnoOfficeConnection=hGetUnoService(TRUE) + oUnoConfigurationAccess=oUnoOfficeConnection.createInstance("com.sun.star.configuration.ConfigurationProvider") + + aPropertyValue( 0 ).Name = "nodepath" + aPropertyValue( 0 ).Value = "/org.openoffice.Office.Common/Security/Scripting" + aPropertyValue( 1 ).Name = "lazywrite" + aPropertyValue( 1 ).Value = FALSE + + xViewRoot=oUnoConfigurationAccess.createInstanceWithArguments( "com.sun.star.configuration.ConfigurationUpdateAccess", aPropertyValue() ) + iLevel = xViewRoot.getByName( "MacroSecurityLevel" ) + xViewRoot.dispose() + + catch + + warnlog( CFN & "Failed to retrieve macro security Level via API" ) + iLevel = -1 + + endcatch + + hGetMacroSecurityAPI() = iLevel + +end function + + +'******************************************************************************* + +function hSetMacroSecurityAPI( iSecLevel as integer ) as integer + + + '///<h3>Set macro security level using API</h3> + '///<i>Set the macro security using remote uno. This implementation does exactly + '///+ the same as hSetMacroSecurity but is considerably faster</i><br><br> + + '///<u>Parameter(s):</u><br> + '///<ol> + + '///+<li>Desired macro security level (Integer). Following symbolic names are defined:</li> + '///<ul> + '///+<li>GC_MACRO_SECURITY_LEVEL_LOW (0) for low security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_MEDIUM (1) for medium security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_HIGH (2) for high security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_VERYHIGH (3) for very high security</li> + '///</ul> + + '///</ol> + + + '///<u>Returns:</u><br> + '///<ol> + '///+<li>Previous security level (Integer)</li> + '///<ul> + '///+<li>GC_MACRO_SECURITY_LEVEL_LOW (0) for low security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_MEDIUM (1) for medium security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_HIGH (2) for high security</li> + '///+<li>GC_MACRO_SECURITY_LEVEL_VERYHIGH (3) for very high security</li> + '///+<li>-1 on error</li> + '///</ul> + '///</ol> + + const CFN = "hSetMacroSecurityAPI::" + + dim oUnoOfficeConnection as object + dim oUnoConfigurationAccess as object + dim aPropertyValue( 1 ) As new com.sun.star.beans.PropertyValue + dim iLevel as integer + dim xViewRoot + + dim caLevel( 3 ) as string + caLevel( 0 ) = "low" + caLevel( 1 ) = "medium" + caLevel( 2 ) = "high" + caLevel( 3 ) = "very high" + + aPropertyValue( 0 ).Name = "nodepath" + aPropertyValue( 0 ).Value = "/org.openoffice.Office.Common/Security/Scripting" + aPropertyValue( 1 ).Name = "lazywrite" + aPropertyValue( 1 ).Value = FALSE + + '///<u>Description:</u> + '///<ul> + + iLevel = 0 + + '///+<li>Verify input parameter, quit function with a warning on error</li> + if ( iSecLevel < GC_MACRO_SECURITY_LEVEL_LOW or iSecLevel > GC_MACRO_SECURITY_LEVEL_VERYHIGH ) then + + warnlog( CFN & "Invalid security level passed to function: " & iSecLevel ) + hSetMacroSecurityAPI() = -1 + exit function + + endif + + + '///+<li>Get current security level, set the new one</li> + try + + oUnoOfficeConnection=hGetUnoService(TRUE) + oUnoConfigurationAccess=oUnoOfficeConnection.createInstance("com.sun.star.configuration.ConfigurationProvider") + + xViewRoot=oUnoConfigurationAccess.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPropertyValue()) + iLevel = xViewRoot.getByName( "MacroSecurityLevel" ) ' Get the current value + xViewRoot.setPropertyValue( "MacroSecurityLevel" , iSecLevel ) ' Set the new value + xViewRoot.commitChanges() + xViewRoot.dispose() + + printlog( CFN & "Setting macro security level to " & caLevel( iSecLevel ) + + catch + + warnlog( CFN & "Failed to get/set new macro security level via API:" & iSecLevel ) + iLevel = -1 + + endcatch + '///</ul> + + hSetMacroSecurityAPI() = iLevel + +end function diff --git a/testautomation/global/tools/includes/required/t_tools1.inc b/testautomation/global/tools/includes/required/t_tools1.inc new file mode 100755 index 000000000000..d87dc179aed2 --- /dev/null +++ b/testautomation/global/tools/includes/required/t_tools1.inc @@ -0,0 +1,1123 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_tools1.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:11 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : Tools (1) +'* +'*************************************************************************************** +'* +' #1 GetClipboardText 'Returns the correct clipboard text (also if there is a 'RETURN' at it's end. +' #1 hDoubleClickInList +' #0 hMouseClick +' #1 wielange +' #1 sleep +' #1 WaitInSek +' #1 WaitInMilliSek +' #1 DialogTest 'Creates snapshots +' #0 DialogTest2 'Creates snapshots +' #1 hFindeImDokument 'Searches for a string with the 'Search&Replace'-dlg in a document. +' #1 hFindeMehrImDokument 'Same as 'hFindeImDokument' but needs an integer how often the search-phrase must be found until the boolean gives TRUE back. +' #1 ErgebnisSchreiben +' #1 TextInDatei +' #1 hGetUIFiltername 'Extracts the UI filtername from configuration. +' #1 hGetFilternameExtension 'Extracts the filtername extension from configuration. +' #1 TrimTab 'trimming strings +' #1 lTrimTab 'trimming strings +' #1 rTrimTab 'trimming strings +' #1 TrimString 'Cuts all ASCII characters which are defined by a parameter (e.g. 32 space will be deleted) +' #1 ActiveDeactivateAsianSupport 'Acivates/Deactivates the Asian support in StarOffice +' #1 ActiveDeactivateCTLSupport 'Acivates/Deactivates the CTL support in StarOffice +' #1 GetDecimalSeperator 'Reads from Tools / Options the used . or , which is being used as seperator +' #1 sResetTheOffice 'Save language information - throw away user directory - restore language information +'* +'\************************************************************************************* + +function GetClipboardText as string +'/// Returns the correct clipboard text (also if there is a 'RETURN' at it's end. + Dim i% : Dim CBText$ + Dim Zwischen$ + + wait 500 + GetClipboardText = "" + CBText$ = GetClipboard + + if CBText$ = "" then + GetClipboardText = "" + exit function + end if + + if asc ( Right( CBText$, 1 )) = 10 then + Zwischen$ = Mid( CBText$, 1, len(CBText$)-1 ) + if Zwischen$ <> "" then + if asc ( Right( Zwischen$, 1 )) = 13 then + GetClipboardText = Mid( Zwischen$, 1, len(Zwischen$)-1 ) + else + GetClipboardText = Zwischen$ + end if + else + GetClipboardText = Zwischen$ + end if + else + if asc ( Right( CBText$, 1 )) = 13 then + Zwischen$ = Mid( CBText$, 1, len(CBText$)-1 ) + if asc ( Right( Zwischen$, 1 )) = 10 then + GetClipboardText = Mid( Zwischen$, 1, len(Zwischen$)-1 ) + else + GetClipboardText = Zwischen$ + end if + else + GetClipboardText = CBText$ + end if + end if +end function + +'------------------------------------------------------------------------- + +function hDoubleClickInList ( window, Selektion as String, optional bFocus as boolean ) as Boolean +'/// hDoubleClickInList +'///+ Makes a double click onto an entry in a list (tested only in <i>style lists</i>) +'///+ window: name of list ///' +'///+ selektion: string to find in list ///' +'///+ bFocus: TRUE: activate the window with mouseclick before leaving ///' +'///+ ReturnValue: if found: TRUE; else FALSE ///' + + Dim i as Integer + Dim AlterWert as String + Dim NeuerWert as String + + NeuerWert = "!=! !=!" ' init with dummy value + window.TypeKeys "<Home>" + if window.gettext <> Selektion then + for i=1 to 100 step 2 + window.MouseDown 5, i +1 + window.MouseUp 5, i +1 + AlterWert = window.GetText + window.TypeKeys "<Down>" + NeuerWert = Window.GetText + window.TypeKeys "<Up>" + if AlterWert = Selektion then + window.MouseDown 5, i +1 + window.MouseUp 5, i +1 + if Window.GetText = Selektion then ' catch if <down> had any effects + window.MouseDoubleClick 5, i +1 + if (isMissing (bFocus) = FALSE) then ' if optional parameter provided + window.MouseDown 5, i +1 + window.MouseUp 5, i +1 + endif + i = 202 + else + i=0 ' start at top of list + end if + else + if AlterWert = NeuerWert then + Warnlog "'" + Selektion + "' wasn't found in list!" + i = 202 + else + if i > 98 then i=40 ' list not at end, but scrolled + end if + end if + next i + if i < 200 OR i > 100 then + hDoubleClickInList = FALSE + else + hDoubleClickInList = TRUE + end if + else + window.TypeKeys "<Return>" + hDoubleClickInList = TRUE + endif +end function + +'------------------------------------------------------------------------- + +sub hMouseClick ( window, xPos, yPos ) +' Author: Thorsten Ziehm (26.09.2000) +'/// hMouseClick +'///+ Do a mouse click on a named window. +'/// <i>Input</i>: +'///+ window : The object on which the mouse click should be make (document, listbox, window) +'///+ xPos : x-position (relativ to the size of the window (1:100) +'///+ yPos : y-position (relativ to the size of the window (1:100) + window.MouseDown ( xPos, yPos ) + window.MouseUp ( xPos, yPos ) +end sub + +'------------------------------------------------------------------------- + +function wielange (StrtTime, optional iFormat as integer) as String + ' Author: Michael Friedrichs + '/// wielange + '///+ Returns the time between a start- and an end timeframe. + '///+ iFormat: 0: default; 1: mysql ///' + + Dim Zeitspanne + Dim Zeitspannesek + Dim Zeitspannemin + Dim Zeitspanneh + dim sTemp as string + + if isMissing(iFormat) then + 'dim iFormat as integer + iFormat = 0 + endif + + Zeitspanne = Now() - StrtTime + Zeitspannesek = Zeitspanne / 1.15741E-05 + 1 + Zeitspanneh = Fix(Zeitspannesek / 3600) + Zeitspannesek = Zeitspannesek - Zeitspanneh * 3600 + Zeitspannemin = Fix(Zeitspannesek / 60) + Zeitspannesek = Zeitspannesek - Zeitspannemin * 60 + Zeitspannesek = Fix(Zeitspannesek) + select case iFormat + case 0: sTemp = "" & Zeitspanneh & "h " & Zeitspannemin & "m " & Zeitspannesek & "s" + case 1: if Zeitspanneh < 10 then ' mysql format for status.inc + sTemp = "0" & Zeitspanneh & ":" + else + sTemp = "" & Zeitspanneh & ":" + end if + if Zeitspannemin < 10 then + sTemp = "" & sTemp & "0" & Zeitspannemin & ":" + else + sTemp = "" & sTemp & Zeitspannemin & ":" + end if + if Zeitspannesek < 10 then + sTemp = "" & sTemp & "0" & Zeitspannesek + else + sTemp = "" & sTemp & Zeitspannesek + end if + case default: qaErrorLog "t_tools1.inc::wielange: optional parameter iFormat out of range!" + sTemp = "" + end select + wielange = sTemp +end function + +'------------------------------------------------------------------------- + +sub WaitInSek ( Sekunden ) +' Author: Thorsten Ziehm +'/// WaitInSek +'///+ Wait exactly x second(s) (using GetSystemTicks) + Dim i : Dim t0 : Dim t1 + t0 = GetSystemTicks() + for i=1 to 10000*Sekunden + t1 = GetSystemTicks() + if t1-t0 > 1000*Sekunden then i=11000*Sekunden + next i +end sub + +'------------------------------------------------------------------------- + +sub WaitInMilliSek ( Milli ) +' Author: Thorsten Ziehm +'/// WaitInMilliSek +'///+ Wait exactly x millisecond(s) (using GetSystemTicks) + Dim i : Dim t0 : Dim t1 + t0 = GetSystemTicks() + for i=1 to 1000*Milli + t1 = GetSystemTicks + if t1-t0 > Milli then i=1001*Milli + next i +end sub + +'------------------------------------------------------------------------- + +sub sleep ( i% ) +'/// sleep +'///+ simple sleep routine which uses seconds. +' WaitInSek ( i% ) + wait i%*1000 +end sub + +'------------------------------------------------------------------------- + +sub DialogTest( Window, optional iNumber as integer) +'/// DialogTest +'///+ Make <i>SnapShots</i> +'/// <b>Window</b> : the name of the window as declared in qa/qatesttool/global/win/* +'/// <i>Optional Parameter</i> <b>iNumber</b> : Number to distinguish windows which dynamical change their content but not their ID///' +'///+ the number has to be provided by the testscript creator ///' + Dim Ergebnis as Integer + Dim Ausgabe as String + Dim UndRaus as Boolean + Dim sCount as string + + ' evaluate optional parameter + if isMissing(iNumber) then + 'just one picture + sCount = "" + else + 'there will be more pictures with the same ID + sCount = "_"+iNumber + endif + + if gDasNicht=0 then + ' In Place Translation Feature: not used anymore; + ' The matching of the strings on the later migration step never worked. + ' Just kept here for historical reasons + Ausgabe = "" + UndRaus = FALSE + while UndRaus = FALSE + Ausgabe = translate + if Ausgabe <> "" OR Ausgabe <> "1" then + if Left ( Ausgabe, 1 ) = "0" then + Ausgabe = Right ( Ausgabe, Len( Ausgabe )- 2 ) + AnhaengenAnDatei ( gOfficePath + "trans_output.txt", Ausgabe ) + end if + end if + if Ausgabe = "1" then UndRaus = TRUE + wend + else + ' Usual window check + try + if Not window.Exists(2) then + Warnlog " - Window nicht existent:" + window.Name + " " + window.ID + exit sub + end if + 'To get a history, of what windows are covered, use the following line + ' AnhaengenAnDatei ( ConvertPath (gOfficePath + "user\work\wieviel.txt"), window.Name + " " + sCount + " : " + window.ID ) + catch + ExceptLog + endcatch + end if + + if gbSnapShot = TRUE then + 'Make Screenshot from dialog and save as HelpID.bmp + Dim Dummy as String, sName as String, sPicName as String + + 'get window ID + Dummy = Window + 'set filename + sName = Dummy + sCount + ".bmp" + + 'save with respect to application and language + sCapturePath = ConvertPath (gOfficePath + "user\work\screenshots"+iSprache+"\") + sPicName = sCapturePath + lCase(gApplication) + 'create directory if it doesn't exist + if hDirectoryExists(sPicName) <> TRUE then + mkdir (sPicName) + end if + sPicName = sPicName + sName + try + sleep 1 + window.SnapShot( sPicName ) + catch + warnlog "t_tools1.inc::DialogTest Failed to save screenshot: '" + sPicName + "'" + endcatch + printlog sPicName + end if +end sub + +'----------------------------------------------------------- + +sub DialogTest2( Window, i% ) + 'deprecated TBO:2006/03/16 + DialogTest( Window, i% ) +end sub + +'------------------------------------------------------------------------- + +function hFindeImDokument ( Passage$ , Optional A, optional bRegEx ) as boolean +' Author: Joerg Sievers (13.11.2001) +'/// hFindeImDokument +'/// Searches via 'Search&Replace'-Dlg in StarOffice Writer, -Clac, +'///+ -HTML, -GlobalDoc for the string <b>EXACT MATCH</b>. +'///+ Only ONE TIME and THE FIRST search phrase will be found! +'/// <i>Optional Parameter</i> <b>a</b> : If you do not want a warnlog message +'/// <i>Optional Parameter</i> <b>bRegEx</b> : if you look fort an regular expression + Dim WhatIsIn as string + Dim bSilent as boolean + + bSilent = NOT isMissing(a) + gApplication = UCase ( gApplication ) + hFindeImDokument = FALSE + + select case gApplication + + case "CALC" : Kontext "DocumentCalc" + DocumentCalc.TypeKeys "<MOD1 HOME>" + + case "WRITER" : Kontext "DocumentWriter" + DocumentWriter.TypeKeys "<MOD1 HOME>" + + case "NACHRICHT" : Kontext "DokumentNachrichten" + DokumentNachrichten.TypeKeys "<MOD1 HOME>" + + case "HTMLDOKUMENT": Kontext "DocumentWriterWeb" + DocumentWriterWeb.TypeKeys "<MOD1 HOME>" + + case "GLOBALDOC" : Kontext "DocumentMasterDoc" + DocumentMasterDoc.TypeKeys "<MOD1 HOME>" + + end select + + SetClipboard "" + EditSearchAndReplace + Kontext "FindAndReplace" + if SimilaritySearch.IsVisible = False then + More.Click + end if + if MatchCase.IsChecked = False then + MatchCase.Check + end if + if SimilaritySearch.IsChecked = TRUE then + SimilaritySearch.UnCheck + if NOT bSilent then + warnlog "'Similarity search' checkbox was enabled! It shouldn't be the default!" + endif + end if + if IsMissing(bRegEx) <> TRUE then + RegularExpressions.Check + end if + SearchFor.Settext Passage$ + SearchNow.Click + Kontext + if NOT Active.Exists(2) then + Kontext "FindAndReplace" + More.Click + FindAndReplace.Cancel + EditCopy + WhatIsIn = GetClipboardText + if WhatIsIn <> Passage$ then + if NOT bSilent then + warnlog "The search-request for '" & Passage$ & "' has been fault! (Found: '"& WhatIsIn & "')" + end if + else + hFindeImDokument = TRUE + end if + else + try + Kontext + if Active.Exists(1) then + Active.OK + end if + if NOT bSilent then + warnlog "The search-request for '" & Passage$ & "' has been fault! (Found: '"& WhatIsIn & "')" + end if + Kontext "FindAndReplace" + if SimilaritySearch.IsVisible = False then + More.Click + endif + if MatchCase.IsChecked then + MatchCase.UnCheck + endif + if SimilaritySearch.IsChecked = TRUE then + SimilaritySearch.UnCheck + if NOT bSilent then + warnlog "'Similarity search' checkbox was enabled! It shouldn't be the default!" + endif + end if + if IsMissing(bRegEx) <> TRUE then + RegularExpressions.UnCheck + endif + More.Click + FindAndReplace.Cancel + catch + Active.Yes + Kontext + if bSilent then + if Active.Exists then printlog "> "+Active.GetText + endif + if Active.Exists then Active.OK + if NOT bSilent then + warnlog "The search-request for '" & Passage$ & "' has been fault! (Found: '"& WhatIsIn & "')" + endif + Kontext "FindAndReplace" + if SimilaritySearch.IsVisible = False then + More.Click + endif + if MatchCase.IsChecked then + MatchCase.UnCheck + endif + if SimilaritySearch.IsChecked = TRUE then + SimilaritySearch.UnCheck + if NOT bSilent then + warnlog "'Similarity search' checkbox was enabled! It shouldn't be the default!" + endif + end if + if IsMissing(bRegEx) <> TRUE then + RegulaererAusdruck.UnCheck + endif + More.Click + FindAndReplace.Cancel + endcatch + end if +end function + +'------------------------------------------------------------------------- + +function hFindeMehrImDokument ( Passage as string , WieOft as integer ) as boolean +' Author: Joerg Sievers (26.07.2000) +'/// hFindeMehrImDokument +'/// Searches per 'Search&Replace'-Dlg in StarOffice Writer, -Clac, +'///+-HTML, -GlobalDoc for the string <b>EXACT MATCH</b>. +'/// You have to give the function the number how often the phrase +'///+should be found in the document as an additional parameter (as integer). +'/// Only when exact the number of the phrase will be found correctly +'///+the function gives back TRUE. +'/// <i>see also</i> : hFindeImDokument (TOOLS.INC) + Dim i as integer + gApplication = UCase ( gApplication ) + + hFindeMehrImDokument = FALSE + + select case gApplication + + case "CALC" : Kontext "DocumentCalc" + DocumentCalc.TypeKeys "<MOD1 HOME>" + + case "WRITER" : Kontext "DocumentWriter" + DocumentWriter.TypeKeys "<MOD1 HOME>" + + case "NACHRICHT" : Kontext "DokumentNachrichten" + DokumentNachrichten.TypeKeys "<MOD1 HOME>" + + case "HTMLDOKUMENT": Kontext "DocumentWriter" + DocumentWriter.TypeKeys "<MOD1 HOME>" + + case "GLOBALDOC" : Kontext "DocumentMasterDoc" + DocumentMasterDoc.TypeKeys "<MOD1 HOME>" + + end select + + SetClipboard "" + EditSearchAndReplace + + For i = 1 to WieOft + Kontext "FindAndReplace" + if NOT MatchCase.IsChecked then MatchCase.Check + SearchFor.Settext Passage + SearchNow.Click + Kontext + if NOT Active.Exists(2) then + FindAndReplace.Cancel + EditCopy + if GetClipboardText <> Passage then + warnlog "The search-request for '" & Passage & "' has been fault!" + i = WieOft + else + if i = WieOft then + hFindeImDokument = TRUE + printlog "Searchphrase found " & i & " time(s)." + end if + end if + else + try + Active.OK + Kontext + if Active.Exists then Active.OK + warnlog "The search-request for '" & Passage & "' has been fault!" + i = WieOft + Kontext "FindAndReplace" + if MatchCase.IsChecked then MatchCase.UnCheck + FindAndReplace.Cancel + catch + Active.Yes + Kontext + if Active.Exists then Active.OK + warnlog "The search-request for '" & Passage & "' has been fault!" + i = WieOft + Kontext "FindAndReplace" + if MatchCase.IsChecked then MatchCase.UnCheck + FindAndReplace.Cancel + endcatch + end if + Next i + Kontext "FindAndReplace" + if FindAndReplace.Exists(2) then + FindAndReplace.Cancel + end if +end function + +'------------------------------------------------------------------------- + +sub ErgebnisSchreiben ( Window, Name$ ) +'/// ErgebnisSchreiben +'///+ Used in context with making screenshots. + Dim FileNum% : Dim i% + Dim Datei$ + Dim Text$ : Dim Text2$ + + Datei$ = sCapturePath + "Ergebis.txt" + Text2$ = Window.Name + Text$ = Text2$ + " => " + Name$ + + FileNum% = FreeFile + Open Datei$ for Append as #FileNum% + Print #FileNum%, Text$ + Close #FileNum% +end sub + +'------------------------------------------------------------------------- + +sub TextInDatei ( TextText$, Datei$ ) +'/// TextInDatei + Dim FileNum% + + FileNum% = FreeFile + Open Datei$ for Append as #FileNum% + Print #FileNum%, TextText$ + Close #FileNum% +end sub + +'------------------------------------------------------------------------- + +function hGetUIFiltername( vFiltername as string ) as string +'/// Returns the in the UI used filter name. +'///+ <b>INPUT</b>: 'internal', language independent filter name from FilterFactory. +'///+ <u>Examples</u>:<ul><li>hGetUIFiltername("StarOffice XML (Draw)") - Draw OOo 1.x/SO6.0/SO7 UI Filtername</li> +'///+ <li>sUIFiltername = hGetUIFiltername("StarOffice XML (Impress)") - Impress OOo 1.x/SO6.0/SO7 UI Filtername</li></ul> +'/// The 'internal' name can be found in the *.xcu in +'///+ ..../share/registry/res/en-US/org/openoffice/TypeDetection/Filter.xcu. +'/// See also: hGetFilternameExtension + Dim i as integer + Dim oOpenUNOService as object + Dim oFilterName as object + Dim oUno as object + + oUno = hGetUNOService(TRUE) + + oOpenUNOService = oUno.createInstance("com.sun.star.document.FilterFactory") + try + oFilterName = oOpenUNOService.getByName(vFiltername) + + for i=0 to ubound(oFilterName) + if oFilterName(i).Name = "UIName" then + hGetUIFiltername = oFilterName(i).Value + end if + next i + catch + warnlog "t_tools1.inc::hGetUIFiltername('" + vFiltername + "'): Filtername is not available." + hGetUIFiltername = "" + endcatch +end function + +'------------------------------------------------------------------------- + +function hGetFilternameExtension ( vFilterName as string) +'/// Returns the in the UI used filter name extension(s) <u>as an <b>array</b></u>. +'///+ <b>Important</b>: Also returns it <u>as an array</u> if there comes a string from the UNO API call. +'/// <u>Input</u>: 'internal', language independent name +'/// The 'internal' name can be found in the *.xcu in +'///+ ../share/registry/modules/org/openoffice/TypeDetection/Types/fcfg_[Application_name]_types.xcu file(s). +'/// List of some 'internal' filter names for OOo 2.0/SO8: +'///+<TABLE BORDER=1><TR><TH>Filter</TH><TH><i>internal</i> name</TH><TH>Note</TH></TR> +'///+<TR><TD>Spreadsheet (default)</TD><TD>calc8</TD><TD>-</TD></TR> +'///+<TR><TD>Text document (default)</TD><TD>writer8</TD><TD>-</TD></TR> +'///+<TR><TD>Master document (default)</TD><TD>writerglobal8</TD><TD>-</TD></TR> +'///+<TR><TD>Drawing (default)</TD><TD>draw8</TD><TD>-</TD></TR> +'///+<TR><TD>Presentation (default)</TD><TD>impress8</TD><TD>-</TD></TR> +'///+<TR><TD>Formula/Math (default)</TD><TD>math8</TD><TD>-</TD></TR> +'///+<TR><TD>HTML</TD><TD>writer_web_HTML</TD><TD>two extensions!</TD></TR> +'///+<TR><TD>Text</TD><TD>writer_text</TD><TD>-</TD></TR> +'///+<TR><TD>StarWriter 5.0</TD><TD>writer_StarWriter_50</TD><TD>-</TD></TR> +'///+<TR><TD>StarCalc 5.0</TD><TD>calc_StarCalc_50</TD><TD>-</TD></TR> +'///+</TABLE><br> +' (rewritten, compatible routine; July 2004) + Dim i as integer + Dim x as integer + Dim oOpenUNOService as object + Dim oFilterNameExtension as object + Dim oUno as object + dim a as integer + Dim aExtensions() as string + + 'Initializize UNO comminication + oUno = hGetUNOService(TRUE) + + 'Using the TypeDetection service + oOpenUNOService = oUno.createInstance("com.sun.star.document.TypeDetection") + 'Getting the Extension by given (internal; language- and product + 'independent) filter name + oFilterNameExtension = oOpenUNOService.getByName(vFiltername) + + 'using ubound to count the nodes + for i=0 to ubound(oFilterNameExtension) + 'if the node name is 'Extensions'... + if oFilterNameExtension(i).Name = "Extensions" then + '...if it's an array... + if IsArray(oFilterNameExtension(i).Value) then + 'create dimension of the integer a + a = 10 + 're-dimension the array with the integer a + Redim aExtensions(a) as string + 'return the array into an array + aExtensions() = oFilterNameExtension(i).Value() + else + '...otherwise 'build' an array with only + 'one entry in (0) + Redim aExtensions(0) as string + aExtensions(0) = oFilterNameExtension(i).Value + end if + endif + next i + 'put the results into the return value of this function into an array. + hGetFilternameExtension = aExtensions() +end function + +'------------------------------------------------------------------------- + +function TrimTab ( sTrimmer as String ) as String +'/// TrimTab +'/// <u>Input</u>: the original text +'/// Returns the string without <tab>s at the beginning and the end of a string. + Dim sInterim as String + + sInterim = sTrimmer + sInterim = lTrimTab ( sInterim ) + TrimTab = rTrimTab ( sInterim ) + +end function + +'------------------------------------------------------------------------- + +function lTrimTab ( slTrimmer as String ) as String +'/// lTrimTab +'/// <u>Input</u>: the original text +'/// Returns the string without <tab>s at the beginning. +'/// Cuts <Tab's> at the beginning of a string ( left ) + Dim i, iLen as Integer + Dim sInterim as String + + iLen = len ( slTrimmer ) + sInterim = slTrimmer + + for i=1 to iLen + if Asc ( left ( sInterim, 1 ) ) = 9 then + sInterim = Right ( sInterim, len ( sInterim ) - 1 ) + else + i=iLen+1 + end if + next i + lTrimTab = sInterim +end function + +'------------------------------------------------------------------------- + +function rTrimTab ( srTrimmer as String ) as String +'/// rTrimTab +'/// Input: the original text +'/// Returns the string without <tab>s at the end. +'/// Cuts <Tab's> at the beginning of a string ( right ) + + Dim i, iLen as Integer + Dim sInterim as String + + iLen = len ( srTrimmer ) + sInterim = srTrimmer + + for i=1 to iLen + if Asc ( right ( sInterim, 1 ) ) = 9 then + sInterim = left ( sInterim, len ( sInterim ) - 1 ) + else + i=iLen+1 + end if + next i + rTrimTab = sInterim +end function + +'------------------------------------------------------------------------- + +function TrimString (Content as String, delim as integer) as String +' Author: Frank Heitbrock (26.07.2002) +'/// TrimString +'/// <u>Input</u>: The String, the delimiter which should be cut from the string. +'/// Returns the String without the delimiter. +'/// <u>Example</u>: +'///+ Content = " H a l l o ", delim = 32 (ascii for space character) +'///+ Return = "Hallo" + dim strlen as integer, i as integer, k as integer + dim CharBuff(1 to 100) as String + dim ResultStr as String + ' at first cut the empty strings left and right of the String + Content = lTrim(Content) + Content = rTrim(Content) + ' now we search for all appropriate ascii characters in the middle of the String and delete them + strlen = len(Content) + k = 1 + for i = 1 to strlen + if mid(Content, i, 1) <> chr(delim) then + CharBuff(k) = mid(Content, i, 1) + k = k +1 + end if + next i + for i = 1 to k + ResultStr = ResultStr + CharBuff(i) + next i + TrimString = ResultStr + +end function + +'------------------------------------------------------------------------- + +function ActiveDeactivateAsianSupport ( WhatState as Boolean ) as Boolean +' Author: Thorsten Ziehm +'/// ActiveDeactivateAsianSupport +'/// <u>Input</u>: TRUE or FALSE +'///+ TRUE: The Asian support will be enabled. +'///+ FALSE: The Asian support will be disabled. +'/// <u>Return:</u> +'///+ TRUE/FALSE for the last state of the checkbox in the office UI. + ToolsOptions + hToolsOptions ( "LanguageSettings", "Languages" ) + + IF Aktivieren.IsEnabled then 'the checkbox is disabled in asian versions + ActiveDeactivateAsianSupport = Aktivieren.IsChecked ' the function gets the old state of the checkbox + + if WhatState = TRUE then + try + Aktivieren.Check + catch + endcatch + else + Aktivieren.UnCheck + end if + gAsianSup = WhatState ' Set the global variable + + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK + Sleep (3) + else + ActiveDeactivateAsianSupport = TRUE + If WhatState = FALSE then + warnlog "Deactivating of asian language support is not possible, because it is disabled in cjk versions" + end if + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK + Sleep (3) + end if + +end function + +'------------------------------------------------------------------------- + +function ActiveDeactivateCTLSupport ( WhatState as Boolean ) as Boolean +' Author: Hercule Li (March 2004) +'/// ActiveDeactivateCTLSupport +'/// <u>Input</u>: TRUE or FALSE +'/// TRUE : The CTL will be enabled. +'/// FALSE: The CTL will be disabled. +'/// <u>Return:</u> +'/// TRUE/FALSE for the last state of the checkbox in the office UI. + ToolsOptions + hToolsOptions ( "LanguageSettings", "Languages" ) + + IF ComplexScriptEnabled.IsEnabled then 'the checkbox is disabled in CTL versions + ActiveDeactivateCTLSupport = ComplexScriptEnabled.IsChecked ' the function gets the old state of the checkbox + + if WhatState = TRUE then + ComplexScriptEnabled.Check + else + ComplexScriptEnabled.UnCheck + end if + gCTLSup = WhatState ' Set the global variable + + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK + Sleep (3) + else + ActiveDeactivateCTLSupport = TRUE + If WhatState = FALSE then + warnlog "Deactivating of CTL language support is not possible, because it is disabled in ctl versions" + end if + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK + Sleep (3) + end if + +end function + +'------------------------------------------------------------------------- + +function GetDecimalSeperator ( optional sDummy$ ) as String +'/// <u>Precondition</u>: Measuring unit has to be set to centimeter (cm) before using this function. (see: fSetMeasurementToCM()) +'///+ <u>Input</u>: Number with fractionmark from <i>NumericField</i> as string +'///+ <u>Output</u>: A dot (.) or a comma (,) as string + Dim sCheckForSeparator as string + Const cWhereIsThisFunction = "qa::qatesttool::global::tools::inc::t_tools1.inc::GetDecimalSeperator: " + Dim bDotOrCommaIncluded as boolean + + 'Setting the determination of a dot or a comma to FALSE until it was successfull. + bDotOrCommaIncluded = FALSE + + if IsMissing(sDummy$) then + '/// Opening a new document depending on <i>gApplication</i> value and closing it at the end. + Call hNewDocument + '/// Tools / Options / (Modul: gApplication) / General tabpage. + ToolsOptions + '///+ <ol><li>Reading the string of the tabulator numeric field</li> + select case UCase(gApplication) + case "WRITER", "TEXTDOKUMENT" : Call hToolsOptions("TEXTDOCUMENT","GENERAL") + sCheckForSeparator = Tabulatorenabstand.GetText + case "CALC", "TABELLENDOKUMENT" : Call hToolsOptions("SPREADSHEET","GENERAL") + sCheckForSeparator = Tabulator.GetText + case "IMPRESS", "PRAESENTATION" : Call hToolsOptions("PRESENTATION","GENERAL") + sCheckForSeparator = Tabulatorenabstand.GetText + case "DRAW", "ZEICHNUNG" : Call hToolsOptions("DRAWING","GENERAL") + sCheckForSeparator = Tabulatorenabstand.GetText + case "GLOBALDOC", "GLOBALDOKUMENT": Call hToolsOptions("TEXTDOCUMENT","GENERAL") + sCheckForSeparator = Tabulatorenabstand.GetText + case "HTML", "HTMLDOKUMENT" : Call hToolsOptions("TEXTDOCUMENT","GENERAL") + sCheckForSeparator = Tabulatorenabstand.GetText + case else : warnlog cWhereIsThisFunction & "For this module ("& gApplication &") no decimal seperator setting exists." + end select + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK + if Instr(sCheckForSeparator, ",") > 0 then + GetDecimalSeperator = "," + bDotOrCommaIncluded = TRUE + endif + if Instr(sCheckForSeparator, ".") > 0 then + GetDecimalSeperator = "." + bDotOrCommaIncluded = TRUE + endif + Call hCloseDocument + else + '///+ <li>or determining the seperator depending on the OPTIONAL value (string).</li></ol> + 'Get position of fraction mark / get IT + if InStr (sDummy$, ",") > 0 then + GetDecimalSeperator = "," + bDotOrCommaIncluded = TRUE + endif + if InStr (sDummy$, ".") > 0 then + GetDecimalSeperator = "." + bDotOrCommaIncluded = TRUE + endif + endif + + '/// If the determination failed the dot will be used (default) as decimal seperator. + if bDotOrCommaIncluded = FALSE then + warnlog cWhereIsThisFunction & "Unable to determine decimal separator. Setting dot (.) as default." + GetDecimalSeperator = "." + endif + printlog "Info: Decimal Seperator is a '" & GetDecimalSeperator & "'." +end function + +sub sResetTheOffice as boolean + Dim uno + Dim ap + Dim xViewRoot + Dim apara(1) As new com.sun.star.beans.PropertyValue + Dim temp() + Dim i,x as integer + Dim sString as string + Dim fDeleteList(32000) as string + Dim sLanguage as string + Dim bError as boolean + Dim sDefaultLocale as string + Dim sDefaultLocaleCJK as string + Dim sDefaultLocaleCTL as string + Dim sfgetL10Nvalue as string + Dim SetupXML as String + Dim SetupXMLNet as string + Dim SetupXMLDefault as string + Dim sLanOutIni as string + + sString = "qa:qatesttool:calc:options:inc:coption1.inc:: " + sResetTheOffice = TRUE + + ' only run on UNIX platforms; there is a problem with the quickstarter on win32 + if ("unx" = gPlatgroup) then + try + SetupXML = gOfficePath & ConvertPath("user\registry\data\org\openoffice\Setup.xcu") + ' function 'fgetL10Nvalue' is also in this library + sLanOutIni = fgetL10Nvalue(SetupXML) + catch + try + ' BugID 98315 -> looking in networkpath for the language until bug will be fixed. + SetupXMLNet = gNetzOfficePath & ConvertPath("share\registry\data\org\openoffice\Setup.xcu") + sLanOutIni = fgetL10Nvalue(SetupXMLNet) + catch + try + ' It is an English FAT version 645m9s2 or higher. + SetupXMLDefault = gOfficePath & ConvertPath("share\registry\data\org\openoffice\Setup.xcu") + sLanOutIni = fgetL10Nvalue(SetupXMLDefault) + catch + warnlog sString & SetupXML & " not found => can't get the correct Office-Language!." + sResetTheOffice = FALSE + Exit sub + endcatch + endcatch + endcatch + + uno=hGetUnoService() + + 'Get UI language + try + ap=uno.createInstance("com.sun.star.configuration.ConfigurationProvider") + apara(0).Name="nodepath" + apara(0).Value="/org.openoffice.Office.Linguistic/General" + apara(1).Name="lazywrite" + apara(1).Value=False + xViewRoot=ap.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPara()) + sLanguage = sfgetL10Nvalue + sDefaultLocale = xViewRoot.getPropertyValue("DefaultLocale") + sDefaultLocaleCJK = xViewRoot.getPropertyValue("DefaultLocale_CJK") + sDefaultLocaleCTL = xViewRoot.getPropertyValue("DefaultLocale_CTL") + printlog "Old UI language: '" + sLanOutIni + "'" + printlog "Old default locale: '" + sDefaultLocale + "'" + printlog "Old default locale CJK: '" + sDefaultLocaleCJK + "'" + printlog "Old default locale CTL: '" + sDefaultLocaleCTL + "'" + xViewRoot.dispose() + bError = FALSE + catch + warnlog sString + "Failed to read UI language." + bError = TRUE + endcatch + + if NOT bError then + 'Close OOo + try + ' To prevent restarting of OOo, the try/catch is around this and + ' to prevent messages about communication errors + printlog ResetApplication + FileExit "SynchronMode", TRUE + try + ' It is no error, if this fails - so it gets its own try/catch + kontext + if active.exists(5) then + active.no 'discard changes + endif + catch + endcatch + bError = FALSE + catch + warnlog sString + "Failed to close OOo." + bError = TRUE + endcatch + sleep 10 'To wait until OOo is realy away + endif + + 'only act, if no error and if language <> '' + if (NOT bError AND sLanguage <> "") then + 'Remove user directory + try + if (right(gOfficePath,1)=gPathSigne) then + 'Dir doesn't work, is a path singe is at the end + gOfficePath = left(gOfficePath,len(gOfficePath)-1) + endif + printlog "Going to delete directory: '" + gOfficePath + "'" + if (dir(gOfficePath) = "") then + qaErrorlog "Directory is already deleted." + else + rmDir (gOfficePath) + if (dir(gOfficePath) <> "") then + warnlog "Directory wasn't deleted." + endif + endif + bError = FALSE + catch + warnlog sString + "Failed to delete user directory." + bError = TRUE + endcatch + endif + + 'Start OOo and restore language + 'Needs only to be done, if UI language wasn't the default (!= "") + if ((sLanguage & sDefaultLocale & sDefaultLocaleCJK & sDefaultLocaleCTL) <> "") then + try + hStartTheOffice + Call hDisableQuickstarter + 'Here we need the Exit from a running Quickstarter... + Call ExitRestartTheOffice + uno=hGetUnoService() + ap=uno.createInstance("com.sun.star.configuration.ConfigurationProvider") + apara(0).Name="nodepath" + apara(0).Value="/org.openoffice.Office.Linguistic/General" + apara(1).Name="lazywrite" + apara(1).Value=False + xViewRoot=ap.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPara()) + if (sLanOutIni <> "") then + printlog "Old UI language: '" + sLanOutIni + "'" + xViewRoot.setPropertyValue("UILocale", sLanOutIni) + xViewRoot.commitChanges() + endif + if (sDefaultLocale <> "") then + printlog "Old default locale: '" + sDefaultLocale + "'" + xViewRoot.setPropertyValue("DefaultLocale", sDefaultLocale) + xViewRoot.commitChanges() + endif + if (sDefaultLocaleCJK <> "") then + printlog "Old default locale CJK: '" + sDefaultLocaleCJK + "'" + xViewRoot.setPropertyValue("DefaultLocale_CJK", sDefaultLocaleCJK) + xViewRoot.commitChanges() + endif + if (sDefaultLocaleCTL <> "") then + printlog "Old default locale CTL: '" + sDefaultLocaleCTL + "'" + xViewRoot.setPropertyValue("DefaultLocale_CTL", sDefaultLocaleCTL) + xViewRoot.commitChanges() + endif + if xViewRoot.hasPendingChanges() then + warnlog(sFileFunction+"Changes still pending...") + endif + xViewRoot.dispose() + catch + warnlog sString + "Failed to set UI language." + exit sub + endcatch + endif + + Call ExitRestartTheOffice + endif +end sub + +'------------------------------------------------------------------------- + +sub raiseApplication +' Try to solve focus problem on MacOS X; After calling this function, OOo should be most front; + Dim i as integer + Dim a as integer + Dim b as integer + Dim tBundle as string + Dim aPath + + ' Calling just the .app with open on MacOS X via shell command + if gPlatform = lcase("osx") then + aPath = split(gNetzOfficePath, gPathSigne) + a=0 + ' make sure 'Contents' is just one time in path + for i=0 to uBound(aPath) + if "Contents" = aPath(i) then + a=a+1 + endif + next i + ' exit if not + if a<>1 then + exit sub + end if + i=inStr(gNetzOfficePath, "Contents") + tBundle=left(gNetzOfficePath, i-2) + shell("open",1 ,tBundle, true) + end if +end sub + diff --git a/testautomation/global/tools/includes/required/t_tools2.inc b/testautomation/global/tools/includes/required/t_tools2.inc new file mode 100755 index 000000000000..51de99dd1bec --- /dev/null +++ b/testautomation/global/tools/includes/required/t_tools2.inc @@ -0,0 +1,1127 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_tools2.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:11 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : joerg.sievers@sun.com +'* +'* short description : Global Tools II +'* +'*************************************************************************************** +'* +' #1 GetOLEDefaultNames 'Get the correct language depending names for OLE objects +' #1 hSetLocaleStrings 'Set a string array with language dependant strings +' #1 GetHTMLCharSet 'Get the character set for HTML export +' #1 SetHTMLCharSet 'Set the character set for HTML export +' #1 SetHTMLCharSetToUTF8 'Set the character set for HTML export to UTF8 +' #1 dec 'Decrease variable +' #1 inc 'Increase variable +' #1 ActivateAutoPilot 'Routine to activate (WebPage Autopilot, Form Autopilot, Documentconverter, Euroconveter and Addressdatasource) +' #1 SetURL 'Open a special URL with 'file open'-dialog +' #1 fGetFileText 'This function is for getting the first or last n characters of a file +' #1 fSetMeasurementToCM 'Sets the measurement unit to cm and returns the unit +' #1 fRemoveDoubleSpace 'Removes every space after a space +' #1 writeCrashRepFile 'Creates a file (gOfficePath)/user/work/crashrep.txt with testcase- and .bas-name +' #1 GetBuildNumHidLst 'Get the BuildId out of the hid.lst +' #1 fGetProductName 'Reads the ProductKey from bootstrap file and cuts of version number +' #1 fopenConfig 'Open a configuration package from the Office installation via UNO API. +' #1 hGetUNOService 'Function enables the UNO communication inside the TestTool to the office application. +' #0 hSetBuildVersionInformation 'set global version information variables: gMajor, gMinor, gBuild +' #1 FindBuildID 'Scans in iso*.res for the BuildID. +' #1 fRelativeToAbsolutePath 'removes ".." from a path with logic +' #1 sCheckValgrindStatus 'recognizes file $HOME/tcs.txt for valgrind tools +' #1 fgetDocumentLanguages 'gets the Default language for documents +' #1 fRemoveDoubleCharacter 'Removes double characters from a string +'* +'\************************************************************************************* + +sub GetOLEDefaultNames + + '/// Reads the names of all OLE objects from a reference file. +'///+ The OLE name-files are language dependent and should be created +'///+ using the the <i>getnames.bas</i> script running on Windows +'///+ The files are (per this revision) written and read utf-8 encoded. +'///+ The OLE names are stored in global variables. + + const CFN = "t_tools2::GetOLEDefaultNames():" + + dim sPath as string + sPath = gTesttoolPath & "global\input\olenames\" & gProductName + + dim sFile as String ' the file that contains the OLE names + sFile = convertpath( sPath & "\ole_" & iSprache & ".txt" ) + + dim sFilterList(20) as String ' the list that temporarily holds the OLE names + sFilterlist( 0 ) = "0" + + printlog( CFN & "Using OLE names from: " & sFile ) + + ' Find the reference file. Warn if not found and exit + if ( Dir ( sFile ) = "" ) then + + Warnlog( CFN & " The file for default-filter-names is missing." + PrintLog( "Please create the list with ..\global\tools\getnames.bas::GetFilterNames!" ) + exit sub + + end if + + ' Read the file data into an array (sFilterList), utf-8 encoded + call ListRead ( sFilterList(), sFile, "utf8" ) + + ' Evaluate the array and assign the data to global variables. + gOLEWriter = hGetValueForKeyAsString( sFilterList() , "WRITER" ) + gOLECalc = hGetValueForKeyAsString( sFilterList() , "CALC" ) + gOLEImpress = hGetValueForKeyAsString( sFilterList() , "IMPRESS" ) + gOLEDraw = hGetValueForKeyAsString( sFilterList() , "DRAW" ) + gOLEMath = hGetValueForKeyAsString( sFilterList() , "MATH" ) + gOLEChart = hGetValueForKeyAsString( sFilterList() , "CHART" ) + gOLEOthers = hGetValueForKeyAsString( sFilterList() , "OTHER" ) + +end sub + +'------------------------------------------------------------------------- + +function hSetLocaleStrings (fLocale as String, TBOstringLocale() as String ) as Boolean +'TODO: JSI, make real description from it! +' creator: TBO @ 25.10.2001 +'/// function to set a string array with language dependant strings /// +'/// format of file (fLocale): /// +'///+ 1.line: entries/lines per language => x /// +'///+ 2.line: first language (A) number (iSprache) /// +'///+ 3.line: 1. string language A /// +'///+ 4.lin3: 2.language string A /// +'///+ ... /// +'///+ (((x+1)*1) +2).line second language (B) number /// +'///+ (((x+1)*1) +2)+1.line: 1. string language B /// +'///+ ... /// +'///+ example file @ "input\\writer\\la_sp\\locale.txt" ///' +' +'/// the function parses the file until it finds the language (iSprache) or until EOF /// +'///+ on success the variable from th ecalling argument /// +'///+ gets set, /// + dim lLocale (15*20) as string ' list, where file gets loaded into + dim i,y,x as integer + dim bFoundLanguage as Boolean + hSetLocaleStrings = FALSE + lLocale(0)=0 + fLocale = ConvertPath(fLocale) + if ListRead (lLocale (), fLocale, "UTF8" ) then +' printlog "LOCALE: read file :-)" + + bFoundLanguage = FALSE + ' check file format + if ( (ListCount(lLocale ()) -1) mod (val(lLocale (1))+1) ) <> 0 then + warnlog "file has wrong format :-( : lines: "+ ListCount(lLocale ()) +", lenght of entries: "+ lLocale (1) +", (lenght -1) modulo lenghtOfEntries: "+ ( ListCount(lLocale ()) -1) mod ( val(lLocale (1)) +1 ) + else + ' ( all lines in file ) (trnsl words) + for i=0 to ( ( (ListCount(lLocale ())-1) / (val(lLocale (1))+1) )-1) + ' ( (val(lLocale (1))+1) *i+2) + x = ( (val(lLocale (1)) ) *i+2 +i) ' line number of entry language + ' print every language found: +' printlog "position: "+i+" @ line: "+x+" Language: "+lLocale (x) + ' check if at suspected language number position is a number + if (val(lLocale (x)) > 0) then + ' set string variable if it is the right language + if (iSprache = val(lLocale (x))) then +' printlog " ^ LOCALE: found needed language :-)" + for y=1 to val(lLocale (1)) + TBOstringLocale(y) = lLocale (x+y) + if (TBOstringLocale(y) = "") then + qaErrorLog("missing string: " + y + ": '" + lLocale (2+y) + "'") + endif + next y + bFoundLanguage = TRUE + endif + else + warnlog "LOCALE: this is no number :-( FileFormatError" + end if + next i + if (bFoundLanguage = FALSE) then + qaErrorLog "LOCALE: please add language to LOCALE file!: "+ iSprache + endif + endif + else + warnlog "LOCALE: file doesn't exist :-( : "+fLocale + endif + hSetLocaleStrings = bFoundLanguage +end function + +'------------------------------------------------------------------------- + +sub GetHTMLCharSet as String +'///function to get the Character Set for HTML export +'///+(tools/options/load&save/HTML compatibility -> Character Set) + ToolsOptions + hToolsOptions ( "LoadSave", "HTMLCompatibility" ) + GetHTMLCharSet = Zeichensatz.GetSelText + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK +end sub + +'------------------------------------------------------------------------- + +sub SetHTMLCharSet ( CharSet as String ) +'///routine to set the Character Set for HTML export +'///+( tools/options/load&save/HTML compatibility -> Character Set ) + ToolsOptions + hToolsOptions ( "LoadSave", "HTMLCompatibility" ) + Zeichensatz.Select CharSet + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK +end sub + +'------------------------------------------------------------------------- + +sub SetHTMLCharSetToUTF8 as Boolean +'///function to set the Character Set for HTML export to 'Unicode UTF8' +'///+( tools/options/load&save/HTML compatibility -> Character Set ) + Dim i as Integer + Dim sDum as String + + ToolsOptions + hToolsOptions ( "LoadSave", "HTMLCompatibility" ) + + for i=1 to Zeichensatz.GetItemCount + sDum = Zeichensatz.GetItemText (i) + if Instr ( lcase (sDum), "utf-8" ) <> 0 then + Zeichensatz.Select (i) + i=1000 + else + if Instr ( lcase (sDum), "utf8" ) <> 0 then + Zeichensatz.Select (i) + i=1000 + else + if Instr ( lcase (sDum), "utf 8" ) <> 0 then + Zeichensatz.Select (i) + i=1000 + end if + end if + end if + next i + if i<1000 then + SetHTMLCharSetToUTF8 = FALSE + else + SetHTMLCharSetToUTF8 = TRUE + end if + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK +end sub + +'------------------------------------------------------------------------- + +function dec(Ref as integer) +'/// decrement variable, call it like 'dec variable' ///' +' reference or value .-) an excursion :-)) +' to give this func a var as ref: call without ANY brackets => 'dec Variable' +' opposite of this to call it via value ! WE DON'T WANT THIS ! +' (would be 'dec (Variable)' or in declaration 'function dec (ByVal x)') + Ref = Ref - 1 +end function + +'------------------------------------------------------------------------- + +function inc(Ref as integer) +'/// increment variable, call it like 'dec variable' ///' + Ref = Ref + 1 +end function + +'------------------------------------------------------------------------- + +function ActivateAutoPilot ( sWhichOne as String ) as Boolean +'Author: TZ +'///Routine to activate (WebPage Autopilot, Form Autopilot, Documentconverter and Euroconveter) +'///Open via menu items (not via SlotID or Macro URL) +'///<u>input</u>: Which Autopilot (<i>webpage</i>, <i>form</i>, <i>documentconverter</i>, <i>euroconverter</i>,<i>addressdatasource</i>) +'///<u>output</u>:<ul><li>TRUE: Autopilot is open</li><li>FALSE: Autopilot can not be opened</li></ul> + Dim bIsLoaded as boolean, LoadTime as integer, PrintTime as Integer + + bIsLoaded = FALSE + LoadTime = 0 + + select case gApplication + case "WRITER", "TEXTDOKUMENT" + Kontext "DocumentWriter" + DocumentWriter.UseMenu + case "HTML", "HTMLDOKUMENT" + Kontext "DocumentWriterWeb" + DocumentWriterWeb.UseMenu + case "MASTERDOC", "GLOBALDOKUMENT", "GLOBALDOC" + Kontext "DocumentMasterDoc" + DocumentMasterDoc.UseMenu + case "CALC", "TABELLENDOKUMENT" + Kontext "DocumentCalc" + DocumentCalc.UseMenu + case "IMPRESS", "PRAESENTATION" + Kontext "DocumentImpress" + DocumentImpress.UseMenu + case "DRAW", "ZEICHNUNG" + Kontext "DocumentDraw" + DocumentDraw.UseMenu + case "MATH", "FORMEL" + Kontext "DocumentMath" + DocumentMath.UseMenu + case else + Kontext "DocumentWriter" + DocumentWriter.UseMenu + end select + sleep(2) + hMenuSelectNr(1) + sleep(2) + hMenuSelectNr(4) + sleep(2) + + select case lcase (sWhichOne) + case "webpage" : hMenuSelectNr(5) + case "documentconverter" : hMenuSelectNr(6) + case "euroconverter" : hMenuSelectNr(7) + case "addressdatasource" : hMenuSelectNr(8) + end select + sleep(5) + + while bIsLoaded = False + while LoadTime < 20 + PrintTime = LoadTime * 3 + select case lcase ( sWhichOne ) + case "webpage" : Kontext "AutopilotWebPage" + if AutopilotWebPage.Exists(1) then + bIsLoaded = true + printlog "Autopilot is loaded in " + PrintTime + " seconds!" + LoadTime = 20 + ActivateAutoPilot = TRUE + end if + case "report" : Kontext "AutoPilotReport" + if AutoPilotReport.Exists(1) then + bIsLoaded = true + printlog "Autopilot is loaded in " + PrintTime + " seconds!" + LoadTime = 20 + ActivateAutoPilot = TRUE + end if + case "form" : Kontext "ChooseDatabase" + if ChooseDatabase.Exists(1) then + bIsLoaded = true + printlog "Autopilot is loaded in " + PrintTime + " seconds!" + LoadTime = 20 + ActivateAutoPilot = TRUE + end if + case "documentconverter" : Kontext "DocumentConverter" + if DocumentConverter.Exists(1) then + bIsLoaded = true + printlog "Autopilot is loaded in " + PrintTime + " seconds!" + LoadTime = 20 + ActivateAutoPilot = TRUE + end if + case "euroconverter" : Kontext "AutoPilotEuroKonverter" + if AutoPilotEuroKonverter.Exists(1) then + bIsLoaded = true + printlog "Autopilot is loaded in " + PrintTime + " seconds!" + LoadTime = 20 + ActivateAutoPilot = TRUE + end if + case "addressdatasource" : Kontext "AddressSourceAutopilot" + if AddressSourceAutopilot.Exists(1) then + bIsLoaded = true + printlog "Autopilot is loaded in " + PrintTime + " seconds!" + LoadTime = 20 + ActivateAutoPilot = TRUE + end if + + end select + 'NOTE: Maybe a messagebox occurs. + Kontext "Active" + if Active.Exists (1) then + warnlog Active.GetText + try + Active.OK + catch + Active.Cancel + endcatch + ActivateAutoPilot = FALSE + end if + sleep(1) + LoadTime = LoadTime + 1 + if LoadTime = 20 and bIsLoaded = False then + warnlog "Autopilot has not been loaded!" + ActivateAutoPilot = FALSE + bIsLoaded = TRUE + end if + wend + wend +end function + +'------------------------------------------------------------------------- + +function SetURL ( sURL as String ) +'Author: TZ +'/// Routine to open a special URL with <i>file open</i>-dialog +'/// <u>input</u>: The URL as string + FileOpen + Kontext "OeffnenDlg" + Dateiname.SetText sURL + Oeffnen.Click + wait 500 +end function + +'------------------------------------------------------------------------- + +function fGetFileText (sFilename as string, iCount as long) as string +'/// This function is for getting the first or last n characters of a file +'///+<u>Input</u>:<ul><li>filename</li><li>number</li></ul>If the number greater 0 then get n characters from start. +'///+A number smaller 0 get from end of file. +'///+<u>Output</u>:<ul><li>string with <b><i>n</i></b> characters</li></ul> + + dim iFile as integer ' filehandle + dim iTem as integer ' get 2 bytes of the file + dim iTemByte(2) as integer ' move 1 byte from iTem in each item + dim sTemp as string ' string of file + dim iSize as long ' size in bytes of file + dim i as long ' runner :-) + + iFile = FreeFile +' Printlog "FreeFile: " + iFile + if (dir (sFilename) <> "") then +' Printlog "FileLen: " + FileLen(sFile) + Open sFilename For binary access read shared As #iFile +' Printlog "Loc: " + Loc(#iFile) ' LONG! where am i in the file? + + iSize = Lof(#iFile) ' get size in bytes of file + if (iSize > 65530) then '65536 = 64kB + 'Warnlog "fGetFileText: file '" + sFilename + "' might get problems on reading it? size is > 65530 Byte: '" + iSize + "'" + else +' printlog "iSize: " + iSize + endif + + sTemp = "" + if (iCount >= 0) then ' get bytes from file start + get iFile,1,sTemp ' get max 64kByte; but not the 1st 2 bytes :-( + get iFile,1,iTem ' get the first 2 bytes of the file + iTemByte(2) = (iTem AND &H0000FF00) \ &H100 ' and seperate the bytes + iTemByte(1) = (iTem AND &H000000FF) + sTemp = chr(iTemByte(1)) + chr(iTemByte(2)) + sTemp ' put them together + else ' get bytes from file end + if ((iSize+iCount) > 0) then + select case (iSize+iCount) + case 1: get iFile,1,sTemp ' take bytes from the end of the file + get iFile,1,iTem ' get the first 2 bytes of the file + sTemp = chr(iTemByte(2)) + sTemp ' put them together + case else: get iFile,(iSize+iCount)-1,sTemp ' take bytes from the end of the file + end select + else + get iFile,1,sTemp ' take bytes from the end of the file + get iFile,1,iTem ' get the first 2 bytes of the file + iTemByte(2) = (iTem AND &H0000FF00) \ &H100 ' and seperate the bytes + iTemByte(1) = (iTem AND &H000000FF) + sTemp = chr(iTemByte(1)) + chr(iTemByte(2)) + sTemp ' put them together + endif + endif +' printlog "'"+left(sTemp,iSize)+"'" ' gotcha! + + if (iSize-(Abs(iCount)) >= 0) then + fGetFileText = left(sTemp,Abs(iCount)) + else + 'Warnlog "fGetFileText: file '" + sFilename + "' isn't as big as expected; will only return '" + iSize+ "' bytes fom: " + iCount + fGetFileText = left(sTemp,iSize) + endif + + ' debugging routine -------------------------------------- + ' iSize = Lof(#iFile) + ' printlog "iSize: " + iSize + ' sTemp = "" + ' if iSize > 0 then + ' printlog "iSize \ 2: " + (iSize \ 2) + ' for i = 0 to ((iSize \ 2)-1) + ' get iFile,(i*2)+1,iTem + ' Printlog "i: " + i + ": 0x" + hex(iTem) + ' iTemByte(2) = (iTem AND &H0000FF00) \ &H100 + ' iTemByte(1) = (iTem AND &H000000FF) + ' sTemp = sTemp + chr(iTemByte(1)) + chr(iTemByte(2)) + ' next i + ' if (iSize MOD 2) = 1 then + ' get iFile,iSize,iTem + ' Printlog "i: " + iSize + ": 0x" + hex(iTem) + ' iTemByte(1) = (iTem AND &H000000FF) + ' sTemp = sTemp + chr(iTemByte(1)) + ' endif + ' endif + ' printlog "'"+sTemp+"'" + ' debugging routine -------------------------------------- + Close #iFile + else ' does file exist + Warnlog "fGetFileText: file '" + sFilename + "' doesn't exist" + fGetFileText = "" + endif +end function +' +'------------------------------------------------------------------------- +' +function fSetMeasurementToCM() as string +'/// Sets the measurement unit to centimeter (cm) and returns the unit. + Dim i as integer + + Call hNewDocument + ToolsOptions + select case UCase(gApplication) + case "WRITER", "TEXTDOKUMENT" : Call hToolsOptions("TEXTDOCUMENT","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 ) + endif + case "CALC", "TABELLENDOKUMENT" : Call hToolsOptions("SPREADSHEET","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulator.Gettext , 3 ) + else + fSetMeasurementToCM = Right$( Tabulator.Gettext , 2 ) + endif + case "IMPRESS", "PRAESENTATION" : Call hToolsOptions("PRESENTATION","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 2 ) + endif + case "DRAW", "ZEICHNUNG" : Call hToolsOptions("DRAWING","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 2 ) + endif + case "GLOBALDOC", "GLOBALDOKUMENT": Call hToolsOptions("TEXTDOCUMENT","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 ) + endif + case "HTML", "HTMLDOKUMENT" : Call hToolsOptions("HTMLDOCUMENT","VIEW") + Masseinheit.Select(2) + 'in Writer/Web also the Writer has to be set to cm + 'because .sdw, .sxw etc. export to HTML depends on it. + Call hToolsOptions("TEXTDOCUMENT","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 ) + endif + case else : warnlog swhereIsThisFunction & "For this module ("& gApplication &") no decimal seperator setting exists." + end select + printlog "Info: Measurement unit has been set to centimeters." + Kontext "ExtrasOptionenDlg" + ExtrasOptionenDlg.OK + Call hCloseDocument +end function + +'------------------------------------------------------------------------- + +function fRemoveDoubleCharacter(stringToChange as string, sCharacter as string) As String +'/// Removes every Character' after a 'Character' in a given string. + Dim lLength, n As Long + Dim sNextLetter As String + Dim sLastLetter As String + Dim sFinalString As String + Dim sTxt, sChar As String + + 'store all arguments in + sTxt = stringToChange + lLength = Len(sTxt) + sLastLetter = left(sTxt, 1) + sFinalString = sLastLetter + + For n = 2 To lLength Step 1 + sNextLetter = Mid(sTxt, n, 1) + If (sCharacter+sCharacter <> sLastLetter + sNextLetter) Then + sFinalString = sFinalString + sNextLetter + End If + sLastLetter = sNextLetter + Next n + fRemoveDoubleCharacter = sFinalString +End Function + +'------------------------------------------------------------------------- + +function fRemoveDoubleSpace(stringToChange as string) As String + fRemoveDoubleSpace = fRemoveDoubleCharacter(stringToChange, " ") +End Function + +'------------------------------------------------------------------------- + +function writeCrashRepFile() +'/// Creates a file <i>(gOfficePath)</i>/user/work/crashrep.txt with two lines: +'///+ <ol><li>name of .bas file</li> +'///+ <li>name of testcase</li></ol> + Dim sFile as string + Dim sContent(5) as string + + sFile = ConvertPath (gOfficePath + "user\work\crashrep.txt") + listAppend(sContent(), gTestName) ' get's set in hStatusIn() + listAppend(sContent(), getTestcaseName) + listWrite(sContent(), sFile) +end function + +'------------------------------------------------------------------------- + +function GetBuildNumHidLst as String +'/// Get the "BuildId" out of the <i>hid.lst</i>. + Dim FileNum as Integer + Dim xmlZeile as String + dim iIndex as integer + dim sTemp as string + + if Dir (gtHidLstPath + "hid.lst") <> "" then + FileNum = FreeFile + Open (gtHidLstPath + "hid.lst") For Input As #FileNum + do until EOF(#FileNum) = True + line input #FileNum, xmlZeile + iIndex = inStr (1, xmlZeile, "_HID_Eigen", 1) + sTemp = Left (xmlZeile, abs(iIndex - 1)) + ' usually only the first line is read + if (sTemp <> "") then exit do + loop + Close #FileNum + GetBuildNumHidLst = sTemp + else + GetBuildNumHidLst = "" + end if +end function + +'------------------------------------------------------------------------- + +function hGetUNOService(optional bSilent as boolean, optional byRef sUnoPortExternal as string) as object +'/// Function enables the UNO communication inside the +'///+ TestTool to the office application. +'/// INPUT: optional <i>bSilent</i> to suppress informal messages, but no warnings +'/// INPUT: optional <i>sUnoPortExternal</i> to just get the UNO port number passed to that variable + Dim sResultUno as string + Dim sUnoPort as string + Dim sOfficeParameters as string + Dim sUnoOffice as string + Dim bJustGettingPort as boolean + Dim sTTPort as string + + ' To not to change the old behaviour, set variable if parameter is not given + if (isMissing(bSilent)) then + bSilent = FALSE + end if + + ' master.inc::sStartUpOffice needs just the Port Numberr from UNO, to pass it to first start up + if (isMissing(sUnoPortExternal)) then + bJustGettingPort = FALSE + else + bJustGettingPort = TRUE + sUnoPortExternal = "" ' clear it + end if + + 'To enable spaces and special chars in path; + 'This doesn't work for the TestTool command 'start' + 'But for the 'shell' command it is ok. + sUnoOffice = convertToURL(sAppExe) + + '/// Get the TestTool port value from the TestTool control file + sTTPort = GetIniValue (gTesttoolIni, "Communication", "TTPort") + '/// Get the UNO port value from the TestTool control file + sResultUno = GetIniValue (gTesttoolIni, "Communication", "UnoPort") + ' make sure both ports are different + if sTTPort = sResultUno then + warnlog "TestTool and UNO port are the same ("+sResultUno+")! Please change the UNO port in the TestTool application: Extra -> Settings -> Misc -> Remote UNO Port and exit OpenOffice.org." + exit function + end if + if NOT bSilent then + printlog "Trying to use Office/Testtool UNO Port '" + sResultUno + "'." + endif + if (sResultUno <> "") then + sUnoPort = sResultUno + else + warnlog ("Please add an entry to your '" + gTesttoolIni + "' in section 'Communication': 'UnoPort=82352' and restart your testtool and exit OpenOffice.org.") + warnlog ("You also can check the setting in TestTool: Extra->Settings->Misc: and change the value for 'Remote UNO Port' and then exit OpenOffice.org.") + exit function + end if + if (NOT bJustGettingPort) then + '/// <i>-accept=socket,host=localhost,port=(PortNr);urp</i> has to be added to the start command. + sOfficeParameters = "-accept=socket,host=localhost,port=" + sUnoPort + ";urp" + try + '/// If this service has been used before the connection will be established. + hGetUNOService = getUnoApp + if NOT bSilent then + printlog "Office/Testtool UNO: CONNECTION SUCCESSFULL" + end if + ' If this tree will be used the connection has been established before! + catch + ' If the connection has not been established before this tree will be used. + '/// If the UNO service has not been used before the application will be <i>started</i> with the additional parameters. + qaerrorLog "/qa/qatesttool/global/tools/inc/t_tools2.inc::hGetUNOService 'getUnoApp' needn't fail anymore!" + Shell (sUnoOffice, 1,sOfficeParameters,false) + if NOT bSilent then + printlog "Office/Testtool UNO: TRYING TO CONNECT" + end if + sleep(10) + endcatch + + '/// This will be tried twice. + ' Second chance + if isNull(hGetUNOService) then + try + hGetUNOService = GetUnoApp + if NOT bSilent then + printlog "Office/Testtool UNO: CONNECTION SUCCESSFULL" + endif + catch + '/// If the UNO service could not be started a warnlog will be written to the result file. + warnlog "Office/Testtool UNO: CONNECTION FAILED" + endcatch + end if + else + sUnoPortExternal = sUnoPort + end if +end function + +'------------------------------------------------------------------------- + +function fopenConfig( sPackage as String ,_ + sPath as String ,_ + bReadWrite as Boolean ,_ + bAllLocale as Boolean ) as Object +'/// Open a configuration package from the Office installation via UNO API. +'/// <ul><b>Input</b> +'///+ <li>Parameter: <i>sPackage</i> +'///+ describe the package which should be handled by the returned +'///+ configuration access object +'///+ <u>Example</u>: "/org.openoffice.Office.TypeDetection"</li> +'///+ <li>Parameter: <i>sPath</i> +'///+ Specify the relativ path inside the new opened package, +'///+ where we are interested on +'///+ <u>Example</u>: "Types/xxx" => "/org.openoffice.Office.TypeDetection/Types/xxx"</li> +'///+ <li>Parameter: <i>bReadWrite</i> +'///+ Describe how the package should be opened (readonly/writable)</li> +'///+ <li>Parameter: <i>bAsLocale</i> +'///+ Enable/disable the special ALL LOCALE mode of the configuration API. +'///+ It makes it possible to have access on localized nodes directly instead +'///+ of using the generic handling of used API for it.</li></ul> +'///+ <b>Return</b>: <i>Object</i> +'///+ Object provides access to the required package or directly to a config key. + Dim sFullPath as String + Dim aConfig as Object + Dim aConfigProvider as Object + Dim lNormalParams(0) as new com.sun.star.beans.PropertyValue + Dim lLocaleParams(1) as new com.sun.star.beans.PropertyValue + Dim lParams() as Object + Dim oUno as Object + + sFullPath = sPackage+"/"+sPath + + if (bAllLocale=true) then + lLocaleParams(0).Name = "nodepath" + lLocaleParams(0).Value = sFullPath + lLocaleParams(1).Name = "locale" + lLocaleParams(1).Value = "*" + lParams() = lLocaleParams() + else + lNormalParams(0).Name = "nodepath" + lNormalParams(0).Value = sFullPath + lParams() = lNormalParams() + end if + + oUno = hGetUnoService + + aConfigProvider = oUno.createInstance("com.sun.star.configuration.ConfigurationProvider") + + if (bReadWrite=true) then + aConfig = aConfigProvider.createInstanceWithArguments( _ + "com.sun.star.configuration.ConfigurationUpdateAccess", _ + lParams() ) + else + aConfig = aConfigProvider.createInstanceWithArguments( _ + "com.sun.star.configuration.ConfigurationAccess", _ + lParams() ) + end if + + fopenConfig = aConfig +end function + +'------------------------------------------------------------------------- + +function fGetProductName as string +'/// Reads the ProductKey from bootstrap/version file and cuts of version number, + Dim sProduct as string + Dim sSplit() as string + Dim i as integer + Dim u as integer + Dim sFile as string + Dim sIniEntry as string + Dim cFileExt as string + + 'Using the bootstraprc/bootstrap.ini file in ../program dir + 'to get the value of 'ProductKey' + + if gPlatform = lcase("osx") then + sfile = convertPath(gNetzOfficePath + "MacOS/bootstrap") + else + sfile = convertPath(gNetzOfficePath + "program/bootstrap") + end if + + sIniEntry = "Bootstrap" + + 'Setting the differnt extension to the files. + if gPlatGroup = "unx" then + cFileExt = "rc" + else + cFileExt = ".ini" + end if + + 'Getting the value of 'ProductKey'-entry or setting it to 'OpenOffice.org 2.0' + if (dir(sFile+cFileExt) <> "") then + sProduct = getIniValue(sFile+cFileExt, sIniEntry , "ProductKey") + else + warnlog "Could not get the ProductKey value! Setting it to 'OpenOffice.org 2.0' and trying to run the tests!" + sProduct = "OpenOffice.org 2.0" + end if + if (sProduct <> "" AND sProduct <> "NOT EXISTING") then + sSplit = split(sProduct, " ") ' get count of spaces + sProduct = "" + 'Presupposition: Version number is not seperated by spaces, + 'but seperated with space from ProductName + u = uBound(sSplit) + if (u > 0) then + for i = 0 to (u-1) + sProduct = sProduct + sSplit(i) ' add strings until last Space + if (i <> (u-1)) then + sProduct = sProduct + " " + end if + next i + else + sProduct = sSplit(0) + end if + end if + fGetProductName = sProduct +end function + +'------------------------------------------------------------------------- + +function FindBuildID as String +'/// Get BuildID out of <i>bootstrap.ini/boostraprc</i> +'///+or search in <i>.../program/resource/isoxxx??.res</i> for the BuildID. + Dim sOfficePath as String + Dim FileNum, iStart, i as Integer + Dim xmlZeile, sZ1, sZ2, sIsofile as String + Dim sTemp as String + Dim sFile as string + Dim sPlatformProgramPath as string + + if (gNetzInst = TRUE) then + sOfficePath = gNetzOfficePath + else + sOfficePath = gOfficePath + end if + + ' bootstrap.ini/rc part + if (gSamePC = TRUE) then + ' since CWS nativefixer18 the information from bootstrap file is spread across bootstrap and version + if gPlatform = lcase("osx") then + sPlatformProgramPath = "MacOS" + else + sPlatformProgramPath = "program" + end if + sfile = convertPath(gNetzOfficePath & sPlatformProgramPath & "/version") + if gPlatGroup = "unx" then + sFile = sFile + "rc" + if (dir(sFile) <> "") then + sTemp = getIniValue(sFile, "Version", "buildid") + gMajor = getIniValue(sFile, "Version", "ProductSource") + else + sfile = convertPath(gNetzOfficePath & sPlatformProgramPath & "/bootstraprc") + sTemp = getIniValue(sFile, "Bootstrap", "buildid") + end if + else + sFile = sFile + ".ini" + if (dir(sFile) <> "") then + sTemp = getIniValue(sFile, "Version", "buildid") + gMajor = getIniValue(sFile, "Version", "ProductSource") + else + sfile = convertPath(gNetzOfficePath & sPlatformProgramPath & "/bootstrap.ini") + sTemp = getIniValue(sFile, "Bootstrap", "buildid") + end if + end if + end if + + ' fallback to get the buildID via isoxxx??.res part + if (sTemp = "") then + sIsofile = Dir (sOfficePath & sPlatformProgramPath & gPathSigne & "resource" & gPathSigne & "iso*.res") + if sIsofile = "" then + sIsofile = App.Dir (sOfficePath & sPlatformProgramPath & gPathSigne & "resource" & gPathSigne & "iso*.res") + end if + sIsofile = ConvertPath (sOfficePath & sPlatformProgramPath & gPathSigne & "resource" & gPathSigne & sIsofile) + if sIsofile= "" then + warnlog "FindBuildID : No isoxxx??.res-file was found!" + exit function + end if + + FileNum = FreeFile + Open sIsofile For Input As #FileNum + do until EOF(#FileNum) = True + line input #FileNum, xmlZeile + for i=1 to 100 + if i=1 then + sZ1 = left (xmlzeile, 2048) + else + sZ1 = left (sZ2, 2048) + end if + if sZ1 < 2048 then + i=101 + else + iStart = instr (1, sZ1, "Build", 1) + if iStart <> 0 then + iStart = iStart-5 + sTemp = Mid (sZ1, iStart, 16) + exit do + end if + sZ2 = right (sZ1, len (sZ1)-2048) + end if + next i + loop + Close #FileNum + end if + + ' WorkAround version information starting with 'SRC' or any other letter code as announced + iStart = len(sTemp) + i = 1 + ' take the first character + sZ1 = mid(sTemp,i,1) + ' if there is more than one character in the string AND the first character is not a number + if ((iStart > 0) AND (NOT isNumeric(sZ1))) then + ' increment counter as long as there is no number found in the string + while ((i < iStart) AND (NOT isNumeric(mid(sTemp,i,1)) )) + inc(i) + wend + ' cut of the not number characters at the start of the string + sTemp = right(sTemp, len(sTemp)-(i-1)) + end if + + FindBuildID = sTemp +end function + +'------------------------------------------------------------------------- + +sub hSetBuildVersionInformation(bQuite as boolean) +'/// set global version information variables: gMajor, gMinor, gBuild ///' +'/// presupposition: global variable gVersionsnummer is initialised by FindBuildID() ///' + dim slVersion() as string + dim ilVersion as integer + dim sLastVersion as string + dim iPosA as integer + dim iPosB as integer + + slVersion() = Split(gVersionsnummer, ",") + ilVersion = uBound(slVersion()) ' array counts from 0 on! + sLastVersion = slVersion(ilVersion) + ' major is from start to 'm' + iPosA = 1 + iPosB = instr(sLastVersion, "m") + if (iPosB = 0) then ' there is no minor + if (Not bQuite) then + warnlog "Product Version Information is missing (mXX). Please tell the developer to build with 'setsolar -ver'" + endif + iPosB = instr(sLastVersion, "(") + endif + if gMajor = "" then + gMajor = Mid(sLastVersion, iPosA, (iPosB-iPosA)) '(1) Major + endif + iPosA = iPosB + iPosB = instr(sLastVersion, "(") + gMinor = Mid(sLastVersion, iPosA, iPosB-iPosA) '(2) Minor + iPosA = instr(sLastVersion, ":") + 1 + iPosB = instr(sLastVersion, ")") + gBuild = cInt(Mid(sLastVersion, iPosA, iPosB-iPosA)) '(3) Build +end sub + +'------------------------------------------------------------------------- + +function fRelativeToAbsolutePath (sRelativePath as string) as string +'/// INPUT: provide a path with relative indicators ".." ///' +'///+ The input needs to konsist of the parts: where was the relative string found, and ///' +'///+ the relative path itself as one string. E.g: "/opt/var/../../here/is/it"///' +'/// RETURN: String with the removed parts for each relative iteration. E.g. This returns: "/here/is/it"///' + + dim iHowOften as string + dim aSplitOnDoublePoints() as string + dim aSplitOnPathSign() as string + dim aJoinWithPathSign() as string + dim i,x,y as integer + dim sIntern as string + + ' save the input + sIntern = sRelativePath + ' get count of 'relative path ups' + aSplitOnDoublePoints = split(sIntern, gPathSigne+"..") + ' for every occurence cut part from path + iHowOften = uBound(aSplitOnDoublePoints)-1 + for i = 0 to iHowOften + ' Split on every "/.." + aSplitOnDoublePoints = split(sIntern, gPathSigne+"..") + ' always work on the first part (The one before the first "/..") + ' Split the first path at the PathSeperators + aSplitOnPathSign = split(aSplitOnDoublePoints(0), gPathSigne) + ' define new size for the first part destination + redim aJoinWithPathSign(uBound(aSplitOnPathSign())-1) + ' copy the parts, but not the last part + for x = 0 to uBound(aJoinWithPathSign()) + aJoinWithPathSign(x) = aSplitOnPathSign(x) + next x + ' make one string of the parts with PathSeperators + aSplitOnDoublePoints(0) = join(aJoinWithPathSign(), gPathSigne) + ' cut the .. for this run from the string + redim aJoinWithPathSign(uBound(aSplitOnDoublePoints())-1) + y=0 + for x = 0 to uBound(aJoinWithPathSign())+1 + if x <> 1 then + aJoinWithPathSign(x-y) = aSplitOnDoublePoints(x) + else + y=1 + endif + next x + ' set put all parts together again into one string + if iHowOften <> i then + sIntern = join(aJoinWithPathSign(), gPathSigne+"..") + else + sIntern = join(aSplitOnDoublePoints(), "") + endif + next i + ' set the returnvalue + fRelativeToAbsolutePath = sIntern +end function + +'------------------------------------------------------------------------- + +sub sCheckValgrindStatus() + ' valgrind only exists on Linux + ' If testlauncher is started with parameter --valgrind, a file called + ' $HOME/tcs.txt is created, with the name of the .bas file + ' If you don't know the testlauncher, just make sure that the file is created + ' and contains the name of the .bas file, if you want to use valgrind tests. + Dim sTestCaseSpecification as string + Dim sList(10) as string + Dim sTemp as string + + sTemp = environ("HOME") + sTemp = sTemp + "/tcs.txt" + if fileExists(sTemp) then + ListRead(sList(), sTemp) + if (ListCount(sList())>0) then + sTemp = sList(1) + sTemp = right(sTemp, len(sTemp)-1) + printlog "** Valgrind mode detected: '" + sTemp + "'" + setChildEnv("tcs",sTemp) + end if + end if +end sub + +'------------------------------------------------------------------------- + +function fgetDocumentLanguages(byRef aDefaultLocale(), optional bInteger as boolean) +'/// INPUT: aDefaultLocale - array from 0 to 3 +'/// INPUT: OPTIONAL: bInteger - TRUE: return language as number en: 1; FALSE: (default) return the short text for locale e.g en_US +'/// RETURN: write in the deliverd array aDefaultLocale depending on bInteger the language from Tools->Options->Language Settings->Languages->Default language for documents +'///+ either the short string representing the language (default) e.g. en_US or the number e.g. 1 +'///+ The index of the array is defined: +'///+ (1) Western +'///+ (2) Asian +'///+ (3) CTL + + dim uno + dim ap + dim xViewRoot + dim apara(1) As new com.sun.star.beans.PropertyValue + dim i as integer + dim blInteger as boolean + + if isMissing(bInteger) then + blInteger = FALSE + else + blInteger = bInteger + endif + + uno=hGetUnoService(true) + ap=uno.createInstance("com.sun.star.configuration.ConfigurationProvider") + apara(0).Name="nodepath" + apara(0).Value="/org.openoffice.Office.Linguistic/General" + apara(1).Name="lazywrite" + apara(1).Value=False + xViewRoot=ap.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPara()) + aDefaultLocale(1) = xViewRoot.getPropertyValue("DefaultLocale") + aDefaultLocale(2) = xViewRoot.getPropertyValue("DefaultLocale_CJK") + aDefaultLocale(3) = xViewRoot.getPropertyValue("DefaultLocale_CTL") + xViewRoot.dispose() + + ' If the return of the language number is requested, convert it + if blInteger then + for i = 1 to 3 + if aDefaultLocale(i) <> "" then + aDefaultLocale(i) = convertLanguage2(aDefaultLocale(i)) + else + aDefaultLocale(i) = 0 + endif + next i + endif +end function + +'------------------------------------------------------------------------- + +function hDisableQuickstarterAPI as boolean + Dim xQuickStarter as object + Dim oUnoOfficeConnection as object + Dim bResult as boolean + + bResult = TRUE + 'Second, closing the Quickstarter process that a restart of the office + 'would result into one process (the Quickstart would hinder otherwise + 'the communication to the office. + 'On mac this results in a disbaled quickstarter imediately, but not persistant on restart. + oUnoOfficeConnection=hGetUnoService(TRUE) + if (isNull(oUnoOfficeConnection)) then + QAErrorLog "Couldn't create UNO access. Can't disable Quickstarter via UNO API." + bResult = FALSE + else + try + xQuickStarter = oUnoOfficeConnection.createInstance("com.sun.star.office.Quickstart") + 'DEBUG: printlog xQuickStarter.dbg_supportedinterfaces + 'disable quickstart veto (not quickstart UI) + xQuickStarter.setFastPropertyValue(0, FALSE) + catch + qaErrorLog "Join Quickstarter and OOo process failed. There will be problems on shutdown" + bResult = FALSE + endcatch + end if + hDisableQuickstarterAPI = bResult +end function + +'------------------------------------------------------------------------- + diff --git a/testautomation/global/tools/includes/required/t_tools3.inc b/testautomation/global/tools/includes/required/t_tools3.inc new file mode 100755 index 000000000000..56d362301e40 --- /dev/null +++ b/testautomation/global/tools/includes/required/t_tools3.inc @@ -0,0 +1,987 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: t_tools3.inc,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:11 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : helge.delfs@sun.com +'* +'* short description : Global Tools III +'* +'*************************************************************************************** +'* +' #1 hToolbarSelect ' opens/closes a toolbar through View/Toolbar menu +' #1 hCloseAllToolbars ' light implementation of i38796 +' #0 hIsAccessBridgeInstalled ' Find out whether the access bridge is installed +'* +'\************************************************************************************* + + +sub hToolbarSelect( sType as string, sOpen as boolean, optional SetToDefault as boolean ) + Dim sDefault as integer, sKontext as string, sPosition as integer + Dim SteppedThrough as boolean + '/// Created by helge.delfs@sun.com + '/// This function opens/closes a toolbar through View/Toolbar menu + '/// Required parameters: + '/// sType as string -> Name of the toolbar to be opened / closed + '/// sOpen as boolean -> Shall the toolbar be opened (true) or closed (false) + '/// optional SetToDefault as boolean -> true if Toolbar-State should be set to default + + Select Case Ucase(sType) + case "3DSETTING" + Kontext "ExtrusionObjectBar" + if ExtrusionObjectBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsThreeDSettings + else + if SetToDefault = True then ViewToolbarsThreeDSettings + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsThreeDSettings + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsThreeDSettings + endif + endif + endif + + + case "ALIGN" + Kontext "Alignmentbar" + if Alignmentbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsAlign + else + if SetToDefault = True then ViewToolbarsAlign + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsAlign + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsAlign + endif + endif + endif + + Case "BULLETSANDNUMBERING" + Kontext "NumObjectbar" + if NumObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsBulletsAndNumbering + else + if SetToDefault = True then ViewToolbarsBulletsAndNumbering + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsBulletsAndNumbering + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsBulletsAndNumbering + endif + endif + endif + + case "COLOR" + Kontext "ColorBar" + if ColorBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsColor + else + if SetToDefault = True then ViewToolbarsColor + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsColor + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsColor + endif + endif + endif + + case "CUSTOMIZE" + ViewToolbarsCustomize + + case "DRAWING" + Kontext "DrawBar" + if DrawBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsDrawing + else + if SetToDefault = True then ViewToolbarsDrawing + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsDrawing + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsDrawing + endif + endif + endif + + case "FORMATTING" + Kontext "TextObjectbar" + if TextObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFormatting + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFormatting + else + if SetToDefault = True then ViewToolbarsFormatting + endif + endif + endif + + case "FORMCONTROLS" + Kontext "FormControls" + if FormControls.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFormControls + else + if SetToDefault = True then ViewToolbarsFormControls + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFormControls + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFormControls + endif + endif + endif + case "CONTROLS" + Kontext "FormControls" + if FormControls.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFormControls + else + if SetToDefault = True then ViewToolbarsFormControls + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFormControls + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFormControls + endif + endif + endif + + case "FORMDESIGNTOOLS", "FORMDESIGN" + Kontext "FormDesignTools" + if FormDesignTools.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFormDesign + else + if SetToDefault = True then ViewToolbarsFormDesign + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFormDesign + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFormDesign + endif + endif + endif + + case "HTMLSOURCEVIEW" + Kontext "SourceViewToolbar" + if SourceViewToolbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsHTMLSourceView + else + if SetToDefault = True then ViewToolbarsHTMLSourceView + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsHTMLSourceView + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsHTMLSourceView + endif + endif + endif + + case "FORMFILTER" + Kontext "FormsFilterBar" + if FormsFilterBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFormFilter + else + if SetToDefault = True then ViewToolbarsFormFilter + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFormFilter + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFormFilter + endif + endif + endif + + case "FORMNAVIGATION" + Kontext "FormsNavigationBar" + if FormsNavigationBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFormNavigation + else + if SetToDefault = True then ViewToolbarsFormNavigation + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFormNavigation + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFormNavigation + endif + endif + endif + + case "FORMOBJECT" + Kontext "FormsObjectbar" + if FormsObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFormObject + else + if SetToDefault = True then ViewToolbarsFormObject + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFormObject + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFormObject + endif + endif + endif + + case "FRAME" + Kontext "FrameObjectbar" + if FrameObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFrame + else + if SetToDefault = True then ViewToolbarsFrame + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFrame + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFrame + endif + endif + endif + + case "FULLSCREEN" + Kontext "FullScreenBar" + if FullScreenBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsFullScreen + else + if SetToDefault = True then ViewToolbarsFullScreen + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsFullScreen + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsFullScreen + endif + endif + endif + + case "GRAPHIC", "DRAWINGOBJECTPROPERTIES" + Kontext "DrawingObjectbar" + if DrawingObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsGraphic + else + if SetToDefault = True then ViewToolbarsGraphic + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsGraphic + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsGraphic + endif + endif + endif + + case "HYPERLINK", "HYPERLINKBAR" + Kontext "Hyperlinkleiste" + if Hyperlinkleiste.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsInsertHyperlink + else + if SetToDefault = True then ViewToolbarsInsertHyperlink + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsInsertHyperlink + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsInsertHyperlink + endif + endif + endif + + + case "INSERT" + Kontext "InsertBar" + if InsertBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsInsert + else + if SetToDefault = True then ViewToolbarsInsert + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsInsert + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsInsert + endif + endif + endif + + case "INSERTOBJECT" + Kontext "InsertObjectBar" + if InsertObjectBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsInsertObject + else + if SetToDefault = True then ViewToolbarsInsertObject + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsInsertObject + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsInsertObject + endif + endif + endif + + case "MEDIAPLAYBACK" + Kontext "MediaObjectBar" + if MediaObjectBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsMediaPlayback + else + if SetToDefault = True then ViewToolbarsMediaPlayback + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsMediaPlayback + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsMediaPlayback + endif + endif + endif + + case "MORECONTROLS" + Kontext "MoreControls" + if MoreControls.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsMoreControls + else + if SetToDefault = True then ViewToolbarsMoreControls + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsMoreControls + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsMoreControls + endif + endif + endif + + case "MOREXFORMCONTROLS" + Kontext "MoreXFormControls" + if MoreXFormControls.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsMoreXFormControls + else + if SetToDefault = True then ViewToolbarsMoreXFormControls + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsMoreXFormControls + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsMoreXFormControls + endif + endif + endif + + case "OLEOBJECT" + Kontext "OLEObjectbar" + if OLEObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsOleObject + else + if SetToDefault = True then ViewToolbarsOleObject + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsOleObject + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsOleObject + endif + endif + endif + + case "OPTIMIZETABLE" + Kontext "OptimizeTablebar" + if OptimizeTablebar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsOptimizeTable + else + if SetToDefault = True then ViewToolbarsOptimizeTable + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsOptimizeTable + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsOptimizeTable + endif + endif + endif + + case "PAGEPREVIEW" + Kontext "PreviewObjectbar" + if PreviewObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsPagePreview + else + if SetToDefault = True then ViewToolbarsPagePreview + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsPagePreview + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsPagePreview + endif + endif + endif + + case "PATH" + Kontext "BezierObjectBar" + if BezierObjectBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsBezier + else + if SetToDefault = True then ViewToolbarsBezier + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsBezier + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsBezier + endif + endif + endif + + case "PICTURE" + Kontext "GraphicObjectbar" + if GraphicObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsPicture + else + if SetToDefault = True then ViewToolbarsPicture + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsPicture + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsPicture + endif + endif + endif + + case "PICTUREFILTER" + Kontext "GraphicFilterBar" + if GraphicFilterBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsPictureFilter + else + if SetToDefault = True then ViewToolbarsPictureFilter + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsPictureFilter + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsPictureFilter + endif + endif + endif + + case "STANDARD" + Kontext "StandardBar" + if StandardBar.Exists then + if StandardBar.IsVisible then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsStandard + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsStandard + else + if SetToDefault = True then ViewToolbarsStandard + endif + endif + endif + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsStandard + else + if SetToDefault = True then ViewToolbarsStandard + endif + endif + endif + + case "STANDARDVIEWINGMODE" + Kontext "Viewerbar" + if Viewerbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsStandardView + else + if SetToDefault = True then ViewToolbarsStandardView + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsStandardView + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsStandardView + endif + endif + endif + + case "TABLE" + Kontext "TableObjectbar" + if TableObjectbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsTable + else + if SetToDefault = True then ViewToolbarsTable + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsTable + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsTable + endif + endif + endif + + case "TEXTOBJECT" + Kontext "DrawTextObjectBar" + if DrawTextObjectBar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsTextObject + else + if SetToDefault = True then ViewToolbarsTextObject + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsTextObject + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsTextObject + endif + endif + endif + + case "TOOLS" + Kontext "Toolbar" + if Toolbar.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsTools + else + if SetToDefault = True then ViewToolbarsTools + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsTools + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsTools + endif + endif + endif + + + case "FORMULA" + Kontext "OL_SW_Rechenleiste" + if OL_SW_Rechenleiste.Exists then + Select Case sOpen + Case False + if IsMissing(SetToDefault) then + ViewToolbarsInsertFormula + else + if SetToDefault = True then ViewToolbarsInsertFormula + endif + Case True + if IsMissing(SetToDefault) = False then + if SetToDefault = True then ViewToolbarsInsertFormula + endif + end select + else + if sOpen = True then + if IsMissing(SetToDefault) then + ViewToolbarsInsertFormula + endif + endif + endif + + case else + Warnlog "No menuentry for parameter " & sType & " found!" + + end select + Sleep 1 + +end sub + +sub hCloseAllToolbars + '/// Created by thorsten.bosbach@sun.com + '/// This function closes all known toolbars which are not docked + '/// only if Build ID is below 8892 + if (gBuild < 8892) AND (gBuild > 8888) then + try + Kontext "ExtrusionObjectBar" + if ExtrusionObjectBar.Exists(0) then if NOT ExtrusionObjectBar.isDocked then ExtrusionObjectBar.close + Kontext "Alignmentbar" + if Alignmentbar.Exists(0) then if NOT Alignmentbar.isDocked then Alignmentbar.close + Kontext "NumObjectbar" + if NumObjectbar.Exists(0) then if NOT NumObjectbar.isDocked then NumObjectbar.close + Kontext "DrawBar" + if DrawBar.Exists(0) then if NOT DrawBar.isDocked then DrawBar.close + Kontext "TextObjectbar" + if TextObjectbar.Exists(0) then if NOT TextObjectbar.isDocked then TextObjectbar.close + Kontext "FormControls" + if FormControls.Exists(0) then if NOT FormControls.isDocked then FormControls.close + Kontext "FormControls" + if FormControls.Exists(0) then if NOT FormControls.isDocked then FormControls.close + Kontext "FormDesignTools" + if FormDesignTools.Exists(0) then if NOT FormDesignTools.isDocked then FormDesignTools.close + Kontext "SourceViewToolbar" + if SourceViewToolbar.Exists(0) then if NOT SourceViewToolbar.isDocked then SourceViewToolbar.close + Kontext "FormsFilterBar" + if FormsFilterBar.Exists(0) then if NOT FormsFilterBar.isDocked then FormsFilterBar.close + Kontext "FormsNavigationBar" + if FormsNavigationBar.Exists(0) then if NOT FormsNavigationBar.isDocked then FormsNavigationBar.close + Kontext "FormsObjectbar" + if FormsObjectbar.Exists(0) then if NOT FormsObjectbar.isDocked then FormsObjectbar.close + Kontext "FrameObjectbar" + if FrameObjectbar.Exists(0) then if NOT FrameObjectbar.isDocked then FrameObjectbar.close + Kontext "FullScreenBar" + if FullScreenBar.Exists(0) then if NOT FullScreenBar.isDocked then FullScreenBar.close + Kontext "DrawingObjectbar" + if DrawingObjectbar.Exists(0) then if NOT DrawingObjectbar.isDocked then DrawingObjectbar.close + Kontext "Hyperlinkleiste" + if Hyperlinkleiste.Exists(0) then if NOT Hyperlinkleiste.isDocked then Hyperlinkleiste.close + Kontext "InsertBar" + if InsertBar.Exists(0) then if NOT InsertBar.isDocked then InsertBar.close + Kontext "InsertObjectBar" + if InsertObjectBar.Exists(0) then if NOT InsertObjectBar.isDocked then InsertObjectBar.close + Kontext "MediaObjectBar" + if MediaObjectBar.Exists(0) then if NOT MediaObjectBar.isDocked then MediaObjectBar.close + Kontext "MoreControls" + if MoreControls.Exists(0) then if NOT MoreControls.isDocked then MoreControls.close + Kontext "OLEObjectbar" + if OLEObjectbar.Exists(0) then if NOT OLEObjectbar.isDocked then OLEObjectbar.close + Kontext "OptimizeTablebar" + if OptimizeTablebar.Exists(0) then if NOT OptimizeTablebar.isDocked then OptimizeTablebar.close + Kontext "PreviewObjectbar" + if PreviewObjectbar.Exists(0) then if NOT PreviewObjectbar.isDocked then PreviewObjectbar.close + Kontext "BezierObjectBar" + if BezierObjectBar.Exists(0) then if NOT BezierObjectBar.isDocked then BezierObjectBar.close + Kontext "GraphicObjectbar" + if GraphicObjectbar.Exists(0) then if NOT GraphicObjectbar.isDocked then GraphicObjectbar.close + Kontext "GraphicFilterBar" + if GraphicFilterBar.Exists(0) then if NOT GraphicFilterBar.isDocked then GraphicFilterBar.close + Kontext "StandardBar" + if StandardBar.Exists(0) then if NOT StandardBar.isDocked then StandardBar.close + Kontext "Viewerbar" + if Viewerbar.Exists(0) then if NOT Viewerbar.isDocked then Viewerbar.close + Kontext "TableObjectbar" + if TableObjectbar.Exists(0) then if NOT TableObjectbar.isDocked then TableObjectbar.close + Kontext "DrawTextObjectBar" + if DrawTextObjectBar.Exists(0) then if NOT DrawTextObjectBar.isDocked then DrawTextObjectBar.close + Kontext "Toolbar" + if Toolbar.Exists(0) then if NOT Toolbar.isDocked then Toolbar.close + Kontext "OL_SW_Rechenleiste" + if OL_SW_Rechenleiste.Exists(0) then if NOT OL_SW_Rechenleiste.isDocked then OL_SW_Rechenleiste.close + catch + printlog "tools3.inc::hCloseAllToolbars Can't close some toolbar" + endcatch + endif +end sub + + +function hIsAccessbridgeInstalled() as boolean + '/// created by HDE + '/// detects if a Java Access Bridge is installed which decreases testtool performance + '/// and should not be installed while running automated tests + '/// 1. searches in testtool.ini entry "UseAccessBridge" in profile "current". Is it <> True then + '/// 2. searches in directory "C:\Program Files\Java Access Bridge" a Java-Bridge Installation. If this is not found + '/// 3. searches in options of installed StarOffice on Java-Tabpage for the entry "with accessibility support" + '/// if 1. = true then false is returned, because it should be tested with accessibility + '/// if 2. or 3. matches this func returns true else false + '/// if Java is deactivated in Office options it returns false, because no Java->no AccessBridge + '/// if AccessbridgeIsInstalled = false (after checking on Java-Tabpage) and iSprache <> English a warning will be printed, because the string in options maybe has to be adapted! + + Dim i as integer, j as integer, sAccessibilityCompare as string + Dim sProgramFiles as string, sAccessBridgeFolder as string, sTmpEntry as string + Dim sCompareString as string, AccessbridgeIsInstalled as boolean + AccessbridgeIsInstalled = False + if GetIniValue ( gTesttoolIni, "UseAccessBridge", "Current" ) = True then + AccessbridgeIsInstalled = False + else + Select case gPlatgroup + Case "w95" + sProgramFiles = environ("ProgramFiles") + sAccessBridgeFolder = "Java Access Bridge" + sCompareString = sProgramFiles & "\" & sAccessBridgeFolder & "\AccessBridgeTester.class" + sAccessibilityCompare = "with accessibility support" + if hFileExists(sCompareString) = True then + AccessbridgeIsInstalled = True + else + ToolsOptions + Call hToolsOptions("STAROFFICE","JAVA") + Kontext "TabJava" + if UseJava.IsChecked = True then + For i = 1 to JavaList.GetItemCount() + JavaList.Select i + if JavaList.GetText(4) = sAccessibilityCompare then + AccessbridgeIsInstalled = True + exit for + endif + next i + if AccessbridgeIsInstalled = false then + Select Case iSprache + Case 01 : sAccessibilityCompare = "with accessibility support" + Case else : Warnlog "Accessibility check failed. Maybe language has to be adapted." + exit function + end select + endif + endif + Kontext "OptionenDlg" + OptionenDlg.Cancel + endif + end select + endif + + hIsAccessbridgeInstalled = AccessbridgeIsInstalled + +end function diff --git a/testautomation/global/tools/record_macro.bas b/testautomation/global/tools/record_macro.bas new file mode 100644 index 000000000000..a3a6d9107c46 --- /dev/null +++ b/testautomation/global/tools/record_macro.bas @@ -0,0 +1,60 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: record_macro.bas,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Records your actions in the Office at the cursorposition in the TestTool window +'* +'\************************************************************************************* + +sub main +' start with <F5>; wait until it got runned, +' open a new window in testtool, +' perform some actions in the office, +' take a look into the testtool window + + RecordMacro true + +' if you're done, comment the above line and uncomment the following line, +' run it <F5> and the macromodus is left + +' RecordMacro false + +end sub + +sub LoadIncludeFiles + use "global\system\includes\declare.inc" + use "global\system\includes\gvariabl.inc" + Call GetUseFiles() +end sub + diff --git a/testautomation/global/tools/resetoffice.bas b/testautomation/global/tools/resetoffice.bas new file mode 100755 index 000000000000..f9aba4805327 --- /dev/null +++ b/testautomation/global/tools/resetoffice.bas @@ -0,0 +1,184 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: resetoffice.bas,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Exit the [Star|Open][Office|Suite][.org] and delete user directory +'* +'\************************************************************************************* + +sub main + dim uno + dim ap + dim xViewRoot + dim apara(1) As new com.sun.star.beans.PropertyValue + dim temp() + dim i,x as integer + dim sString as string + dim fDeleteList(32000) as string + dim sLanguage as string + dim bError as boolean + dim sDefaultLocale as string + dim sDefaultLocaleCJK as string + dim sDefaultLocaleCTL as string + + sString = "qatesttool/global/tools/resetoffice.bas:: " + uno=hGetUnoService() + + 'Get UI language + try + ap=uno.createInstance("com.sun.star.configuration.ConfigurationProvider") + apara(0).Name="nodepath" + apara(0).Value="/org.openoffice.Office.Linguistic/General" + apara(1).Name="lazywrite" + apara(1).Value=False + xViewRoot=ap.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPara()) + sLanguage = xViewRoot.getPropertyValue("UILocale") + sDefaultLocale = xViewRoot.getPropertyValue("DefaultLocale") + sDefaultLocaleCJK = xViewRoot.getPropertyValue("DefaultLocale_CJK") + sDefaultLocaleCTL = xViewRoot.getPropertyValue("DefaultLocale_CTL") + printlog "Old UI language: '" + sLanguage + "'" + printlog "Old default locale: '" + sDefaultLocale + "'" + printlog "Old default locale CJK: '" + sDefaultLocaleCJK + "'" + printlog "Old default locale CTL: '" + sDefaultLocaleCTL + "'" + xViewRoot.dispose() + bError = FALSE + catch + warnlog sString + "Failed to read UI language." + bError = TRUE + endcatch + + if NOT bError then + 'Close OOo + try + ' To prevent restarting of OOo, the try/catch is around this and + ' to prevent messages about communication errors + printlog ResetApplication + FileExit "SynchronMode", TRUE + try + ' It is no error, if this fails - so it gets its own try/catch + kontext + if active.exists(5) then + active.no 'discard changes + endif + catch + endcatch + bError = FALSE + catch + warnlog sString + "Failed to close OOo." + bError = TRUE + endcatch + sleep 10 'To wait until OOo is realy away + endif + + 'Remove user directory + if NOT bError then + try + if (right(gOfficePath,1)=gPathSigne) then + 'Dir doesn't work, is a path singe is at the end + gOfficePath = left(gOfficePath,len(gOfficePath)-1) + endif + printlog "Going to delete directory: '" + gOfficePath + "'" + if (dir(gOfficePath) = "") then + qaErrorlog "Directory is already deleted." + else + rmDir (gOfficePath) + if (dir(gOfficePath) <> "") then + warnlog "Directory wasn't deleted." + endif + endif + bError = FALSE + catch + warnlog sString + "Failed to delete user directory." + bError = TRUE + endcatch + endif + + 'Start OOo and restore language + 'Needs only to be done, if UI language wasn't the default (!= "") + if ((sLanguage & sDefaultLocale & sDefaultLocaleCJK & sDefaultLocaleCTL) <> "") then + try + hStartTheOffice + uno=hGetUnoService() + ap=uno.createInstance("com.sun.star.configuration.ConfigurationProvider") + apara(0).Name="nodepath" + apara(0).Value="/org.openoffice.Office.Linguistic/General" + apara(1).Name="lazywrite" + apara(1).Value=False + xViewRoot=ap.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPara()) + if (sLanguage <> "") then + printlog "------------------------------ UI language: " + sLanguage + xViewRoot.setPropertyValue("UILocale", sLanguage) + xViewRoot.commitChanges() + endif + if (sDefaultLocale <> "") then + printlog "------------------------------ default locale: " + sDefaultLocale + xViewRoot.setPropertyValue("DefaultLocale", sDefaultLocale) + xViewRoot.commitChanges() + endif + if (sDefaultLocaleCJK <> "") then + printlog "------------------------------ default locale CJK: " + sDefaultLocaleCJK + xViewRoot.setPropertyValue("DefaultLocale_CJK", sDefaultLocaleCJK) + xViewRoot.commitChanges() + endif + if (sDefaultLocaleCTL <> "") then + printlog "------------------------------ default locale CTL: " + sDefaultLocaleCTL + xViewRoot.setPropertyValue("DefaultLocale_CTL", sDefaultLocaleCTL) + xViewRoot.commitChanges() + endif + if xViewRoot.hasPendingChanges() then + warnlog(sFileFunction+"Changes still pending...") + endif + xViewRoot.dispose() + exitRestartTheOffice + catch + warnlog sString + "Failed to set UI language." + endcatch + else + 'open OOo? + endif + 'Close OOo ? + + 'If it still loses the language information, we have to create a file with + 'the information of the language we want to test! + + 'Before this script is run you might need to kill the office! + 'Else you get problems with UNO access to OOo +end sub + +sub LoadIncludeFiles + use "global\system\includes\master.inc" + use "global\system\includes\gvariabl.inc" + Call GetUseFiles() +end sub + diff --git a/testautomation/global/tools/wintree.bas b/testautomation/global/tools/wintree.bas new file mode 100755 index 000000000000..305412319d00 --- /dev/null +++ b/testautomation/global/tools/wintree.bas @@ -0,0 +1,45 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +'* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +'* +'* Copyright 2008 by Sun Microsystems, Inc. +'* +'* OpenOffice.org - a multi-platform office productivity suite +'* +'* $RCSfile: wintree.bas,v $ +'* +'* $Revision: 1.1 $ +'* +'* last change: $Author: jsi $ $Date: 2008-06-13 10:27:06 $ +'* +'* 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. +'* +'/************************************************************************ +'* +'* owner : thorsten.bosbach@sun.com +'* +'* short description : Show the complete window hierarchy +'* +'\************************************************************************************* + +sub main +' Office has to be started before starting this! + setClipboard(WinTree) + Printlog (getClipboard) +end sub + |