'encoding UTF-8 Do not remove or change this line!
'*************************************************************************
'
' Licensed to the Apache Software Foundation (ASF) under one
' or more contributor license agreements. See the NOTICE file
' distributed with this work for additional information
' regarding copyright ownership. The ASF licenses this file
' to you under the Apache License, Version 2.0 (the
' "License"); you may not use this file except in compliance
' with the License. You may obtain a copy of the License at
'
' http://www.apache.org/licenses/LICENSE-2.0
'
' Unless required by applicable law or agreed to in writing,
' software distributed under the License is distributed on an
' "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
' KIND, either express or implied. See the License for the
' specific language governing permissions and limitations
' under the License.
'
'*************************************************************************
'*
'* short description : functions for directories and files; execution happens in the office
'*
'\************************************************************************
function DirNameList (ByVal sPfad$ , lsDirName() as String ) as Integer
'/// seperate a path in its parts
'/// Input: Path to seperate; Empty list, because it get's reset in this function!;
'/// Return: Number on entries in the list; list with entries
Dim i% : Dim Pos%
lsDirName(0) = 0
do
Pos% = InStr(1, sPfad$, gPathsigne ) ' got a part of teh path
i% = Val(lsDirName(0) ) + 1
lsDirName(0) = i%
lsDirName( i% ) = Left( sPfad$, Pos% ) ' .. put into list
sPfad = Mid( sPfad$, Pos% + 1 ) ' ...cut off
loop while Pos%>0
lsDirName( i% ) = sPfad$
DirNameList = i% ' count of
end function
'
'-------------------------------------------------------------------------------
'
function GetFileNameList ( sPath$, sMatch$ ,lsFile() as String ) as integer
'/// Get files from a directory that match the pattern and append them to a list (without path)
'/// Input: Directory with complete path; Search Pattern, e.g *.*; List
'/// Return: count of appended entries; updated list
Dim Count% : Dim Datname as String
Dim i as Integer
Count% = 0
' at the end of the string has to be teh path seperator, else the dir-command doesn't work
if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne
Datname = app.Dir( sPath$ + sMatch$ , 0) ' 0: normal files
for i=1 to 5
if Right ( Datname, 1 ) = "." then
Datname = app.Dir
else
i=10
end if
next i
do until Len(Datname) = 0
Count% = Count% + 1
lsFile(Count%) = Datname ' append
lsFile(0) = Count%
Datname = app.Dir
loop
GetFileNameList = Count% ' All files
end function
'
'-------------------------------------------------------------------------------
'
function GetFileList ( sPath$, sMatch$ ,lsFile() as String ) as integer
'/// Get files from a directory that match the pattern and append them to a list (with path)
'/// Input: Directory with complete path; Search Pattern, e.g *.*; List
'/// Return: count of appended entries; updated list
Dim Count% : Dim Datname as String
Dim i as Integer
Count% = 0
' at the end of the string has to be teh path seperator, else the dir-command doesn't work
if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne
Datname = app.Dir( sPath$ + sMatch$ , 0)
for i=1 to 5
if Right ( Datname, 1 ) = "." then
Datname = app.Dir
else
i=10
end if
next i
do until Len(Datname) = 0
lsFile(0) = Val(lsFile(0)) + 1
lsFile( lsFile(0) ) =sPath$ + Datname
Count% = Count% + 1
' if the number of files in the directory exceeds the arraysize do not
' crash but try to handle the situation gracefully. Of course this
' makes the testresults worthless...
if ( Count% = ubound( lsFile() ) ) then
warnlog ( "List of files exceeds bounds of array." )
printlog( "Processing of this directory will be discontinued." )
printlog( "Last processed file was: " & Datname )
printlog( "Arraysize is: " & ubound( lsFile() ) )
Datname = ""
else
Datname = app.Dir
endif
loop
GetFileList = Count%
end function
'
'-------------------------------------------------------------------------------
'
function GetDirList ( sPath$, sMatch$ ,lsFile() as String ) as integer
'/// Get Subdirectories from a directory and append them to a list (with path)
'/// Input: Directory with complete path; Search Pattern, e.g *; List
'/// Return: count of appended entries; updated list
Dim iFolderCount as integer
Dim Folder as String
' at the end of the string has to be teh path seperator, else the dir-command doesn't work
if right ( sPath$, 1 ) <> gPathSigne then sPath$ = sPath$ + gPathSigne
Folder = app.Dir( sPath$ + sMatch$ , 16)
iFolderCount = 0
do until Len( Folder ) = 0
select case ( lcase( Folder ) )
case "."
case ".."
case ".svn"
case ".hg"
case else
lsFile(0) = Val(lsFile(0)) + 1
lsFile( lsFile(0) ) = sPath$ + Folder + gPathSigne
iFolderCount = iFolderCount + 1
end select
Folder = app.Dir
loop
GetDirList = iFolderCount
end function
'
'-------------------------------------------------------------------------------
'
function GetAllDirList ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer
'/// Get all directorys recursiv that match the pattern and append them to a list
'/// Input: Directory with complete path; Search Pattern, e.g *; Empty list, because it get's reset in this function!;
'/// Return: Count of appended entries (1. entry is the whole path); updated list
Dim Count% : Dim DirCount%
DirCount% = 1 ' dummy
Count% = 1
lsFile(0) = 1 'new list
lsFile(1) = sPath$ 'first path is the called path
do until Count%>Val(lsFile(0)) ' get count of 1.generation
DirCount% = GetDirList( lsFile(Count%) , sMatch$, lsFile() ) ' append all subdirectories
Count% = Count% +1
loop
GetAllDirList = Count% - 1 ' count of...
end function
'
'-------------------------------------------------------------------------------
'
function GetAllFileList ( byVal sPath$, byVal sMatch$ ,lsFile() as String ) as integer
'/// Get all Files recursiv (including in subdirectories) that match the pattern and append them to a list
'/// Input: Directory with complete path; Search Pattern, e.g *.*; Empty list, because it get's reset in this function!;
'/// Return: Count of appended entries (1. entry is the whole path); updated list
Dim DirCount% : Dim FileCount% : Dim Count%
Dim lsDir(1000) as String
DirCount% = GetAllDirList( sPath$, "*", lsDir() ) ' erstmal _alle_ Verzeichnisse
FileCount% = 0
lsFile(0) = 1
lsFile(1) = sPath$
For Count% = 1 to Val( lsDir(0) )
FileCount% = FileCount% + GetFileList( lsDir( Count% ), sMatch$, lsFile() )
next Count%
GetAllFileList = FileCount% ' Anzahl aller Dateien
end function
'
'-------------------------------------------------------------------------------
'
function KillFileList ( lsList() as String ) as Boolean
'/// Delete all files in the list
'/// Input: List with files
'/// Return: TRUE or FALSE if files are killed; modified list with not deleted files.
Dim i as Integer
Dim FehlerListe ( 1000 ) as String
FehlerListe ( 0 ) = 0
for i=1 to ListCount ( lsList() )
try
app.kill ( lsList(i) )
catch
ListAppend ( FehlerListe (), lsList(i) )
endcatch
next i
lsList(0) = 0 ' delete old list
KillFileList = TRUE
for i=1 to ListCount ( FehlerListe () )
KillFileList = FALSE
ListAppend ( lsList(), FehlerListe (i) )
next i
end function
'
'-------------------------------------------------------------------------------
'
function KillDirList ( lsList() as String ) as Boolean
'/// Delete all directories in the list
'/// Input: List with directories
'/// Return: TRUE or FALSE if directories are killed; modified list with not deleted directories.
Dim i as Integer
Dim FehlerListe ( 1000 ) as String
FehlerListe ( 0 ) = 0
for i=1 to ListCount ( lsList() )
try
app.rmDir ( lsList(i) )
catch
ListAppend ( FehlerListe (), lsList(i) )
endcatch
next i
lsList(0) = 0 ' delete old list
KillDirList = TRUE
for i=1 to ListCount ( FehlerListe () )
KillDirList = FALSE
ListAppend ( lsList(), FehlerListe (i) )
next i
end function
'
'-------------------------------------------------------------------------------
'
function DateiExtract ( sFileDat$ )
'/// Get the filename from a path
'/// Input: path with file
'/// Return: filename without the path
Dim i%
dim ls(20) as String
i% = DirNameList( sFileDat$, ls() )
DateiExtract = ls(i%)
end function
'
'-------------------------------------------------------------------------------
'
function DateiOhneExt (Datei$) as String
'/// Get the filename without the extension
'/// Input: filename
'/// Return: filename without the extension
Dim wh as Integer
Dim dummy as String
dummy = Datei$
for wh = 1 to len(dummy)
if mid(dummy,wh,1) = "." then
dummy = left(dummy,wh - 1)
wh = len(dummy) + 1
else
dummy = dummy
end if
next wh
DateiOhneExt = dummy
end function
'
'-------------------------------------------------------------------------------
'
function GetExtention ( Datei as String ) as string
'/// Get the extension from a file
'/// Input: filename
'/// Return: extension of the file
Dim i%
for i% = 1 to len ( Datei )
if mid(Datei,i%,1) = "." then Datei = right( Datei, len(Datei)-i%)
next i%
GetExtention = Datei
end function
'
'-------------------------------------------------------------------------------
'
function hSplitString( sString as string, sSeparator as string, iIndex as integer ) as string
' This function wraps around the "split" command and returns one single
' item by index. Index = 0 means the *LAST* item is returned as this is
' probably the most commonly used item. If the index is invalid (out of
' bounds) we print a warning and return an error string.
const CFN = "global::tools::includes::required::t_dir.inc:hSplitString(): "
const ERROR_MESSAGE = "Array out of bounds for the requested index in string "
const ARRAY_INDEX_CORRECTION = 1 ' The array lower boundary is zero but
' function starts to count with one.
' Split the string into its fragments into an array with dynamic boundaries
dim sArray() as string
dim sReturnString as string : sReturnString = ""
if ( GVERBOSE ) then
printlog( CFN & "Separator is: " & sSeparator )
printlog( CFN & "Original string is: " & sString )
endif
sArray() = split( sString, sSeparator )
if ( GVERBOSE ) then
printlog( CFN & "Number of items found: " & ubound( sArray() ) )
endif
' Special case: Index out of bounds
if ( iIndex > ( ubound( sArray() ) + ARRAY_INDEX_CORRECTION ) or iIndex < 0 ) then
warnlog( CFN & ERROR_MESSAGE & sString )
hSplitString() = ERROR_MESSAGE & sString
exit function
endif
' Special case: Last item requested (this usually is the filename from a path)
if ( iIndex = 0 ) then
sReturnString = sArray( ubound( sArray() )
if ( GVERBOSE ) then printlog( CFN & sReturnString )
hSplitString() = sReturnString
exit function
endif
' Default is to return the requested item.
sReturnString = sArray( iIndex - ARRAY_INDEX_CORRECTION )
if ( GVERBOSE ) then printlog( CFN & sReturnString )
hSplitString() = sReturnString
end function