'# 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

'_============================================================== 
'-- *****************************************************' 

sub MKSubDir (DirDst$)
'Andrew Shelkovenko dec 2003 
'Create DirDst$ directory with full subdir structure 
z1=instr(DirDst$,"\")
z2=0
while z1>0
SubDirDst$=left$(DirDst$,z1 )
if DIREXISTS(SubDirDst$)=0 then MKDIR SubDirDst$
'print "SubDirDst$=" ,SubDirDst$ 
z2=z1+1
z1=instr(z2,DirDst$,"\")

wend
end sub

'-- *****************************************************' 
sub SubDirCopy (DirSrc$, DirDst$, mask$) '- -----------------------------------' 
'Andrew Shelkovenko dec 2003 
'Copy DirSrc$ directory with full subdir structure and files (by mask$) to DirDst$ 
dim FileSrc as QFileStream
dim FileDst as QFileStream

'Index=0 
NumFiles=0
defint nsd1, nsd2
defstr mask
nsd1=0:nsd2=0
NumDir=0
ArrNumDir=500
dim SubDir(500) as string

ArrNumFil=500
dim FileNames (500) as string
mask="*.*"
SubDir(0)=DirSrc$

1
for i=NSD1 to Nsd2 'current level sudirs' 
'print "SubDir(",i,")=",SubDir(i) 
SubDirname$=dir$(SubDir(i)+mask, faDirectory)

while    SubDirname$ <>""
  if FileRec.Size =0 and SubDirname$<> "." and SubDirname$<> ".." then '' 
    inc adddir
    inc NumDir 'add subdir' 
if NumDir=ArrNumDir then ArrNumDir=ArrNumDir+300: redim SubDir(ArrNumDir) as string
    SubDir(NumDir)=SubDir(i)+SubDirname$+"\"
''    print "SubDir(", NumDir, ")=",SubDir(NumDir) 
else
end if
  SubDirname$=dir$
 doevents:if stops1=1 then stops1=0: exit sub
wend
'search files in current subdirectory 
    Fn$=dir$(SubDir(i)+mask$,faAnyFile-faDirectory) ':-) 
     while Fn$ <>""
if  Fn$<> "." and Fn$<> ".."  then 'and FileRec.Size <>0' 
    inc NumFiles
if NumFiles=ArrNumFil then ArrNumFil=ArrNumFil+300: redim FileNames(ArrNumFil) as string:print "redim FileNames"
 FileNames(NumFiles)=SubDir(i)+Fn$
 print "FileNames(",NumFiles,")=" ,FileNames(NumFiles)
 
else
end if
    Fn$=dir$
     wend
next i

if adddir>0 then
NSD1=NSD2+1       
NSD2=NSD2+adddir  
adddir=0
goto 1 'repeat with new sub level  
else
end if

' got subdirs list in SubDir(i) array and file list with full path in FileNames(j) 
' now create subdirs structure with new path 

for i1=0 to i-1
NewSubDir$=SubDir(i1)-DirSrc$
NewSubDir$=DirDst$+NewSubDir$
MKSubDir (NewSubDir$)
next i1

for j=1 to NumFiles
FileSrc.Open(FileNames(j), fmOpenRead) 
NewFileName$=FileNames(j)-DirSrc$
NewFileName$=DirDst$+NewFileName$
'print "NewFileName$=" ,NewFileName$ 
FileDst.Open(NewFileName$, fmCreate) 
FileDst.CopyFrom  (FileSrc, 0)'' 
		FileSrc.close'' 
		FileDst.close
next j

end sub

'-- ***********************************************************************' 
sub DirCopy (DirSrc$, DirDst$, mask$) '- -----------------------------------' 
'Andrew Shelkovenko dec 2003 
'Copy files (by mask$) from DirSrc$ to DirDst$ 
dim FileSrc as QFileStream
dim FileDst as QFileStream
MKDIR DirDst$

FileName$ = DIR$(DirSrc$+mask$, 0) '-- Get first file 

while    FileName$ <>""

FileSrc.Open(DirSrc$+filename$, fmOpenRead) 
FileDst.Open(DirDst$ +"\"+filename$, fmCreate) 
FileDst.CopyFrom  (FileSrc, 0)
		FileSrc.close
		FileDst.close

FileName$ = DIR$ '-- Get next file 

'inc rest 
wend
'print "copied= "+str$(rest) +" files 

rest=0

end sub
'-- ***********************************************************************' 
SUB io2Rnd (fsrc$, fdst$)
'-------------------------------- 
'convert text file with single value strings to binary 
' for example 

'17.78091 
'16.64166 
'19.87037 
'21.29429 
'15.64965 

'fsrc$ - source file  fdst$ - dest. file 
'data type - single 

'const fmCreate = 65535 
'const fmOpenRead = 0 
'const fmOpenWrite = 1 
'const fmOpenReadWrite = 2 
 
dim FileSourse as QFileStream
dim FileDest as QFileStream
defsng ValSrc

FileSourse.Open (fsrc$, 2 )'fmOpenReadWrite' 
FileDest.Open   (fdst$, 65535 )  'fmOpenReadWrite' 

WHILE NOT FileSourse.EOF
ValSrc$=FileSourse.ReadLine : 'print "ValSrc$=" ,ValSrc$ 
ValSrc=val(ValSrc$) :         'print "ValSrc=" ,ValSrc 
FileDest.Write (ValSrc)
wend

FileSourse.CLOSE  
FileDest.CLOSE 

END SUB

'-- ***********************************************************************' 
SUB Rnd2io (fsrc$, fdst$)
'-------------------------------- 
'convert  binary file with single type value data to  text file with single type value strings 
' for example 

'17.78091 
'16.64166 
'19.87037 
'21.29429 
'15.64965 

'const fmCreate = 65535 
'const fmOpenRead = 0 
'const fmOpenWrite = 1 
'const fmOpenReadWrite = 2 

'const Num_BYTE = 1  
'const Num_SHORT = 2 
'const Num_WORD = 3 
'const Num_LONG = 4 
'const Num_DWORD = 5 
'const Num_SINGLE = 6 
'const Num_DOUBLE = 8 

dim FileSourse as QFileStream
dim FileDest as QFileStream

defsng ValSrc

FileSourse.Open (fsrc$, 2 )        'fmOpenReadWrite' 
FileDest.Open   (fdst$, 65535 )    'fmOpenCreate' 

ie = FileSourse.size/4: 'print "ie=" ,ie 

for i=0 to ie-1
ValSrc=FileSourse.ReadNum(6) :'print "ValSrc=" ,ValSrc 
ValSrc$=str$(ValSrc):			'print "ValSrc$=" ,ValSrc$ 
FileDest.WriteLine (ValSrc$)
next i

FileSourse.CLOSE  
FileDest.CLOSE 

END SUB