path: root/testautomation/global/tools/includes/required/t_tools2.inc

'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 &quot;BuildId&quot; 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

'-------------------------------------------------------------------------