diff options
Diffstat (limited to 'testautomation/global/tools/includes/required/t_tools2.inc')
| -rw-r--r-- | testautomation/global/tools/includes/required/t_tools2.inc | 1101 |
1 files changed, 1101 insertions, 0 deletions
diff --git a/testautomation/global/tools/includes/required/t_tools2.inc b/testautomation/global/tools/includes/required/t_tools2.inc new file mode 100644 index 000000000000..8ea2ed6315ee --- /dev/null +++ b/testautomation/global/tools/includes/required/t_tools2.inc @@ -0,0 +1,1101 @@ +'encoding UTF-8 Do not remove or change this line! +'************************************************************************** +' DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER. +' +' Copyright 2000, 2010 Oracle and/or its affiliates. +' +' OpenOffice.org - a multi-platform office productivity suite +' +' This file is part of OpenOffice.org. +' +' OpenOffice.org is free software: you can redistribute it and/or modify +' it under the terms of the GNU Lesser General Public License version 3 +' only, as published by the Free Software Foundation. +' +' OpenOffice.org is distributed in the hope that it will be useful, +' but WITHOUT ANY WARRANTY; without even the implied warranty of +' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +' GNU Lesser General Public License version 3 for more details +' (a copy is included in the LICENSE file that accompanied this code). +' +' You should have received a copy of the GNU Lesser General Public License +' version 3 along with OpenOffice.org. If not, see +' <http://www.openoffice.org/license.html> +' for a copy of the LGPLv3 License. +' +'/************************************************************************ +'* +'* owner : helge.delfs@sun.com +'* +'* short description : Global Tools II +'* +'\************************************************************************************* + +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" + Kontext "DocumentWriter" + DocumentWriter.UseMenu + case "HTML" + Kontext "DocumentWriterWeb" + DocumentWriterWeb.UseMenu + case "MASTERDOCUMENT" + Kontext "DocumentMasterDoc" + DocumentMasterDoc.UseMenu + case "CALC" + Kontext "DocumentCalc" + DocumentCalc.UseMenu + case "IMPRESS" + Kontext "DocumentImpress" + DocumentImpress.UseMenu + case "DRAW" + Kontext "DocumentDraw" + DocumentDraw.UseMenu + case "MATH" + 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" + Call hToolsOptions("WRITER","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 ) + endif + case "CALC" + Call hToolsOptions("CALC","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulator.Gettext , 3 ) + else + fSetMeasurementToCM = Right$( Tabulator.Gettext , 2 ) + endif + case "IMPRESS" + Call hToolsOptions("IMPRESS","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 2 ) + endif + case "DRAW" + Call hToolsOptions("DRAW","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 2 ) + endif + case "MASTERDOCUMENT" + Call hToolsOptions("WRITER","GENERAL") + Masseinheit.Select(2) + if iSprache = 81 then + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 ) + else + fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 ) + endif + case "HTML" + Call hToolsOptions("HTML","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("WRITER","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, "010101010101010", 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 ( lcase( gPlatform ) = "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 ( lcase( gPlatform ) = "osx" ) then + sPlatformProgramPath = "MacOS" + else + sPlatformProgramPath = "program" + end if + sfile = convertPath(gOfficeBasisPath & "program/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 & "/versionrc") + sTemp = getIniValue(sFile, "Version", "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 & "/version.ini") + sTemp = getIniValue(sFile, "Version", "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 + +'------------------------------------------------------------------------- + |