Const FILE_ATTRIBUTE_READONLY = &H1
Const FILE_ATTRIBUTE_HIDDEN = &H2
Const FILE_ATTRIBUTE_SYSTEM = &H4
Const FILE_ATTRIBUTE_DIRECTORY = &H10
Const FILE_ATTRIBUTE_ARCHIVE = &H20
Const FILE_ATTRIBUTE_NORMAL = &H80
Const FILE_ATTRIBUTE_TEMPORARY = &H100
Const FILE_ATTRIBUTE_COMPRESSED = &H800
Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Declare Function GetFileAttributes Lib "kernel32" Alias "GetFileAttributesA"_
(ByVal lpFileName As String) As Long
Declare Function SetFileAttributes Lib "kernel32" Alias "SetFileAttributesA"_
(ByVal lpFileName As String, ByVal dwFileAttributes As Long) As Long
Declare Function CreateDirectory Lib "kernel32" Alias "CreateDirectoryA" _
(ByVal lpPathName As String, lpSecurityAttributes As SECURITY_ATTRIBUTES) As Long
'# QUOTE : Returns a quoted string
function Quote (StringToQuote as string) as string
StringToQuote = chr$(34) + StringToQuote + chr$(34)
result = replacesubstr$(stringtoquote, chr$(34) + chr$(34), chr$(34))
end function
'===============================================================================
'# STRIPPATH : Returns file path (without file name)
Function StripPath (fullname as string) as string
result = left$(fullname, rinstr(fullname, "\"))
end function
'===============================================================================
'# STRIPFILENAME : Returns file name (without path)
Function StripFileName (fullname as string) as string
result = right$(fullname, len(fullname) - rinstr(fullname, "\"))
end function
'===============================================================================
'# STRIPFILEEXT : Returns file extension (like ".exe", ".html" etc.)
Function StripFileExt (fullname as string) as string
result = right$(fullname, len(fullname) - rinstr(fullname, ".") + 1)
end function
'===============================================================================
'# FILENAMENOEXT : Returns file name without extension
function FileNameNoExt(fullname as string) as string
fullname = right$(fullname, len(fullname) - rinstr(fullname, "\"))
result = left$(fullname, rinstr(fullname, ".") - 1)
end function
'===============================================================================
'# FULLPATHNOEXT : Returns full path without file extension
function FullPathNoExt(fullname as string) as string
result = left$(fullname, rinstr(fullname, ".") - 1)
end function
'===============================================================================
'# C_Style : Returns "slashed" path from a "backslashed" one
function C_Style (fullname as string) as string
fullname = replacesubstr$(fullname, "\\", "\")
result = replacesubstr$(fullname, "\", "/")
end function
'===============================================================================
'# SYSDIR : Retrieves windows shell directories
'-------------------------|
' Allowed values for dir |
'-----------------------------------------------------------------------------|
' Desktop | Templates | AppData |
' Start Menu | Programs | Startup |
' Fonts | SendTo | Recent |
' Favorites | Cache | Cookies |
' History | NetHood | Personal |
' PrintHood | Local AppData | My Pictures |
' Administrative Tools | | |
'-----------------------------------------------------------------------------|
function SysDir (dir as string) as string
DIM fo_reg AS QRegistry
fo_reg.RootKey = &H80000001
fo_reg.openkey ("Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders", 0)
result = fo_reg.readstring(dir) + "\"
end function
'===============================================================================
'# HOMEDIR : The folder where the application is
function homedir() as string
result = left$(command$(0), rinstr(command$(0), "\"))
end function
'===============================================================================
'# BROWSEFORFOLDERS : Returns the selected folder
function BrowseForFolders (initialdir as string, wincapt as string) as string
dim bff_form as qform
with bff_form
.height = 400
.center
.caption = wincapt
.delbordericons 2
end with
dim bff_tree as qdirtree
with bff_tree
.parent = bff_form
.align = 5
end with
if bff_form.caption = "" then bff_form.caption = "Select folder"
if direxists(initialdir) then
bff_tree.directory = initialdir
else
bff_tree.directory = curdir$
end if
bff_form.showmodal
result = bff_tree.directory
end function
'===============================================================================
'# BROWSEFORFILE : Returns the selected folder
Function BrowseForFile (caption as string, filter as string, _
initialdir as string) as string
dim bff_od as qopendialog
with bff_od
.caption = caption
.filter = filter
.initialdir = initialdir
if .execute then
result = .filename
end if
end with
end function
'_=============================================================================
$ESCAPECHARS ON
'ChangeFileExt:
'Returns: String
'Parameters:
'FileName (String): Name of file with old extention
'NewExt (String): New extention. This must include the leading ".".
'Information:
'Author: Taj Morton
'Email: tmorton at linuxmail dot org.
'License: Public Domain
'Description:
'Changes the extention of FileName to NewExt. For example:
'ChangeFileExt("File.bas", ".inc")
'returns File.inc. This function does not delete the old string,
'instead, it simply returns a new one with the extention.
'You must include the leading "." for it to be added, as it is not
'done by the function.
FUNCTION ChangeFileExt(FileName as String, NewExt as STRING) as STRING
DIM Returns as STRING
DIM CurrentExt as String
DIM CurrentExtLoc as INTEGER
DIM FileNoExt as STRING
CurrentExtLoc = RInStr(FileName, ".")
CurrentExt = MID$(FileName, CurrentExtLoc, LEN(FileName))
FileNoExt = DELETE$(FileName, CurrentExtLoc, LEN(FileName))
Result = INSERT$(NewExt, FileNoExt, LEN(FileName))
ChangeFileExt = Result
END FUNCTION
'ExtractFileName:
'Returns: String
'Parameters:
'FileName (String): File with full path
'Information:
'Author: Taj Morton
'Email: tmorton at linuxmail dot org.
'License: Public Domain
'Description:
'ExtractFileName takes a file name with a path and returns only
'the file name. For example:
'ExtractFileName("C:\\Program Files\\AFile.bas")
'returns AFile.bas. You can use either two back-slashes or a single
'forward slash (/) for folder seperators.
'Both forward and back-slashes are supported by Windows.
'The back-slash takes procedure over the forward slash.
'Note that ExtractFileName does _not_ check the validity of the path passed.
'You must check yourself.
FUNCTION ExtractFileName(FileName as STRING) AS STRING
DIM Length as INTEGER
DIM Result as STRING
Length = RInStr(FileName, "\\") OR RInStr(FileName, "/")
Result = MID$(FileName, Length+1, LEN(FileName) - Length + 1)
ExtractFileName = Result
END FUNCTION
'ExtractFilePath
'Returns: String
'Parameters:
'FileName (String): File with full path
'Information:
'Author: Taj Morton
'Email: tmorton at linuxmail dot org.
'License: Public Domain
'Description:
'ExtractFilePath takes string with full path and returns a string
'with only the path. For example:
'ExtractFilePath("C:\\Program Files\\AProgram.bas")
'returns C:\Program Files (the \\'s are for RQ and back-slashes).
'ExtractFilePath also takes forward-slashes (/). Window's supports
'these as well.
'The back-slash takes procedure over the forward slash.
'Note that ExtractFilePath does _not_ test the validity
'of the passed name. You must check it yourself. Even if the name is
'invalid, the path will be returned. For example, if C:/ProgramErrorFiles/AFile.txt
'is passed, C:/ProgramErrorFiles will be returned.
'-- *****************************************************'
FUNCTION ExtractFilePath(FileName as STRING) AS STRING
DIM Length as INTEGER
DIM Result as STRING
Length = RInStr(FileName, "\\") OR RInStr(FileName, "/")
Result = MID$(FileName, 0, Length)
ExtractFilePath = Result
END FUNCTION
'ChangeFileName
'Returns: String
'Parameters:
'FileName (String): File with full path
'NewName (String): Text that will replace old file name
'Information:
'Author: Taj Morton
'Email: tmorton at linuxmail dot org.
'License: Public Domain
'Description:
'ChangeFileName takes a file name with full path and file and a new name.
'It replaces the current filename (in FileName) and replaces it with NewName.
'ChangeFileName does not actually change FileName, instead it returns a new
'string which contains the new name.
'Note that ChangeFileName does not check the validity of FileName
'or the new result. You must do it yourself (if you want). ChangeFileName
'takes both the back-slash and forward slash to serperate folder and file names.
'You can use either \\ or /. Both are supported by Windows.
'The back-slash takes procedure over the forward slash.
'-- *****************************************************'
FUNCTION ChangeFileName(FileName as STRING, NewName as STRING) AS STRING
DIM FileNameLoc as INTEGER
DIM Result as STRING
DIM PathNoName AS STRING
PathNoName = ExtractFilePath(FileName)
Result = PathNoName+NewName
ChangeFileName = Result
END FUNCTION
'ChangeFilePath
'Returns: String
'Parameters:
'FileName (String): File with full path
'NewPath (String): New path that will replace the path in FileName
'Information:
'Author: Taj Morton
'Email: tmorton at linuxmail dot org.
'License: Public Domain
'Description:
'ChangeFilePath takes FileName and replaces the path with NewPath.
'It does not change FileName to have the new path, instead, it returns
'a string which has the new path. It's up to you to take the correct
'action. Also, old or new path and names' are not checked for validity,
'you must do it yourself.
'You may use either the \\ or the / to seperate your paths. Windows supports
'both.
'-- *****************************************************'
FUNCTION ChangeFilePath(FileName as STRING, NewPath as STRING) AS STRING
DIM Result AS STRING
DIM FileNoPath AS STRING
FileNoPath = ExtractFileName(FileName)
Result = NewPath+FileNoPath
ChangeFilePath = Result
END FUNCTION
$ESCAPECHARS Off
'_==============================================================
'==============================================================
FUNCTION FileSize(FileName as STRING) AS integer
DIM fileStr as QFileStream
if fileexists (FileName)>0 then
fileStr.open (FileName,0)
result= fileStr.size
fileStr.close
else
result=-1
end if
END FUNCTION
'-- *****************************************************'
FUNCTION SaveString(ss$ as STRING ,FileName as STRING ) AS integer
if FileName="" then showmessage ("FUNCTION SaveString. Wrong FileName="+FileName)
DIM fileStr as QFileStream
result=0
fileStr.open (FileName,65535 ) 'fmCreate'
result=-1
FileStr.WriteStr(ss$, len(ss$))
FileStr.Close
result=1
END FUNCTION
'-- *****************************************************'
FUNCTION LoadString(FileName as STRING ) AS