update dev300-m58
[ooovba.git] / testautomation / global / tools / includes / required / t_tools2.inc
blob731bea120afc45b79567844bd73f883e19c49187
1 'encoding UTF-8  Do not remove or change this line!
2 '**************************************************************************
3 '* DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
4 '* 
5 '* Copyright 2008 by Sun Microsystems, Inc.
6 '*
7 '* OpenOffice.org - a multi-platform office productivity suite
8 '*
9 '* $RCSfile: t_tools2.inc,v $
11 '* $Revision: 1.1 $
13 '* last change: $Author: jsi $ $Date: 2008-06-13 10:27:11 $
15 '* This file is part of OpenOffice.org.
17 '* OpenOffice.org is free software: you can redistribute it and/or modify
18 '* it under the terms of the GNU Lesser General Public License version 3
19 '* only, as published by the Free Software Foundation.
21 '* OpenOffice.org is distributed in the hope that it will be useful,
22 '* but WITHOUT ANY WARRANTY; without even the implied warranty of
23 '* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
24 '* GNU Lesser General Public License version 3 for more details
25 '* (a copy is included in the LICENSE file that accompanied this code).
27 '* You should have received a copy of the GNU Lesser General Public License
28 '* version 3 along with OpenOffice.org.  If not, see
29 '* <http://www.openoffice.org/license.html>
30 '* for a copy of the LGPLv3 License.
32 '/************************************************************************
34 '* owner : helge.delfs@sun.com
36 '* short description : Global Tools II
38 '\*************************************************************************************
40 sub GetOLEDefaultNames
42  '/// Reads the names of all OLE objects from a reference file.
43 '///+ The OLE name-files are language dependent and should be created 
44 '///+ using the the <i>getnames.bas</i> script running on Windows
45 '///+ The files are (per this revision) written and read utf-8 encoded.
46 '///+ The OLE names are stored in global variables.
48     const CFN = "t_tools2::GetOLEDefaultNames():"
49   
50     dim sPath as string
51         sPath = gTesttoolPath & "global\input\olenames\" & gProductName
52       
53     dim sFile as String              ' the file that contains the OLE names
54         sFile = convertpath( sPath & "\ole_" & iSprache & ".txt" )
55       
56     dim sFilterList(20) as String    ' the list that temporarily holds the OLE names
57         sFilterlist( 0 ) = "0"
58       
59     printlog( CFN & "Using OLE names from: " & sFile )
61     ' Find the reference file. Warn if not found and exit
62     if ( Dir ( sFile ) = "" ) then
63    
64         Warnlog( CFN & " The file for default-filter-names is missing."
65         PrintLog( "Please create the list with ..\global\tools\getnames.bas::GetFilterNames!" )
66         exit sub
67       
68     end if
70     ' Read the file data into an array (sFilterList), utf-8 encoded
71     call ListRead ( sFilterList(), sFile, "utf8" )
73     ' Evaluate the array and assign the data to global variables.
74     gOLEWriter  = hGetValueForKeyAsString( sFilterList() , "WRITER"  )
75     gOLECalc    = hGetValueForKeyAsString( sFilterList() , "CALC"    )
76     gOLEImpress = hGetValueForKeyAsString( sFilterList() , "IMPRESS" )
77     gOLEDraw    = hGetValueForKeyAsString( sFilterList() , "DRAW"    )
78     gOLEMath    = hGetValueForKeyAsString( sFilterList() , "MATH"    )
79     gOLEChart   = hGetValueForKeyAsString( sFilterList() , "CHART"   )
80     gOLEOthers  = hGetValueForKeyAsString( sFilterList() , "OTHER"   )
82 end sub
84 '-------------------------------------------------------------------------
86 function hSetLocaleStrings (fLocale as String, TBOstringLocale() as String ) as Boolean
87 'TODO: JSI, make real description from it!
88 ' creator: TBO @ 25.10.2001
89 '/// function to set a string array with language dependant strings ///
90 '/// format of file (fLocale): ///
91 '///+ 1.line: entries/lines per language => x ///
92 '///+ 2.line: first language (A) number (iSprache) ///
93 '///+ 3.line: 1. string language A ///
94 '///+ 4.lin3: 2.language string  A ///
95 '///+ ... ///
96 '///+ (((x+1)*1) +2).line second language (B) number ///
97 '///+ (((x+1)*1) +2)+1.line:  1. string language B ///
98 '///+ ... ///
99 '///+ example file @ "input\\writer\\la_sp\\locale.txt" ///'
101 '/// the function parses the file until it finds the language (iSprache) or until EOF ///
102 '///+ on success the variable from th ecalling argument ///
103 '///+ gets set, ///
104    dim lLocale (15*20) as string ' list, where file gets loaded into
105    dim i,y,x as integer
106    dim bFoundLanguage as Boolean
107    hSetLocaleStrings = FALSE
108    lLocale(0)=0
109    fLocale = ConvertPath(fLocale)
110    if ListRead (lLocale (), fLocale, "UTF8" ) then
111 '      printlog "LOCALE: read file :-)"
113       bFoundLanguage = FALSE
114   ' check file format
115       if ( (ListCount(lLocale ()) -1) mod (val(lLocale (1))+1) ) <> 0 then
116          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 )
117       else
118       '                ( all lines in file  )          (trnsl words)
119          for i=0 to ( ( (ListCount(lLocale ())-1) / (val(lLocale (1))+1) )-1)
120            '    ( (val(lLocale (1))+1) *i+2)
121             x = ( (val(lLocale (1))  ) *i+2 +i) ' line number of entry language
122   ' print every language found:
123 '            printlog "position: "+i+" @ line: "+x+" Language: "+lLocale (x)
124   ' check if at suspected language number position is a number
125             if (val(lLocale (x)) > 0) then
126   ' set string variable if it is the right language
127                if (iSprache = val(lLocale (x))) then
128 '                  printlog "          ^ LOCALE: found needed language :-)"
129                   for y=1 to val(lLocale (1))
130                      TBOstringLocale(y) = lLocale (x+y)
131                      if (TBOstringLocale(y) = "") then
132                          qaErrorLog("missing string: " + y + ": '" + lLocale (2+y) + "'")
133                      endif
134                   next y
135                   bFoundLanguage = TRUE
136                endif
137             else
138                warnlog "LOCALE: this is no number :-( FileFormatError"
139             end if
140          next i
141          if (bFoundLanguage = FALSE) then
142             qaErrorLog "LOCALE: please add language to LOCALE file!: "+ iSprache
143          endif
144       endif
145    else
146       warnlog "LOCALE: file doesn't exist :-( : "+fLocale
147    endif
148    hSetLocaleStrings = bFoundLanguage
149 end function
151 '-------------------------------------------------------------------------
153 sub GetHTMLCharSet as String
154 '///function to get the Character Set for HTML export
155 '///+(tools/options/load&save/HTML compatibility -> Character Set)
156    ToolsOptions
157    hToolsOptions ( "LoadSave", "HTMLCompatibility" )
158    GetHTMLCharSet = Zeichensatz.GetSelText
159    Kontext "ExtrasOptionenDlg"
160    ExtrasOptionenDlg.OK
161 end sub
163 '-------------------------------------------------------------------------
165 sub SetHTMLCharSet ( CharSet as String )
166 '///routine to set the Character Set for HTML export
167 '///+( tools/options/load&save/HTML compatibility -> Character Set )
168    ToolsOptions
169    hToolsOptions ( "LoadSave", "HTMLCompatibility" )
170    Zeichensatz.Select CharSet
171    Kontext "ExtrasOptionenDlg"
172    ExtrasOptionenDlg.OK
173 end sub
175 '-------------------------------------------------------------------------
177 sub SetHTMLCharSetToUTF8 as Boolean
178 '///function to set the Character Set for HTML export to 'Unicode UTF8'
179 '///+( tools/options/load&save/HTML compatibility -> Character Set )
180   Dim i as Integer
181   Dim sDum as String
183    ToolsOptions
184    hToolsOptions ( "LoadSave", "HTMLCompatibility" )
186    for i=1 to Zeichensatz.GetItemCount
187       sDum = Zeichensatz.GetItemText (i)
188       if Instr ( lcase (sDum), "utf-8" ) <> 0 then
189          Zeichensatz.Select (i)
190          i=1000
191       else
192          if Instr ( lcase (sDum), "utf8" ) <> 0 then
193             Zeichensatz.Select (i)
194             i=1000
195          else
196             if Instr ( lcase (sDum), "utf 8" ) <> 0 then
197                Zeichensatz.Select (i)
198                i=1000
199             end if
200          end if
201       end if
202    next i
203    if i<1000 then
204       SetHTMLCharSetToUTF8 = FALSE
205    else
206       SetHTMLCharSetToUTF8 = TRUE
207    end if
208    Kontext "ExtrasOptionenDlg"
209     ExtrasOptionenDlg.OK
210 end sub
212 '-------------------------------------------------------------------------
214 function dec(Ref as integer)
215 '/// decrement variable, call it like 'dec variable' ///'
216 ' reference or value .-) an excursion :-))
217 ' to give this func a var as ref: call without ANY brackets => 'dec Variable'
218 ' opposite of this to call it via value ! WE DON'T WANT THIS !
219 ' (would be 'dec (Variable)' or in declaration 'function dec (ByVal x)')
220    Ref = Ref - 1
221 end function
223 '-------------------------------------------------------------------------
225 function inc(Ref as integer)
226 '/// increment variable, call it like 'dec variable' ///'
227    Ref = Ref + 1
228 end function
230 '-------------------------------------------------------------------------
232 function ActivateAutoPilot ( sWhichOne as String ) as Boolean
233 'Author: TZ
234 '///Routine to activate (WebPage Autopilot, Form Autopilot, Documentconverter and Euroconveter)
235 '///Open via menu items (not via SlotID or Macro URL)
236 '///<u>input</u>: Which Autopilot (<i>webpage</i>, <i>form</i>, <i>documentconverter</i>, <i>euroconverter</i>,<i>addressdatasource</i>)
237 '///<u>output</u>:<ul><li>TRUE: Autopilot is open</li><li>FALSE: Autopilot can not be opened</li></ul>
238   Dim bIsLoaded as boolean, LoadTime as integer, PrintTime as Integer
240    bIsLoaded = FALSE
241    LoadTime = 0
243    select case gApplication
244       case "WRITER"
245                        Kontext "DocumentWriter"
246                        DocumentWriter.UseMenu
247       case "HTML"
248                        Kontext "DocumentWriterWeb"
249                        DocumentWriterWeb.UseMenu
250       case "MASTERDOCUMENT"
251                        Kontext "DocumentMasterDoc"
252                        DocumentMasterDoc.UseMenu
253       case "CALC"
254                        Kontext "DocumentCalc"
255                        DocumentCalc.UseMenu
256       case "IMPRESS"
257                        Kontext "DocumentImpress"
258                        DocumentImpress.UseMenu
259       case "DRAW"
260                        Kontext "DocumentDraw"
261                        DocumentDraw.UseMenu
262       case "MATH"
263                        Kontext "DocumentMath"
264                        DocumentMath.UseMenu
265       case else
266                        Kontext "DocumentWriter"
267                        DocumentWriter.UseMenu
268    end select
269    sleep(2)
270    hMenuSelectNr(1)
271    sleep(2)
272    hMenuSelectNr(4)
273    sleep(2)
275    select case lcase (sWhichOne)
276       case "webpage"            : hMenuSelectNr(5)
277       case "documentconverter"  : hMenuSelectNr(6)
278       case "euroconverter"      : hMenuSelectNr(7)
279       case "addressdatasource"  : hMenuSelectNr(8)
280    end select
281    sleep(5)
283    while bIsLoaded = False
284       while LoadTime < 20
285          PrintTime = LoadTime * 3
286          select case lcase ( sWhichOne )
287             case "webpage"            : Kontext "AutopilotWebPage"
288                                         if AutopilotWebPage.Exists(1) then
289                                            bIsLoaded = true
290                                            printlog "Autopilot is loaded in " + PrintTime + " seconds!"
291                                            LoadTime = 20
292                                            ActivateAutoPilot = TRUE
293                                         end if
294             case "report"             : Kontext "AutoPilotReport"
295                                         if AutoPilotReport.Exists(1) then
296                                            bIsLoaded = true
297                                            printlog "Autopilot is loaded in " + PrintTime + " seconds!"
298                                            LoadTime = 20
299                                            ActivateAutoPilot = TRUE
300                                         end if
301             case "form"               : Kontext "ChooseDatabase"
302                                         if ChooseDatabase.Exists(1) then
303                                            bIsLoaded = true
304                                            printlog "Autopilot is loaded in " + PrintTime  + " seconds!"
305                                            LoadTime = 20
306                                            ActivateAutoPilot = TRUE
307                                         end if
308             case "documentconverter"  : Kontext "DocumentConverter"
309                                         if DocumentConverter.Exists(1) then
310                                            bIsLoaded = true
311                                            printlog "Autopilot is loaded in " + PrintTime + " seconds!"
312                                            LoadTime = 20
313                                            ActivateAutoPilot = TRUE
314                                         end if
315             case "euroconverter"      : Kontext "AutoPilotEuroKonverter"
316                                         if AutoPilotEuroKonverter.Exists(1) then
317                                            bIsLoaded = true
318                                            printlog "Autopilot is loaded in " + PrintTime + " seconds!"
319                                            LoadTime = 20
320                                            ActivateAutoPilot = TRUE
321                                         end if
322             case "addressdatasource"  : Kontext "AddressSourceAutopilot"
323                                         if AddressSourceAutopilot.Exists(1) then
324                                            bIsLoaded = true
325                                            printlog "Autopilot is loaded in " + PrintTime + " seconds!"
326                                            LoadTime = 20
327                                            ActivateAutoPilot = TRUE
328                                         end if
330          end select
331          'NOTE: Maybe a messagebox occurs.
332          Kontext "Active"
333          if Active.Exists (1) then
334             warnlog Active.GetText
335             try
336                Active.OK
337             catch
338                Active.Cancel
339             endcatch
340             ActivateAutoPilot = FALSE
341          end if
342          sleep(1)
343          LoadTime = LoadTime + 1
344          if LoadTime = 20 and bIsLoaded = False then
345             warnlog "Autopilot has not been loaded!"
346             ActivateAutoPilot = FALSE
347             bIsLoaded = TRUE
348          end if
349       wend
350    wend
351 end function
353 '-------------------------------------------------------------------------
355 function SetURL ( sURL as String )
356 'Author: TZ
357 '/// Routine to open a special URL with <i>file open</i>-dialog
358 '/// <u>input</u>: The URL as string
359   FileOpen
360   Kontext "OeffnenDlg"
361    Dateiname.SetText sURL
362    Oeffnen.Click
363    wait 500
364 end function
366 '-------------------------------------------------------------------------
368 function fGetFileText (sFilename as string, iCount as long) as string
369 '/// This function is for getting  the first or last n characters of a file
370 '///+<u>Input</u>:<ul><li>filename</li><li>number</li></ul>If the number greater 0 then get n characters from start.
371 '///+A number smaller 0 get from end of file.
372 '///+<u>Output</u>:<ul><li>string with <b><i>n</i></b> characters</li></ul>
374    dim iFile as integer ' filehandle
375    dim iTem as integer  ' get 2 bytes of the file
376    dim iTemByte(2) as integer ' move 1 byte from iTem in each item
377    dim sTemp as string   ' string of file
378    dim iSize as long  ' size in bytes of file
379    dim i as long      ' runner :-)
381    iFile = FreeFile
382 '   Printlog "FreeFile: " + iFile
383    if (dir (sFilename) <> "") then
384 '      Printlog "FileLen: " + FileLen(sFile)
385       Open sFilename For binary access read shared As #iFile
386 '      Printlog "Loc: " + Loc(#iFile)  ' LONG! where am i in the file?
388       iSize = Lof(#iFile) ' get size in bytes of file
389       if (iSize > 65530) then '65536 = 64kB
390          'Warnlog "fGetFileText: file '" + sFilename + "' might get problems on reading it? size is > 65530 Byte: '" + iSize + "'"
391       else
392 '         printlog "iSize: " + iSize
393       endif
395       sTemp = ""
396       if (iCount >= 0) then   ' get bytes from file start
397          get iFile,1,sTemp    ' get max 64kByte; but not the 1st 2 bytes :-(
398          get iFile,1,iTem     ' get the first 2 bytes of the file
399          iTemByte(2) = (iTem AND &H0000FF00) \ &H100   ' and seperate the bytes
400          iTemByte(1) = (iTem AND &H000000FF)
401          sTemp = chr(iTemByte(1)) + chr(iTemByte(2)) + sTemp  ' put them together
402        else     ' get bytes from file end
403          if ((iSize+iCount) > 0) then
404                select case (iSize+iCount)
405                   case 1: get iFile,1,sTemp ' take bytes from the end of the file
406                           get iFile,1,iTem     ' get the first 2 bytes of the file
407                           sTemp = chr(iTemByte(2)) + sTemp  ' put them together
408                   case else: get iFile,(iSize+iCount)-1,sTemp ' take bytes from the end of the file
409                end select
410          else
411             get iFile,1,sTemp ' take bytes from the end of the file
412             get iFile,1,iTem     ' get the first 2 bytes of the file
413             iTemByte(2) = (iTem AND &H0000FF00) \ &H100   ' and seperate the bytes
414             iTemByte(1) = (iTem AND &H000000FF)
415             sTemp = chr(iTemByte(1)) + chr(iTemByte(2)) + sTemp  ' put them together
416          endif
417        endif
418 '      printlog "'"+left(sTemp,iSize)+"'"  ' gotcha!
420       if (iSize-(Abs(iCount)) >= 0) then
421          fGetFileText = left(sTemp,Abs(iCount))
422       else
423          'Warnlog "fGetFileText: file '" + sFilename + "' isn't as big as expected; will only return '" + iSize+ "' bytes fom: " + iCount
424          fGetFileText = left(sTemp,iSize)
425       endif
427    ' debugging routine --------------------------------------
428    '   iSize = Lof(#iFile)
429    '   printlog "iSize: " + iSize
430    '   sTemp = ""
431    '   if iSize > 0 then
432    '      printlog "iSize \ 2: " + (iSize \ 2)
433    '      for i = 0 to ((iSize \ 2)-1)
434    '         get iFile,(i*2)+1,iTem
435    '         Printlog "i: " + i + ": 0x" + hex(iTem)
436    '       iTemByte(2) = (iTem AND &H0000FF00) \ &H100
437    '       iTemByte(1) = (iTem AND &H000000FF)
438    '         sTemp = sTemp + chr(iTemByte(1)) + chr(iTemByte(2))
439    '      next i
440    '      if (iSize MOD 2) = 1 then
441    '         get iFile,iSize,iTem
442    '         Printlog "i: " + iSize + ": 0x" + hex(iTem)
443    '       iTemByte(1) = (iTem AND &H000000FF)
444    '         sTemp = sTemp + chr(iTemByte(1))
445    '      endif
446    '   endif
447    '   printlog "'"+sTemp+"'"
448    ' debugging routine --------------------------------------
449       Close #iFile
450    else  ' does file exist
451       Warnlog "fGetFileText: file '" + sFilename + "' doesn't exist"
452       fGetFileText = ""
453    endif
454 end function
456 '-------------------------------------------------------------------------
458 function fSetMeasurementToCM() as string
459 '/// Sets the measurement unit to centimeter (cm) and returns the unit.
460     Dim i as integer
461     
462     Call hNewDocument
463     ToolsOptions
464         select case UCase(gApplication)
465             case "WRITER"
466             Call hToolsOptions("WRITER","GENERAL")
467                                                 Masseinheit.Select(2)
468                                                 if iSprache = 81 then
469                                                     fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 )        
470                                                 else
471                                                     fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 )        
472                                                 endif            
473             case "CALC"
474             Call hToolsOptions("CALC","GENERAL")
475                                                 Masseinheit.Select(2)
476                                                 if iSprache = 81 then
477                                                     fSetMeasurementToCM = Right$( Tabulator.Gettext , 3 )        
478                                                 else
479                                                     fSetMeasurementToCM = Right$( Tabulator.Gettext , 2 )        
480                                                 endif
481             case "IMPRESS"
482             Call hToolsOptions("IMPRESS","GENERAL")
483                                                 Masseinheit.Select(2)
484                                                 if iSprache = 81 then
485                                                     fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 3 )        
486                                                 else
487                                                     fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 2 )        
488                                                 endif            
489             case "DRAW"
490             Call hToolsOptions("DRAW","GENERAL")
491                                                 Masseinheit.Select(2)
492                                                 if iSprache = 81 then
493                                                     fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 3 )        
494                                                 else
495                                                     fSetMeasurementToCM = Right$( Tabulatorabstand.Gettext, 2 )        
496                                                 endif                        
497             case "MASTERDOCUMENT"
498             Call hToolsOptions("WRITER","GENERAL")
499                                                 Masseinheit.Select(2)
500                                                 if iSprache = 81 then
501                                                     fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 )        
502                                                 else
503                                                     fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 )        
504                                                 endif                        
505             case "HTML"
506             Call hToolsOptions("HTML","VIEW")
507                                                 Masseinheit.Select(2)
508                                                 'in Writer/Web also the Writer has to be set to cm 
509                                                 'because .sdw, .sxw etc. export to HTML depends on it.
510                                                 Call hToolsOptions("WRITER","GENERAL")
511                                                 Masseinheit.Select(2)
512                                                 if iSprache = 81 then
513                                                     fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 3 )        
514                                                 else
515                                                     fSetMeasurementToCM = Right$( Tabulatorenabstand.Gettext, 2 )        
516                                                 endif            
517             case else                         : warnlog swhereIsThisFunction & "For this module ("& gApplication &") no decimal seperator setting exists."
518         end select                   
519     printlog "Info: Measurement unit has been set to centimeters."
520     Kontext "ExtrasOptionenDlg"
521     ExtrasOptionenDlg.OK
522     Call hCloseDocument
523 end function
525 '-------------------------------------------------------------------------
527 function fRemoveDoubleCharacter(stringToChange as string, sCharacter as string) As String   
528 '/// Removes every Character' after a 'Character' in a given string.   
529    Dim lLength, n As Long
530    Dim sNextLetter As String
531    Dim sLastLetter As String
532    Dim sFinalString As String
533    Dim sTxt, sChar As String
535     'store all arguments in
536    sTxt = stringToChange
537    lLength = Len(sTxt)
538    sLastLetter = left(sTxt, 1)
539    sFinalString = sLastLetter
541    For n = 2 To lLength Step 1
542       sNextLetter = Mid(sTxt, n, 1)
543       If (sCharacter+sCharacter <> sLastLetter + sNextLetter) Then
544          sFinalString = sFinalString + sNextLetter
545       End If
546       sLastLetter = sNextLetter
547    Next n
548    fRemoveDoubleCharacter = sFinalString
549 End Function
551 '-------------------------------------------------------------------------
553 function fRemoveDoubleSpace(stringToChange as string) As String
554     fRemoveDoubleSpace = fRemoveDoubleCharacter(stringToChange, " ")
555 End Function
557 '-------------------------------------------------------------------------
559 function writeCrashRepFile()
560 '/// Creates a file <i>(gOfficePath)</i>/user/work/crashrep.txt with two lines:
561 '///+ <ol><li>name of .bas file</li>
562 '///+ <li>name of testcase</li></ol>  
563     Dim sFile as string
564     Dim sContent(5) as string
565     
566     sFile = ConvertPath (gOfficePath + "user\work\crashrep.txt")
567     listAppend(sContent(), gTestName) ' get's set in hStatusIn()
568     listAppend(sContent(), getTestcaseName)
569     listWrite(sContent(), sFile)
570 end function
572 '-------------------------------------------------------------------------
574 function GetBuildNumHidLst as String
575 '/// Get the &quot;BuildId&quot; out of the <i>hid.lst</i>.
576   Dim FileNum as Integer
577   Dim xmlZeile as String
578   dim iIndex as integer
579   dim sTemp as string
581    if Dir (gtHidLstPath + "hid.lst") <> "" then
582       FileNum = FreeFile
583       Open (gtHidLstPath + "hid.lst") For Input As #FileNum
584       do until EOF(#FileNum) = True
585          line input #FileNum, xmlZeile
586          iIndex = inStr (1, xmlZeile, "010101010101010", 1)
587          sTemp = Left (xmlZeile, abs(iIndex - 1))
588          ' usually only the first line is read
589          if (sTemp <> "") then exit do
590       loop
591       Close #FileNum
592       GetBuildNumHidLst = sTemp
593     else
594       GetBuildNumHidLst = ""
595    end if
596 end function
598 '-------------------------------------------------------------------------
600 function hGetUNOService(optional bSilent as boolean, optional byRef sUnoPortExternal as string) as object
601 '/// Function enables the UNO communication inside the
602 '///+ TestTool to the office application.
603 '/// INPUT: optional <i>bSilent</i> to suppress informal messages, but no warnings
604 '/// INPUT: optional <i>sUnoPortExternal</i> to just get the UNO port number passed to that variable
605     Dim sResultUno as string
606     Dim sUnoPort as string
607     Dim sOfficeParameters as string
608     Dim sUnoOffice as string
609     Dim bJustGettingPort as boolean
610     Dim sTTPort as string
611     
612     ' To not to change the old behaviour, set variable if parameter is not given
613     if (isMissing(bSilent)) then
614         bSilent = FALSE
615     end if
617     ' master.inc::sStartUpOffice needs just the Port Numberr from UNO, to pass it to first start up
618     if (isMissing(sUnoPortExternal)) then
619         bJustGettingPort = FALSE
620     else
621         bJustGettingPort = TRUE
622         sUnoPortExternal = "" ' clear it 
623     end if
624      
625     'To enable spaces and special chars in path;
626     'This doesn't work for the TestTool command 'start'
627     'But for the 'shell' command it is ok.
628     sUnoOffice = convertToURL(sAppExe)
629   
630     '/// Get the TestTool port value from the TestTool control file  
631     sTTPort = GetIniValue (gTesttoolIni, "Communication", "TTPort")
632     '/// Get the UNO port value from the TestTool control file  
633     sResultUno = GetIniValue (gTesttoolIni, "Communication", "UnoPort")
634     ' make sure both ports are different
635     if sTTPort = sResultUno then
636         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."
637         exit function
638     end if
639     if NOT bSilent then
640         printlog "Trying to use Office/Testtool UNO Port '" + sResultUno + "'."
641     endif
642     if (sResultUno <> "") then
643         sUnoPort = sResultUno
644     else
645         warnlog ("Please add an entry to your '" + gTesttoolIni + "' in section 'Communication': 'UnoPort=82352' and restart your testtool and exit OpenOffice.org.")
646         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.")
647         exit function
648     end if
649     if (NOT bJustGettingPort) then
650         '/// <i>-accept=socket,host=localhost,port=(PortNr);urp</i> has to be added to the start command. 
651         sOfficeParameters = "-accept=socket,host=localhost,port=" + sUnoPort + ";urp"
652         try
653             '/// If this service has been used before the connection will be established.
654             hGetUNOService = getUnoApp
655             if NOT bSilent then
656                 printlog "Office/Testtool UNO: CONNECTION SUCCESSFULL"
657             end if
658             ' If this tree will be used the connection has been established before!
659         catch        
660             ' If the connection has not been established before this tree will be used.
661             '/// If the UNO service has not been used before the application will be <i>started</i> with the additional parameters.
662             qaerrorLog "/qa/qatesttool/global/tools/inc/t_tools2.inc::hGetUNOService 'getUnoApp' needn't fail anymore!"
663             Shell (sUnoOffice, 1,sOfficeParameters,false)
664             if NOT bSilent then
665                 printlog "Office/Testtool UNO: TRYING TO CONNECT"
666             end if
667             sleep(10)
668         endcatch
669         
670         '/// This will be tried twice.
671         ' Second chance
672         if isNull(hGetUNOService) then
673             try
674                 hGetUNOService = GetUnoApp
675                 if NOT bSilent then
676                     printlog "Office/Testtool UNO: CONNECTION SUCCESSFULL"
677                 endif
678             catch
679                 '/// If the UNO service could not be started a warnlog will be written to the result file. 
680                 warnlog "Office/Testtool UNO: CONNECTION FAILED"
681             endcatch
682         end if
683     else
684         sUnoPortExternal = sUnoPort
685     end if
686 end function
688 '-------------------------------------------------------------------------
690 function fopenConfig( sPackage   as String  ,_
691                      sPath      as String  ,_
692                      bReadWrite as Boolean ,_
693                      bAllLocale as Boolean ) as Object
694 '/// Open a configuration package from the Office installation via UNO API.
695 '/// <ul><b>Input</b> 
696 '///+ <li>Parameter: <i>sPackage</i>
697 '///+ describe the package which should be handled by the returned
698 '///+ configuration access object
699 '///+ <u>Example</u>: "/org.openoffice.Office.TypeDetection"</li>
700 '///+ <li>Parameter: <i>sPath</i>
701 '///+ Specify the relativ path inside the new opened package,
702 '///+ where we are interested on
703 '///+ <u>Example</u>: "Types/xxx" => "/org.openoffice.Office.TypeDetection/Types/xxx"</li>
704 '///+ <li>Parameter: <i>bReadWrite</i>
705 '///+ Describe how the package should be opened (readonly/writable)</li>
706 '///+ <li>Parameter: <i>bAsLocale</i>
707 '///+ Enable/disable the special ALL LOCALE mode of the configuration API.
708 '///+ It makes it possible to have access on localized nodes directly instead
709 '///+ of using the generic handling of used API for it.</li></ul>
710 '///+ <b>Return</b>: <i>Object</i>
711 '///+ Object provides access to the required package or directly to a config key.
712     Dim sFullPath as String
713     Dim aConfig as Object
714     Dim aConfigProvider as Object
715     Dim lNormalParams(0) as new com.sun.star.beans.PropertyValue
716     Dim lLocaleParams(1) as new com.sun.star.beans.PropertyValue
717     Dim lParams() as Object
718     Dim oUno as Object
720     sFullPath = sPackage+"/"+sPath
722     if (bAllLocale=true) then
723         lLocaleParams(0).Name  = "nodepath"
724         lLocaleParams(0).Value = sFullPath
725         lLocaleParams(1).Name  = "locale"
726         lLocaleParams(1).Value = "*"
727         lParams() = lLocaleParams()
728     else
729         lNormalParams(0).Name  = "nodepath"
730         lNormalParams(0).Value = sFullPath
731         lParams() = lNormalParams()
732     end if
734     oUno = hGetUnoService
735     
736     aConfigProvider = oUno.createInstance("com.sun.star.configuration.ConfigurationProvider")
738     if (bReadWrite=true) then
739         aConfig = aConfigProvider.createInstanceWithArguments( _
740             "com.sun.star.configuration.ConfigurationUpdateAccess", _
741             lParams() )
742     else
743         aConfig = aConfigProvider.createInstanceWithArguments( _
744             "com.sun.star.configuration.ConfigurationAccess", _
745             lParams() )
746     end if
748     fopenConfig = aConfig
749 end function
751 '-------------------------------------------------------------------------
753 function fGetProductName as string
754 '/// Reads the ProductKey from bootstrap/version file and cuts of version number,
755     Dim sProduct as string
756     Dim sSplit() as string
757     Dim i as integer
758     Dim u as integer
759     Dim sFile as string
760     Dim sIniEntry as string
761     Dim cFileExt as string
762        
763     'Using the bootstraprc/bootstrap.ini file in ../program dir
764     'to get the value of 'ProductKey'
765     
766     if gPlatform = lcase("osx") then
767         sfile = convertPath(gNetzOfficePath + "MacOS/bootstrap")
768     else
769         sfile = convertPath(gNetzOfficePath + "program/bootstrap")
770     end if
771     
772     sIniEntry = "Bootstrap"
773     
774     'Setting the differnt extension to the files.
775     if gPlatGroup = "unx" then
776         cFileExt = "rc"
777     else
778         cFileExt = ".ini"
779     end if
781     'Getting the value of 'ProductKey'-entry or setting it to 'OpenOffice.org 2.0'
782     if (dir(sFile+cFileExt) <> "") then
783         sProduct = getIniValue(sFile+cFileExt, sIniEntry , "ProductKey")
784     else
785         warnlog "Could not get the ProductKey value! Setting it to 'OpenOffice.org 2.0' and trying to run the tests!"
786         sProduct = "OpenOffice.org 2.0"
787     end if
788     if (sProduct <> "" AND sProduct <> "NOT EXISTING") then
789         sSplit = split(sProduct, " ") ' get count of spaces
790         sProduct = ""
791         'Presupposition: Version number is not seperated by spaces, 
792         'but seperated with space from ProductName
793         u = uBound(sSplit)
794         if (u > 0) then
795             for i = 0 to (u-1)
796                 sProduct = sProduct + sSplit(i)        ' add strings until last Space
797                 if (i <> (u-1)) then 
798                     sProduct = sProduct + " "
799                 end if
800             next i
801         else
802             sProduct = sSplit(0)
803         end if
804     end if
805     fGetProductName = sProduct 
806 end function
808 '-------------------------------------------------------------------------
810 function FindBuildID as String
811 '/// Get BuildID out of <i>bootstrap.ini/boostraprc</i>
812 '///+or search in <i>.../program/resource/isoxxx??.res</i> for the BuildID.
813   Dim sOfficePath as String
814   Dim FileNum, iStart, i as Integer
815   Dim xmlZeile, sZ1, sZ2, sIsofile as String
816   Dim sTemp as String
817   Dim sFile as string
818   Dim sPlatformProgramPath as string
819     
820   if (gNetzInst = TRUE) then
821      sOfficePath = gNetzOfficePath
822    else
823      sOfficePath = gOfficePath
824   end if
826    ' bootstrap.ini/rc part
827    if (gSamePC = TRUE) then
828         ' since CWS nativefixer18 the information from bootstrap file is spread across bootstrap and version
829         if gPlatform = lcase("osx") then
830             sPlatformProgramPath = "MacOS"
831         else
832             sPlatformProgramPath = "program"
833         end if        
834         sfile = convertPath(gOfficeBasisPath & "program/version")
835         if gPlatGroup = "unx" then
836             sFile = sFile + "rc"
837             if (dir(sFile) <> "") then
838                 sTemp = getIniValue(sFile, "Version", "buildid")
839                 gMajor = getIniValue(sFile, "Version", "ProductSource")
840             else
841                 sfile = convertPath(gNetzOfficePath & sPlatformProgramPath & "/versionrc")
842                 sTemp = getIniValue(sFile, "Version", "buildid")
843             end if
844         else
845             sFile = sFile + ".ini"
846             if (dir(sFile) <> "") then
847                 sTemp = getIniValue(sFile, "Version", "buildid")
848                 gMajor = getIniValue(sFile, "Version", "ProductSource")
849             else
850                 sfile = convertPath(gNetzOfficePath & sPlatformProgramPath & "/version.ini")
851                 sTemp = getIniValue(sFile, "Version", "buildid")
852             end if
853         end if
854    end if
855    
856    ' fallback to get the buildID via isoxxx??.res part
857    if (sTemp = "") then
858       sIsofile = Dir (sOfficePath & sPlatformProgramPath & gPathSigne & "resource" & gPathSigne & "iso*.res")
859       if sIsofile = "" then
860          sIsofile = App.Dir (sOfficePath & sPlatformProgramPath & gPathSigne & "resource" & gPathSigne & "iso*.res")
861       end if
862       sIsofile = ConvertPath (sOfficePath & sPlatformProgramPath & gPathSigne & "resource" & gPathSigne & sIsofile)
863       if sIsofile= "" then
864          warnlog "FindBuildID : No isoxxx??.res-file was found!"
865          exit function
866       end if
868       FileNum = FreeFile
869       Open sIsofile For Input As #FileNum
870       do until EOF(#FileNum) = True
871          line input #FileNum, xmlZeile
872          for i=1 to 100
873              if i=1 then
874                 sZ1 = left (xmlzeile, 2048)
875              else
876                 sZ1 = left (sZ2, 2048)
877              end if
878              if sZ1 < 2048 then
879                 i=101
880              else
881                 iStart = instr (1, sZ1, "Build", 1)
882                 if iStart <> 0 then
883                    iStart = iStart-5
884                    sTemp = Mid (sZ1, iStart, 16)
885                    exit do
886                 end if
887                 sZ2 = right (sZ1, len (sZ1)-2048)
888             end if
889          next i
890       loop
891       Close #FileNum
892    end if
894    ' WorkAround version information starting with 'SRC' or any other letter code as announced
895    iStart = len(sTemp)
896    i = 1
897    ' take the first character
898    sZ1 = mid(sTemp,i,1)
899    ' if there is more than one character in the string AND the first character is not a number
900    if ((iStart > 0) AND (NOT isNumeric(sZ1))) then
901        ' increment counter as long as there is no number found in the string
902        while ((i < iStart) AND (NOT isNumeric(mid(sTemp,i,1)) ))
903            inc(i)
904        wend
905        ' cut of the not number characters at the start of the string
906        sTemp = right(sTemp, len(sTemp)-(i-1))
907    end if
908    
909    FindBuildID = sTemp
910 end function
912 '-------------------------------------------------------------------------
914 sub hSetBuildVersionInformation(bQuite as boolean)
915 '/// set global version information variables: gMajor, gMinor, gBuild ///'
916 '/// presupposition: global variable gVersionsnummer is initialised by FindBuildID() ///'
917     dim slVersion() as string
918     dim ilVersion as integer
919     dim sLastVersion as string
920     dim iPosA as integer
921     dim iPosB as integer
923     slVersion() = Split(gVersionsnummer, ",") 
924     ilVersion = uBound(slVersion()) ' array counts from 0 on!
925     sLastVersion = slVersion(ilVersion)
926     ' major is from start to 'm'
927     iPosA = 1
928     iPosB = instr(sLastVersion, "m")
929     if (iPosB = 0) then ' there is no minor
930         if (Not bQuite) then
931             warnlog "Product Version Information is missing (mXX). Please tell the developer to build with 'setsolar -ver'"
932         endif
933         iPosB = instr(sLastVersion, "(")
934     endif
935     if gMajor = "" then
936         gMajor  = Mid(sLastVersion, iPosA, (iPosB-iPosA))  '(1) Major
937     endif
938     iPosA = iPosB
939     iPosB = instr(sLastVersion, "(")
940     gMinor  = Mid(sLastVersion, iPosA, iPosB-iPosA)        '(2) Minor
941     iPosA = instr(sLastVersion, ":") + 1
942     iPosB = instr(sLastVersion, ")")
943     gBuild = cInt(Mid(sLastVersion, iPosA, iPosB-iPosA))   '(3) Build
944 end sub
946 '-------------------------------------------------------------------------
948 function fRelativeToAbsolutePath (sRelativePath as string) as string
949 '/// INPUT: provide a path with relative indicators ".." ///'
950 '///+ The input needs to konsist of the parts: where was the relative string found, and ///'
951 '///+ the relative path itself as one string. E.g: "/opt/var/../../here/is/it"///'
952 '/// RETURN: String with the removed parts for each relative iteration. E.g. This returns: "/here/is/it"///'
954     dim iHowOften as string
955     dim aSplitOnDoublePoints() as string
956     dim aSplitOnPathSign() as string
957     dim aJoinWithPathSign() as string
958     dim i,x,y as integer
959     dim sIntern as string
961     ' save the input
962     sIntern = sRelativePath
963     ' get count of 'relative path ups'
964     aSplitOnDoublePoints = split(sIntern, gPathSigne+"..")
965     ' for every occurence cut part from path
966     iHowOften = uBound(aSplitOnDoublePoints)-1
967     for i = 0 to iHowOften
968         ' Split on every "/.."
969         aSplitOnDoublePoints = split(sIntern, gPathSigne+"..")
970         ' always work on the first part (The one before the first "/..")
971         ' Split the first path at the PathSeperators
972         aSplitOnPathSign = split(aSplitOnDoublePoints(0), gPathSigne)
973         ' define new size for the first part destination
974         redim aJoinWithPathSign(uBound(aSplitOnPathSign())-1)
975         ' copy the parts, but not the last part
976         for x = 0 to uBound(aJoinWithPathSign())
977             aJoinWithPathSign(x) = aSplitOnPathSign(x)
978         next x
979         ' make one string of the parts with PathSeperators
980         aSplitOnDoublePoints(0) = join(aJoinWithPathSign(), gPathSigne)
981         ' cut the .. for this run from the string
982         redim aJoinWithPathSign(uBound(aSplitOnDoublePoints())-1)
983         y=0
984         for x = 0 to uBound(aJoinWithPathSign())+1
985             if x <> 1 then
986                 aJoinWithPathSign(x-y) = aSplitOnDoublePoints(x)
987             else
988                 y=1
989             endif
990         next x
991         ' set put all parts together again into one string
992         if iHowOften <> i then
993             sIntern = join(aJoinWithPathSign(), gPathSigne+"..")
994         else
995             sIntern = join(aSplitOnDoublePoints(), "")
996         endif
997     next i
998     ' set the returnvalue
999     fRelativeToAbsolutePath = sIntern
1000 end function
1002 '-------------------------------------------------------------------------
1004 sub sCheckValgrindStatus()
1005     ' valgrind only exists on Linux 
1006     ' If testlauncher is started with parameter --valgrind, a file called
1007     ' $HOME/tcs.txt is created, with the name of the .bas file
1008     ' If you don't know the testlauncher, just make sure that the file is created
1009     ' and contains the name of the .bas file, if you want to use valgrind tests.
1010     Dim sTestCaseSpecification as string
1011     Dim sList(10) as string
1012     Dim sTemp as string
1013     
1014     sTemp = environ("HOME")
1015     sTemp = sTemp + "/tcs.txt"
1016     if fileExists(sTemp) then
1017         ListRead(sList(), sTemp)
1018         if (ListCount(sList())>0) then
1019             sTemp = sList(1)
1020             sTemp = right(sTemp, len(sTemp)-1)
1021             printlog "**  Valgrind mode detected: '" + sTemp + "'"
1022             setChildEnv("tcs",sTemp)
1023         end if
1024     end if
1025 end sub
1027 '-------------------------------------------------------------------------
1029 function fgetDocumentLanguages(byRef aDefaultLocale(), optional bInteger as boolean)
1030 '/// INPUT: aDefaultLocale - array from 0 to 3
1031 '/// INPUT: OPTIONAL: bInteger - TRUE: return language as number en: 1; FALSE: (default) return the short text for locale e.g en_US
1032 '/// RETURN: write in the deliverd array aDefaultLocale depending on bInteger the language from Tools->Options->Language Settings->Languages->Default language for documents
1033 '///+ either the short string representing the language (default) e.g. en_US or the number e.g. 1
1034 '///+ The index of the array is defined:
1035 '///+ (1) Western
1036 '///+ (2) Asian
1037 '///+ (3) CTL
1039     dim uno
1040     dim ap
1041     dim xViewRoot
1042     dim apara(1) As new com.sun.star.beans.PropertyValue
1043     dim i as integer
1044     dim blInteger as boolean
1046     if isMissing(bInteger) then
1047         blInteger = FALSE
1048     else
1049         blInteger = bInteger
1050     endif
1052     uno=hGetUnoService(true)
1053     ap=uno.createInstance("com.sun.star.configuration.ConfigurationProvider")
1054     apara(0).Name="nodepath"
1055     apara(0).Value="/org.openoffice.Office.Linguistic/General"
1056     apara(1).Name="lazywrite"
1057     apara(1).Value=False
1058     xViewRoot=ap.createInstanceWithArguments("com.sun.star.configuration.ConfigurationUpdateAccess",aPara())
1059     aDefaultLocale(1) = xViewRoot.getPropertyValue("DefaultLocale")
1060     aDefaultLocale(2) = xViewRoot.getPropertyValue("DefaultLocale_CJK")
1061     aDefaultLocale(3) = xViewRoot.getPropertyValue("DefaultLocale_CTL")
1062     xViewRoot.dispose()
1063     
1064     ' If the return of the language number is requested, convert it
1065     if blInteger then
1066         for i = 1 to 3
1067             if aDefaultLocale(i) <> "" then
1068                 aDefaultLocale(i) = convertLanguage2(aDefaultLocale(i))
1069             else
1070                 aDefaultLocale(i) = 0
1071             endif
1072         next i
1073     endif
1074 end function
1076 '-------------------------------------------------------------------------
1078 function hDisableQuickstarterAPI as boolean
1079     Dim xQuickStarter as object
1080     Dim oUnoOfficeConnection as object
1081     Dim bResult as boolean
1083     bResult = TRUE
1084     'Second, closing the Quickstarter process that a restart of the office
1085     'would result into one process (the Quickstart would hinder otherwise
1086     'the communication to the office.    
1087     'On mac this results in a disbaled quickstarter imediately, but not persistant on restart.
1088     oUnoOfficeConnection=hGetUnoService(TRUE)
1089     if (isNull(oUnoOfficeConnection)) then
1090         QAErrorLog "Couldn't create UNO access. Can't disable Quickstarter via UNO API."                
1091         bResult = FALSE
1092     else
1093         try
1094             xQuickStarter = oUnoOfficeConnection.createInstance("com.sun.star.office.Quickstart")        
1095             'DEBUG: printlog xQuickStarter.dbg_supportedinterfaces
1096             'disable quickstart veto (not quickstart UI)
1097             xQuickStarter.setFastPropertyValue(0, FALSE)        
1098         catch
1099             qaErrorLog "Join Quickstarter and OOo process failed. There will be problems on shutdown"
1100             bResult = FALSE
1101         endcatch
1102     end if
1103     hDisableQuickstarterAPI = bResult    
1104 end function
1106 '-------------------------------------------------------------------------