testautomation/global/tools/includes/required/t_dir.inc

   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_dir.inc,v $
  10 '*
  11 '* $Revision: 1.1 $
  12 '*
  13 '* last change: $Author: jsi $ $Date: 2008-06-13 10:27:09 $
  14 '*
  15 '* This file is part of OpenOffice.org.
  16 '*
  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.
  20 '*
  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).
  26 '*
  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.
  31 '*
  32 '/************************************************************************
  33 '*
  34 '* owner : thorsten.bosbach@sun.com
  35 '*
  36 '* short description : functions for directories and files; execution happens in the office
  37 '*
  38 '\************************************************************************
  39
  40 function hFileExists ( Dat as String ) as Boolean
  41     '/// Checks if a file exists
  42     '/// <u>Input</u>: Filename with complete path
  43     '/// <u>Return</u>: TRUE or FALSE if the file exists.
  44     if app.Dir ( Dat ) = "" then
  45         hFileExists = FALSE
  46     else
  47         hFileExists = TRUE
  48     end if
  49 end function
  50 '
  51 '-------------------------------------------------------------------------------
  52 '
  53 function hDirectoryExists ( Verz as String ) as Boolean
  54     '/// Checks if a directory exists
  55     '/// <u>Input</u>: Directory with complete path
  56     '/// <u>Return</u>: TRUE or FALSE if the directory exists.
  57     ' at the end of the string has to be teh path seperator, else the dir-command doesn't work
  58     if right ( Verz, 1 ) <> gPathSigne then Verz = Verz + gPathsigne
  59     if app.Dir ( Verz, 16 ) = "" then
  60         hDirectoryExists = FALSE
  61     else
  62         hDirectoryExists = TRUE
  63     end if
  64 end function
  65 '
  66 '-------------------------------------------------------------------------------
  67 '
  68 function hKillFile ( Dat as String ) as Boolean
  69     '/// Delete a file
  70     '/// <u>Input</u>: File with complete path
  71     '/// <u>Return</u>: TRUE or FALSE success on deleting?
  72     if app.Dir ( Dat ) <> "" then
  73         try
  74             app.kill ( Dat )
  75         catch
  76         endcatch
  77         if app.Dir ( Dat ) <> "" then
  78             hKillFile = FALSE
  79         else
  80             hKillFile = TRUE
  81         end if
  82     else
  83         hKillFile = TRUE
  84     end if
  85 end function
  86 '
  87 '-------------------------------------------------------------------------------
  88 '
  89 function DirNameList (ByVal sPfad$ , lsDirName() as String ) as Integer
  90     '/// seperate a path in its parts
  91     '/// <u>Input</u>: Path to seperate; Empty list, because it get's reset in this function!;
  92     '/// <u>Return</u>: Number on entries in the list; list with entries
  93     Dim i% : Dim Pos%
  94     lsDirName(0) = 0
  95     do
  96         Pos% = InStr(1, sPfad$, gPathsigne )  ' got a part of teh path
  97         i% = Val(lsDirName(0) ) + 1
  98         lsDirName(0) = i%
  99         lsDirName( i%  ) = Left( sPfad$, Pos%  )    ' .. put into list
 100         sPfad = Mid( sPfad$, Pos% + 1 )         ' ...cut off
 101     loop while Pos%>0
 102     lsDirName( i%  ) = sPfad$
 103     DirNameList = i%    ' count of
 104 end function
 105 '
 106 '-------------------------------------------------------------------------------
 107 '
 108 function GetFileNameList ( sPath$, sMatch$ ,lsFile() as String  ) as integer
 109     '/// Get files from a directory that match the pattern and append them to a list (without path)
 110     '/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; List
 111     '/// <u>Return</u>: count of appended entries; updated list
 112     Dim Count% : Dim Datname as String
 113     Dim i  as Integer
 114     Count% = 0
 115     ' at the end of the string has to be teh path seperator, else the dir-command doesn't work
 116     if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne
 117     Datname = app.Dir( sPath$ + sMatch$ , 0) ' 0: normal files
 118     for i=1 to 5
 119         if Right ( Datname, 1 ) = "." then
 120             Datname = app.Dir
 121         else
 122             i=10
 123         end if
 124     next i
 125
 126     do until Len(Datname) = 0
 127         Count% = Count% + 1
 128         lsFile(Count%) = Datname    ' append
 129         lsFile(0) = Count%
 130         Datname = app.Dir
 131     loop
 132
 133     GetFileNameList = Count%    ' All files
 134 end function
 135 '
 136 '-------------------------------------------------------------------------------
 137 '
 138 function GetFileList ( sPath$, sMatch$ ,lsFile() as String  ) as integer
 139     '/// Get files from a directory that match the pattern and append them to a list (<b>with</b> path)
 140     '/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; List
 141     '/// <u>Return</u>: count of appended entries; updated list
 142     Dim Count% : Dim Datname as String
 143     Dim i as Integer
 144     Count% = 0
 145     ' at the end of the string has to be teh path seperator, else the dir-command doesn't work
 146     if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne
 147     Datname = app.Dir( sPath$ + sMatch$ , 0)
 148     for i=1 to 5
 149         if Right ( Datname, 1 ) = "." then
 150             Datname = app.Dir
 151         else
 152             i=10
 153         end if
 154     next i
 155
 156     do until Len(Datname) = 0
 157         lsFile(0) = Val(lsFile(0)) + 1
 158         lsFile( lsFile(0) ) =sPath$ + Datname
 159         Count% = Count% + 1
 160
 161         ' if the number of files in the directory exceeds the arraysize do not
 162         ' crash but try to handle the situation gracefully. Of course this
 163         ' makes the testresults worthless...
 164         if ( Count% = ubound( lsFile() ) ) then
 165             warnlog ( "List of files exceeds bounds of array." )
 166             printlog( "Processing of this directory will be discontinued." )
 167             printlog( "Last processed file was: " & Datname )
 168             printlog( "Arraysize is: " & ubound( lsFile() ) )
 169             Datname = ""
 170         else
 171             Datname = app.Dir
 172         endif
 173     loop
 174     GetFileList = Count%
 175 end function
 176 '
 177 '-------------------------------------------------------------------------------
 178 '
 179 function GetDirList ( sPath$, sMatch$ ,lsFile() as String ) as integer
 180     '/// Get Subdirectories from a directory and append them to a list (<b>with</b> path)
 181     '/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *; List
 182     '/// <u>Return</u>: count of appended entries; updated list
 183     Dim iFolderCount as integer
 184     Dim Folder as String
 185     ' at the end of the string has to be teh path seperator, else the dir-command doesn't work
 186     if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne
 187     Folder = app.Dir( sPath$ + sMatch$ , 16)
 188     iFolderCount = 0
 189
 190     do until Len( Folder ) = 0
 191         select case ( lcase( Folder ) )
 192         case "."
 193         case ".."
 194         case ".svn"
 195         case ".hg"
 196         case else
 197             lsFile(0) = Val(lsFile(0)) + 1
 198             lsFile( lsFile(0) ) = sPath$  + Folder + gPathSigne
 199             iFolderCount = iFolderCount + 1
 200         end select
 201         Folder = app.Dir
 202     loop
 203     GetDirList = iFolderCount
 204 end function
 205 '
 206 '-------------------------------------------------------------------------------
 207 '
 208 function GetAllDirList ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer
 209     '/// Get all directorys recursiv that match the pattern and append them to a list
 210     '/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *; Empty list, because it get's reset in this function!;
 211     '/// <u>Return</u>: Count of appended entries (1. entry is the whole path); updated list
 212     Dim Count% : Dim DirCount%
 213
 214     DirCount% = 1   ' dummy
 215     Count% = 1
 216     lsFile(0) = 1           'new list
 217     lsFile(1) = sPath$      'first path is the called path
 218
 219     do until Count%>Val(lsFile(0))  ' get count of 1.generation
 220         DirCount% = GetDirList( lsFile(Count%) , sMatch$, lsFile() )        ' append all subdirectories
 221         Count% = Count% +1
 222     loop
 223
 224     GetAllDirList = Count% - 1  ' count of...
 225 end function
 226 '
 227 '-------------------------------------------------------------------------------
 228 '
 229 function GetAllFileList ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer
 230     '/// Get all Files recursiv (including in subdirectories) that match the pattern and append them to a list
 231     '/// <u>Input</u>: Directory with complete path; Search Pattern, e.g *.*; Empty list, because it get's reset in this function!;
 232     '/// <u>Return</u>: Count of appended entries (1. entry is the whole path); updated list
 233     Dim DirCount% : Dim FileCount% : Dim Count%
 234     Dim lsDir(1000) as String
 235
 236     DirCount% = GetAllDirList( sPath$, "*", lsDir() ) ' erstmal _alle_ Verzeichnisse
 237     FileCount% = 0
 238     lsFile(0) = 1
 239     lsFile(1) = sPath$
 240
 241     For Count% = 1 to Val( lsDir(0) )
 242         FileCount% = FileCount% + GetFileList( lsDir( Count% ), sMatch$, lsFile() )
 243     next Count%
 244
 245     GetAllFileList = FileCount% ' Anzahl aller Dateien
 246 end function
 247 '
 248 '-------------------------------------------------------------------------------
 249 '
 250 function KillFileList ( lsList() as String ) as Boolean
 251     '/// Delete all files in the list
 252     '/// <u>Input</u>: List with files
 253     '/// <u>Return</u>: TRUE or FALSE if files are killed; modified list with not deleted files.
 254     Dim i as Integer
 255     Dim FehlerListe ( 1000 ) as String
 256
 257     FehlerListe ( 0 ) = 0
 258     for i=1 to ListCount ( lsList() )
 259         try
 260             app.kill ( lsList(i) )
 261         catch
 262             ListAppend ( FehlerListe (), lsList(i) )
 263         endcatch
 264     next i
 265
 266     lsList(0) = 0               ' delete old list
 267     KillFileList = TRUE
 268     for i=1 to ListCount ( FehlerListe () )
 269         KillFileList = FALSE
 270         ListAppend (  lsList(), FehlerListe (i) )
 271     next i
 272 end function
 273 '
 274 '-------------------------------------------------------------------------------
 275 '
 276 function KillDirList ( lsList() as String ) as Boolean
 277     '/// Delete all directories in the list
 278     '/// <u>Input</u>: List with directories
 279     '/// <u>Return</u>: TRUE or FALSE if directories are killed; modified list with not deleted directories.
 280     Dim i as Integer
 281     Dim FehlerListe ( 1000 ) as String
 282
 283     FehlerListe ( 0 ) = 0
 284     for i=1 to ListCount ( lsList() )
 285         try
 286             app.rmDir ( lsList(i) )
 287         catch
 288             ListAppend ( FehlerListe (), lsList(i) )
 289         endcatch
 290     next i
 291
 292     lsList(0) = 0               ' delete old list
 293     KillDirList = TRUE
 294     for i=1 to ListCount ( FehlerListe () )
 295         KillDirList = FALSE
 296         ListAppend (  lsList(), FehlerListe (i) )
 297     next i
 298 end function
 299 '
 300 '-------------------------------------------------------------------------------
 301 '
 302 function PfadExtract ( sFiledat$ ) as string
 303     '/// Get the path from a file
 304     '/// <u>Input</u>: file with path
 305     '/// <u>Return</u>: path without the filename
 306     Dim s$ : Dim i% : Dim k%
 307     dim ls(25) as String
 308
 309     s$ = ""
 310     i% = DirNameList( sFileDat$, ls() )
 311     k% = 2
 312     do until K%>=i%
 313         ls( 1 ) = ls( 1 ) +  ls(k%)
 314         k% = k% +1
 315     loop
 316     PfadExtract = Left( ls(1), Len(ls( 1 ))-1)
 317 end function
 318 '
 319 '-------------------------------------------------------------------------------
 320 '
 321 function hPfadname (Dateipfad$) as string
 322     '/// Get the path from a file
 323     '/// <u>Input</u>: file with path
 324     '/// <u>Return</u>: path without the filename
 325     dim wh as integer
 326
 327     for wh = len(Dateipfad$) to 1 step -1
 328         if mid(Dateipfad$,wh,1) = gPathSigne then
 329             hpfadname = left(Dateipfad$,wh)
 330             exit for
 331         else
 332             hpfadname = Dateipfad$
 333         end if
 334     next wh
 335 end function
 336 '
 337 '-------------------------------------------------------------------------------
 338 '
 339 function DateiExtract ( sFileDat$ )
 340     '/// Get the filename from a path
 341     '/// <u>Input</u>: path with file
 342     '/// <u>Return</u>: filename without the path
 343     Dim i%
 344     dim ls(20) as String
 345
 346     i% = DirNameList( sFileDat$, ls() )
 347     DateiExtract = ls(i%)
 348 end function
 349 '
 350 '-------------------------------------------------------------------------------
 351 '
 352 function DateiOhneExt (Datei$) as String
 353     '/// Get the filename without the extension
 354     '/// <u>Input</u>: filename
 355     '/// <u>Return</u>: filename without the extension
 356     Dim wh as Integer
 357     Dim dummy as String
 358
 359     dummy = Datei$
 360     for wh = 1 to len(dummy)
 361         if mid(dummy,wh,1) = "." then
 362             dummy = left(dummy,wh - 1)
 363             wh = len(dummy) + 1
 364         else
 365             dummy = dummy
 366         end if
 367     next wh
 368     DateiOhneExt = dummy
 369 end function
 370 '
 371 '-------------------------------------------------------------------------------
 372 '
 373 function GetExtention ( Datei as String ) as string
 374     '/// Get the extension from a file
 375     '/// <u>Input</u>: filename
 376     '/// <u>Return</u>: extension of the file
 377     Dim i%
 378     for i% = 1 to len ( Datei )
 379         if mid(Datei,i%,1) = "." then Datei = right( Datei, len(Datei)-i%)
 380     next i%
 381     GetExtention = Datei
 382 end function
 383