'***** More Useful subs and functions ******

'=======================================================================|
' Also see Fileops functions:                                           |
'  QUOTE - Returns a quoted string                                      |
'  STRIPPATH - Returns file path (without file name)                    |
'  STIPFILENAME - Returns file name (without path)                      |
'  STRIPFILEEXT - Returns file extension (like ".exe", ".html" etc.)    |
'  FILENAMENOEXT - Returns file name without extension                  |
'  FULLPATHNOEXT - Returns full path without file extension             |
'  BROWSEFORFOLDERS : Returns the selected folder                       |
'  BROWSEFORFILE : Uses opendialog, returns file name                   |
'=======================================================================|

$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
    Result = 0

    IF FileName = "" THEN SHOWMESSAGE("FUNCTION SaveString. Wrong FileName=" + FileName) :EXIT FUNCTION
    DIM fileStr AS QFILESTREAM
    fileStr.Open(FileName , 65535)       'fmCreate'
    Result = - 1
    fileStr.WriteStr(ss$ , LEN(ss$))
    fileStr.Close
    Result = 1
END FUNCTION

      '-- *****************************************************'
FUNCTION SaveStringEx(ss$ AS STRING , FileName AS STRING , mode AS INTEGER) AS INTEGER
          'save string SS$ to file FileName.
          'Mode=0 - overwrite,
          'Mode=1 - append string ss$ to file FileName
          'Mode=2 - append  crlf+ss$ to file FileName

    Result = 0

    IF FileName = "" THEN SHOWMESSAGE("FUNCTION SaveString. Wrong FileName=" + FileName) :exit FUNCTION

    DIM fileStr AS QFILESTREAM

    IF mode = 0 THEN
        Result = 0
        fileStr.Open(FileName , 65535)       'fmCreate'
        Result = - 1
        fileStr.WriteStr(ss$ , LEN(ss$))
        fileStr.Close
    ELSEIF mode = 1 OR mode = 2 THEN
        DEFSTR crlf = ""
        DEFINT md = 65535                   'create new file
        IF FILEEXISTS(FileName) THEN        'else append
            md = 2                          'fmOpenReadWrite
            crlf = CHR$(13) + CHR$(10)    
        'ELSE
            'showmessage("FUNCTION SaveString. Can't open File=" + FileName) :exit FUNCTION
        END IF
        fileStr.Open(FileName , md)
        fileStr.Position = fileStr.Size
        Result = - 1
        IF mode = 1 THEN fileStr.WriteStr(ss$ , LEN(ss$)) ELSE fileStr.WriteStr(crlf + ss$ , LEN(crlf + ss$))
        fileStr.Close
    ELSE
    END IF
    Result = 1
END FUNCTION

      '-- *****************************************************'
FUNCTION LoadString(FileName AS STRING) AS STRING
    DIM fileStr AS QFILESTREAM
    Result = "0"
    IF fileStr.Open(FileName , 0) THEN        ''fmOpenRead
        Result = "-1"
        Result = fileStr.ReadStr(fileStr.Size)
        fileStr.Close
        'result=1
    END IF

END FUNCTION



'--------- Windows API call for functions below  -----------------
$IFNDEF __WIN32API                    
    DECLARE FUNCTION CharToOem LIB "user32" ALIAS "CharToOemA" _
        (ByVal lpszSrc AS STRING , ByVal lpszDst AS STRING) AS LONG
    
    DECLARE FUNCTION OemToChar LIB "user32" ALIAS "OemToCharA" _
        (ByVal lpszSrc AS STRING , ByVal lpszDst AS STRING) AS LONG
$ENDIF


      '-- *****************************************************'
FUNCTION MKSubDir(DirDst$) AS SHORT
          'Andrew Shelkovenko dec 2003, jul 2004
          'Create DirDst$ directory with full subdir structure
          '----------------------------------------------
          'print "MKSubDir DirDst$="; DirDst$
    Result = 0
    DEFSTR DirDst1$ = STRING$(LEN(DirDst$) , "a"), BkSl = "\", SubDirDst$
    'CharToOem DirDst$,DirDst1$
    DirDst1$ = DirDst$

    IF RIGHT$(DirDst1$ , 1) <> BkSl THEN DirDst1$ = DirDst1$ + BkSl
    DEFINT z1 = INSTR(DirDst1$ , BkSl)
    DEFINT z2 = 0
    WHILE z1 > 0
        SubDirDst$ = LEFT$(DirDst1$ , z1)
        IF DIREXISTS(SubDirDst$) = 0 THEN MKDIR SubDirDst$ :        'print "MKSubDir SubDirDst$=" ,SubDirDst$
        z2 = z1 + 1
        z1 = INSTR(z2 , DirDst1$ , BkSl)
    WEND

    Result = 1
END FUNCTION


    '-- *****************************************************'
    'Andrew Shelkovenko dec 2003
    'Copy DirSrc$ directory with full subdir structure and files (by mask$) to DirDst$
    '- -----------------------------------'
SUB SubDirCopy(DirSrc$ , DirDst$ , mask$)
    DIM FileSrc AS QFILESTREAM
    DIM FileDst AS QFILESTREAM

          'Index=0
    DEFINT NumFiles = 0, nsd1 = 0, nsd2 = 0, i
    DEFINT NumDir = 0, adddir, ArrNumDir = 500, ArrNumFil = 500
    DEFSTR mask = "*.*", BkSl = "\", SubDirname$, Fn$
    DIM SubDir(500) AS STRING
    DIM FileNames(500) AS STRING

    IF RIGHT$(DirSrc$ , 1) <> BkSl THEN DirSrc$ = DirSrc$ + BkSl
    IF RIGHT$(DirDst$ , 1) <> BkSl THEN DirDst$ = DirDst$ + BkSl
    SubDir(0) = DirSrc$

    sss1:
    FOR i = nsd1 TO nsd2        'current level sudirs'
        'print "374 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 "383 SubDir(", NumDir, ")=",SubDir(NumDir)
            ELSE
            END IF
            SubDirname$ = DIR$
            doevents
        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 sss1        '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
    DEFINT i1
    DEFSTR NewSubDir$
    FOR i1 = 0 TO i - 1
        NewSubDir$ = SubDir(i1) - DirSrc$
        NewSubDir$ = DirDst$ + NewSubDir$
        MKSubDir(NewSubDir$)
    NEXT i1

    DEFINT j
    DEFSTR NewFileName$
    FOR j = 1 TO NumFiles
        FileSrc.Open(FileNames(j) , fmOpenRead)
        IF FileSrc.Size = 0 THEN FileSrc.close: GOTO nextj1

        NewFileName$ = FileNames(j) - DirSrc$
        NewFileName$ = DirDst$ + NewFileName$
              'print "NewFileName$=" ,NewFileName$
        FileDst.Open(NewFileName$ , fmCreate)
        FileDst.CopyFrom(FileSrc , 0)       '
        FileSrc.Close        '
        FileDst.Close
        nextj1:
    NEXT j

END SUB

      '-- *****************************************************'
FUNCTION fSubDirCopy(DirSrc$ , DirDst$ , mask$) AS LONG        '- -----------------------------------'
          'Andrew Shelkovenko dec 2003
          'Copy DirSrc$ directory with full subdir structure and files (by mask$) to DirDst$
          'DiaMsg$="??? ?????ﮮ"

    DIM FileSrc AS QFILESTREAM
    DIM FileDst AS QFILESTREAM

    Result = - 1
          'Index=0
    
    DEFINT i, nsd1 = 0, nsd2 = 0, NumFiles = 0, NumDir = 0, addDir, ArrNumDir = 500, ArrNumFil = 500
    DEFSTR mask, BkSl = "\", SUBDIRNAME$, NewFileName$, NewFileName1$, DiaMsg$
    DIM SubDir(500) AS STRING
    DIM FileNames(500) AS STRING
    mask = "*.*"
    IF RIGHT$(DirSrc$ , 1) <> BkSl THEN DirSrc$ = DirSrc$ + BkSl
          'print "DirSrc$="; DirSrc$
    IF RIGHT$(DirDst$ , 1) <> BkSl THEN DirDst$ = DirDst$ + BkSl
          'print "DirDst$="; DirDst$

    SubDir(0) = DirSrc$

    sss1:
    FOR i = nsd1 TO nsd2        'current level sudirs'
              'print "374 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:        'DiaMsg$="?? ????? ????४?eg;ਨ "+SubDir(NumDir) 'SubDirname$
                SubDir(NumDir) = SubDir(i) + SubDirname$ + "\"
                      'print "383 SubDir(", NumDir, ")=",SubDir(NumDir)
                      'DiaMsg$="??????????? "+SubDir(NumDir) 'SubDirname$
            ELSE
            END IF
            SubDirname$ = DIR$
            doevents
        WEND

              'DiaMsg$="????????? " +str$(NumDir)

              'search files in current subdirectory
        DEFSTR 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:        'DiaMsg$=str$(NumFiles)
                FileNames(NumFiles) = SubDir(i) + Fn$
                      'print "FileNames(",NumFiles,")=" ,FileNames(NumFiles)
                      'DiaMsg$="??????? "+FileNames(NumFiles)
            ELSE
            END IF
            Fn$ = DIR$
        WEND
    NEXT i
    Result = - 2

    IF adddir > 0 THEN
        nsd1 = nsd2 + 1
        nsd2 = nsd2 + adddir
        adddir = 0
        GOTO sss1        '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

          'DiaMsg$="????????议. "
    DEFINT i1
    DEFSTR NewSubDir$
    FOR i1 = 0 TO i - 1
        NewSubDir$ = SubDir(i1) - DirSrc$
        NewSubDir$ = DirDst$ + NewSubDir$
        MKSubDir(NewSubDir$)
              'DiaMsg$="????????quot;+NewSubDir$
    NEXT i1
    Result = - 3

          'DiaMsg$="???? ??뮮."
    DEFINT j
    FOR j = 1 TO NumFiles
              'DiaMsg$="???? ?????렦quot;+FileNames(j)
              'DiaMsg$="Try to open file "+NewFileName$

        FileSrc.Open(FileNames(j) , fmOpenRead)
              'DiaMsg$="???蠦quot;+FileNames(j) +" ???=" +str$( FileSrc.size)
              'print "opened " +FileNames(j)

              'print "FileSrc.size=" ,FileSrc.size


        IF FileSrc.Size = 0 THEN
            FileSrc.close:
                  'print "zerosize closed " +FileNames(j):
            GOTO nextj
        END IF

        NewFileName1$ = FileNames(j) - DirSrc$
        NewFileName$ = DirDst$ + NewFileName1$

              'print "NewFileName$=" ,NewFileName$
              'DiaMsg$="???? ?????렦quot;+NewFileName1$
              'DiaMsg$="Try to create file "+NewFileName$

        FileDst.Open(NewFileName$ , fmCreate)
              'DiaMsg$="???? ???????렦quot; +FileNames(j) +" ⠦quot;+NewFileName1$
              'print "DiaMsg$=" ,DiaMsg$
              'DiaMsg$="Try to copy "

        FileDst.CopyFrom(FileSrc , 0)       '
        FileSrc.Close        '
        FileDst.Close
              'DiaMsg$="Copied "+str$(j) + " from "+ str$(NumFiles)+" = "+ NewFileName$
        DiaMsg$ = "????????⠦quot; + STR$(j) 'FileNames(j) ' + " ⠦quot; + NewFileName$

        nextj:
        DOEVENTS
    NEXT j

    Result = j - 1
          'DiaMsg$="???????? ???"+ str$(result) + " ? "+ str$(NumFiles)

END FUNCTION

      '-- ***********************************************************************'
FUNCTION DirCopy(DirSrc$ , DirDst$ , mask$) AS LONG
          'print "DirCopy mask$=" ,mask$
          'print "DirCopy DirDst$=" ,DirDst$
          'print "DirCopy DirSrc$=" ,DirSrc$
          'Andrew Shelkovenko dec 2003
          'Copy files (by mask$) from DirSrc$ to DirDst$
    Result = 0
    DIM FileSrc AS QFILESTREAM
    DIM FileDst AS QFILESTREAM
    DEFINT NumFIles
    NumFIles = 0
          'MKDIR DirDst$
    MKSubDir(DirDst$)
    IF RIGHT$(DirSrc$ , 1) <> "\" THEN DirSrc$ = DirSrc$ + "\"

    IF DIREXISTS(DirDst$) = 0 THEN
        SHOWMESSAGE("DirCopy Error: Can't create folder " + DirDst$)
        EXIT FUNCTION
    END IF
          'print "DirCopy DirSrc$+mask$=" ,DirSrc$+mask$

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

    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 NumFIles
    WEND
          'print "DirCopy copied= "+str$(NumFIles) +" files
    Result = NumFIles
END FUNCTION

      '-- ***********************************************************************'
SUB FileCopy(FileSrc$ , FileDst$)       '- -----------------------------------'
          'Andrew Shelkovenko dec 2003
          'Copy FileSrc$ to FileDst$
          'if path dest is not exists - create it.

    DIM FileSrc AS QFILESTREAM
    DIM FileDst AS QFILESTREAM

    DEFSTR dr$ = StripPath(FileDst$)
          'print "dr$=" ,dr$

          'MKDIR dr$ 'StripPath (FileDst$)

    IF dr$ <> "" THEN
        MKSubDir dr$
        IF DIREXISTS(dr$) = 0 THEN SHOWMESSAGE("FileCopy Can't create directory " + dr$) :        'exit sub
    END IF

    FileSrc.Open(FileSrc$ , fmOpenRead)
    FileDst.Open(FileDst$ , fmCreate)

    FileDst.CopyFrom(FileSrc , 0)
    FileSrc.Close
    FileDst.Close
          'print "FileCopy (";FileSrc$, FileDst$;") done"
END SUB

      '-- ***********************************************************************'
SUB KillFiles(FileName$)
          'Andrew Shelkovenko  diakin@narod.ru  apr 2004
          'Kill files in FileName$
          'for example KillFiles "C:\BAS\RAPIDQ\tmp\*.tmp"

    DEFSTR FName$ = StripPath(FileName$) + DIR$(FileName$ , 0)       '-- Get first file
          'print " -------------------  FName$=" ,FName$

    WHILE StripFileName(FName$) <> ""
        KILL FName$
              'print "killed FName$=" ,FName$

        IF FILEEXISTS(StripPath(FileName$) + FName$) > 0 THEN SHOWMESSAGE("KillFiles Can't kill file " + FName$)
              'print "Can't kill file "+FName$

        FName$ = StripPath(FileName$) + DIR$        '-- Get next file
    WEND
END SUB

      '-- *****************************************************'
SUB KillSubDir(DirSrc$ , mask$)       '- -----------------------------------'

          'print "-- KillSubDir DirSrc$=",DirSrc$

          'Andrew Shelkovenko diakin@narod.ru may 2004
          'Kill files by mask$ in all subdirs in DirSrc$ directory and kill all empty subdirs and DirSrc$ (if empty)
          'So.. if mask$="*.*" then  kill DirSrc$ with all subdirs and files

    DIM FileSrc AS QFILESTREAM

          'Index=0
    
    DEFINT i, nsd1 = 0 , nsd2 = 0, NumFIles = 0, NumDir = 0, adddir,ArrNumDir = 500, ArrNumFil = 500
    DEFSTR mask, BkSl = "\", SubDirname$, Fn$
    DIM SubDir(500) AS STRING
    DIM FileNames(500) AS STRING
    mask = "*.*"
    IF RIGHT$(DirSrc$ , 1) <> BkSl THEN SubDir(0) = DirSrc$ + BkSl ELSE SubDir(0) = DirSrc$
          'print "BkSl=" ,BkSl
          'print "SubDir(0)=" ,SubDir(0)
    s1:
    FOR i = nsd1 TO nsd2        'current level sudirs'
              'print "KillSubDir SubDir(",i,")=",SubDir(i)
        SubDirname$ = DIR$(SubDir(i) + mask , faDirectory)
              'print "-- KillSubDir SubDirname$=",SubDirname$	
        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 "--KillSubDir SubDir(", NumDir, ")=",SubDir(NumDir)
            ELSE
            END IF
            SubDirname$ = DIR$
            doevents
        WEND

              'search files in current subdirectory
        Fn$ = DIR$(SubDir(i) + mask$ , faAnyFile - faDirectory)       ':-)
        WHILE Fn$ <> ""
            IF Fn$ <> "." AND Fn$ <> ".." THEN        'and FileRec.Size <>0'
                KILL SubDir(i) + Fn$
                      'print "-- KillSubDir kill ",SubDir(i)+Fn$
            ELSE
            END IF
            Fn$ = DIR$
        WEND
    NEXT i

    IF adddir > 0 THEN
        nsd1 = nsd2 + 1
        nsd2 = nsd2 + adddir
        adddir = 0
        GOTO s1        'repeat with new sub level
    ELSE
    END IF

    DEFINT i1
    FOR i1 = i - 1 TO 1 STEP - 1
        RMDIR SubDir(i1)
              'print "-- KillSubDir RMDIR SubDir(",i1,")=", SubDir(i1)
    NEXT i1

END SUB

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

          '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
    DEFSTR 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
          'i.e
          '17.78091
          '16.64166
          '19.87037

          '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
    DEFSTR ValSrc$

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

    DEFINT ie = FileSourse.Size / 4, i

    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

      '-- ***********************************************************************'
SUB io2RndPV(fsrc$ , fdst$)
          '--------------------------------
          'convert text file with single value strings to binary
          'for example
          '17.78091
          '16.64166

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


      '-------------------------------------------------------------------'
      '-- ***********************************************************************'
FUNCTION ChDirOEM(PathDst$) AS SHORT
          'print "ChDirOEM PathDst$=" ,PathDst$
    Result = 0
    DIM PathDst1$ AS STRING
    PathDst1$ = STRING$(LEN(PathDst$) , "a")
    CharToOem PathDst$ , PathDst1$
          'print "ChDirOEM PathDst$=" ,PathDst$
          'print "ChDirOEM PathDst1$=" ,PathDst1$

    CHDIR PathDst1$
    Result = 1
END FUNCTION

      '-------------------------------------------------------------------'
      '-- ***********************************************************************'
FUNCTION MkDirOEM(PathDst$) AS SHORT
    Result = 0
    DIM PathDst1$ AS STRING
          'print "MkDirOEM PathDst$=" ,PathDst$
    PathDst1$ = STRING$(LEN(PathDst$) , "a")
    CharToOem PathDst$ , PathDst1$
          'print "MkDirOEM PathDst$=" ,PathDst$
          'print "MkDirOEM PathDst1$=" ,PathDst1$
    MKDIR PathDst1$
    Result = 1
END FUNCTION



      '-- **************************************************************************'
' FUNCTION DecToHex(DEC AS STRING) AS STRING
'     DEFDBL ost , ch
'     DEFSTR HexVal$
'     HexVal$ = ""
'     ost = 0: ch = 0
'     Dec# = VAL(DEC)
'     sign = SGN(Dec#)
'     Dec# = ABS(Dec#)
'     WHILE Dec# >= 16#
'         ch = FIX(Dec# / 16#)
'         ost = Dec# - ch * 16#
' 
'         Dec# = ch
'         SELECT CASE ost
'             CASE IS < 10
'                 Hexdig$ = STR$(ost)
'             CASE 10
'                 Hexdig$ = "A"
'             CASE 11
'                 Hexdig$ = "B"
'             CASE 12
'                 Hexdig$ = "C"
'             CASE 13
'                 Hexdig$ = "D"
'             CASE 14
'                 Hexdig$ = "E"
'             CASE 15
'                 Hexdig$ = "F"
'             CASE 15
'                 Hexdig$ = "10"
' 
'             CASE ELSE
'         END SELECT
' 
'         HexVal$ = Hexdig$ + HexVal$:
' 
'     WEND
' 
'     SELECT CASE Dec#
' 
'         CASE IS < 10
'             Hexdig$ = STR$(Dec#)
'         CASE 10
'             Hexdig$ = "A"
'         CASE 11
'             Hexdig$ = "B"
'         CASE 12
'             Hexdig$ = "C"
'         CASE 13
'             Hexdig$ = "D"
'         CASE 14
'             Hexdig$ = "E"
'         CASE 15
'             Hexdig$ = "F"
'         CASE 15
'             Hexdig$ = "10"
' 
'         CASE ELSE
'     END SELECT
' 
'     HexVal$ = Hexdig$ + HexVal$:
'     IF sign = - 1 THEN signn$ = "-" ELSE signn$ = ""
'     IF HexVal$ = "0" THEN HexVal$ = "00"
'     dectoHex = signn$ + HexVal$
' END FUNCTION

      '-- **************************************************************************'
FUNCTION AddChrBefore(NumStr AS STRING , Dlina AS INTEGER , chr AS STRING) AS STRING
          'Andrew Shelkovenko dec 2003
          'A function that pre-padd string with chr to required Length
          'print AddChrBefore("-387.35" , 10, "=")
          '==-0387.35

    DIM kolvo AS INTEGER
    kolvo = Dlina - LEN(NumStr)
    IF kolvo < 0 THEN AddChrBefore = "String too long"
    IF kolvo = 0 THEN AddChrBefore = NumStr: EXIT FUNCTION
    AddChrBefore = STRING$(kolvo , chr) + NumStr
END FUNCTION


      '-- **************************************************************************'
FUNCTION Add0Before(NumStr AS STRING , Dlina AS INTEGER) AS STRING
          'Andrew Shelkovenko dec 2003
          'A function that pre-padd string with 0's to required Length
          'print Add0Before("-387.35" , 8)
          '-0387.35

    DIM kolvo AS INTEGER
    kolvo = Dlina - LEN(NumStr)
    IF kolvo < 0 THEN Add0Before = "String too long"
    IF kolvo = 0 THEN Add0Before = NumStr: EXIT FUNCTION

    Add0Before	 = STRING$(kolvo , "0") + NumStr

END FUNCTION

      '-- **************************************************************************'
FUNCTION ByteReOrder(ByteStr$ , ReOrder$) AS STRING
          'Andrew Shelkovenko dec 2003
          'A function that reorder bytes in string.
          'ByteStr$ - Sourse string
          'ReOrder$ - new byte order

          'ReOrder$="21342"
          'old position - 2, new position - 1
          'old position - 1, new position - 2
          'old position - 3, new position - 3
          'old position - 4, new position - 4
          'old position - 2, new position - 5

    DEFINT LenB = LEN(ByteStr$), LenR = LEN(ReOrder$), i
    DEFSTR poz$, byt$, tmp$

    FOR i = 1 TO LenB
        poz$ = ReOrder$[i]
        IF VAL(poz$) > LenB THEN SHOWMESSAGE("ReOrder index outbound input string") :exit FUNCTION
        IF i <= LenR THEN
            byt$ = ByteStr$[val(poz$) ]
        ELSE
            byt$ = ByteStr$[i]
        END IF
        tmp$ = tmp$ + byt$
    NEXT
    ByteReOrder = tmp$
END FUNCTION

      '-- **************************************************************************'
FUNCTION CByteNum(ByteStr$ , Num_Type AS SHORT) AS VARIANT
          'Andrew Shelkovenko dec 2003
          'converts   number of Num_Type type to bytes sequence.
          'Num_Type can be next value:
          '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 M AS QMEMORYSTREAM
    SELECT CASE Num_Type
        CASE Num_BYTE
            SHOWMESSAGE "Can't to write BYTE.Wrong parameter type - Num_BYTE": EXIT FUNCTION
        CASE Num_SHORT: M.Write(ByteStr$) :m.Position = 0:CByteNum = M.ReadNum(Num_SHORT)
        CASE Num_WORD: M.Write(ByteStr$) :m.Position = 0:CByteNum = M.ReadNum(Num_WORD)
        CASE Num_LONG: M.Write(ByteStr$) :m.Position = 0:CByteNum = M.ReadNum(Num_LONG)
        CASE Num_DWORD: M.Write(ByteStr$) :m.Position = 0:CByteNum = M.ReadNum(Num_DWORD)
        CASE Num_SINGLE:M.Write(ByteStr$) :m.Position = 0:CByteNum = M.ReadNum(Num_SINGLE)
        CASE Num_DOUBLE:M.Write(ByteStr$) :m.Position = 0:CByteNum = M.ReadNum(Num_DOUBLE)

        CASE ELSE
            M.Write(ByteStr$) :m.Position = 0:CByteNum = M.ReadNum(Num_DOUBLE)
    END SELECT
    M.Close
END FUNCTION

      '-- **************************************************************************'
FUNCTION CNumByte(Num , Num_Type AS SHORT) AS STRING
          'Andrew Shelkovenko dec 2003

          'converts bytes sequence to  number of Num_Type type
          'Num_Type can be next value:
          '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 M AS QMEMORYSTREAM

    SELECT CASE Num_Type
        CASE Num_BYTE
            DIM N1 AS BYTE
            SHOWMESSAGE "Can't to write BYTE.Wrong parameter type - Num_BYTE": EXIT FUNCTION

        CASE Num_SHORT: DEFSHORT N2:N2 = Num:M.Write(N2) :M.Position = 0:CNumByte = M.ReadBinStr(SIZEOF(N2))
        CASE Num_WORD: DEFWORD N3:N3 = Num:M.Write(N3) :M.Position = 0:CNumByte = M.ReadBinStr(SIZEOF(N3))
        CASE Num_LONG: DEFLNG N4:N4 = Num:M.Write(N4) :M.Position = 0:CNumByte = M.ReadBinStr(SIZEOF(N4))
        CASE Num_DWORD: DEFDWORD N5:N5 = Num:M.Write(N5) :M.Position = 0:CNumByte = M.ReadBinStr(SIZEOF(N5))
        CASE Num_SINGLE:DEFSNG N6:N6 = Num:M.Write(N6) :M.Position = 0:CNumByte = M.ReadBinStr(SIZEOF(N6))
        CASE Num_DOUBLE:DEFDBL N7:N7 = Num:M.Write(N7) :M.Position = 0:CNumByte = M.ReadBinStr(SIZEOF(N7))

        CASE ELSE
            DIM N8 AS DOUBLE:N8 = Num:
            M.Write(N8) :
            M.Position = 0:CNumByte = M.ReadBinStr(SIZEOF(N8)) :M.Close
    END SELECT
    M.Close
END FUNCTION


      '-- **************************************************************************'

      'LIKE Function - pattern matching routine for Rapid-Q by William Yu
      'This emulates the VB LIKE operator.
      'Thanks to Thomas Binder for the original C code
      '
      '?   Any single character.
      '*   Zero or more characters.
      '#   Any single digit (0-9).
      '[charlist]  Any single character in charlist.
      '[!charlist] Any single character not in charlist.
      '
      'A group of one or more characters (charlist) enclosed in brackets ([ ])
      'can be used to match any single character in string and can include almost
      'any character code, including digits.
      '
      'Note:   To match the special characters left bracket ([), question
      'mark (?), number sign (#), and asterisk (*), enclose them in brackets.
      'The right bracket (]) can't be used within a group to match itself, but
      'it can be used outside a group as an individual character.
      '
      'By using a hyphen (-) to separate the upper and lower bounds of the range,
      'charlist can specify a range of characters. For example, [A-Z] results in
      'a match if the corresponding character position in string contains any
      'uppercase letters in the range A-Z. Multiple ranges are included within
      'the brackets without delimiters.


'CONST INVERT = "!"        '-- Some like ^ or ~ instead, whatever you want
      '-- **************************************************************************'
FUNCTION IsDigit(S AS STRING) AS INTEGER
    IF S >= "0" AND S <= "9" THEN
        IsDigit = 1
    ELSE
        IsDigit = 0
    END IF
END FUNCTION


      '-- **************************************************************************'
' FUNCTION Like(ParseString AS STRING , Pattern AS STRING) AS INTEGER
'     DIM prev AS INTEGER , matched AS INTEGER , reverse AS INTEGER
' 
'     WHILE Pattern <> ""
'         SELECT CASE MID$(Pattern , 1 , 1)
'             CASE "?"
'                 IF ParseString = "" THEN
'                     Like = 0
'                     EXIT FUNCTION
'                 END IF
'             CASE "#"
'                 IF IsDigit(MID$(ParseString , 1 , 1)) = 0 THEN
'                     Like = 0
'                     EXIT FUNCTION
'                 END IF
'             CASE "*"
'                 DO
'                     Pattern = MID$(Pattern , 2 , LEN(Pattern) - 1)
'                 LOOP UNTIL MID$(Pattern , 1 , 1) <> "*"
'                 IF Pattern = "" THEN
'                     Like = 1
'                     EXIT FUNCTION
'                 END IF
'                 WHILE ParseString <> ""
'                     IF Like(ParseString , Pattern) THEN
'                         Like = 1
'                         EXIT FUNCTION
'                     END IF
'                     IF ParseString <> "" THEN
'                         ParseString = MID$(ParseString , 2 , LEN(ParseString) - 1)
'                     END IF
'                 WEND
'                 Like = 0
'                 EXIT FUNCTION
'             CASE "["
'                 reverse =(MID$(Pattern , 2 , 1) = "!") 'INVERT)
'                 IF reverse THEN
'                     Pattern = MID$(Pattern , 2 , LEN(Pattern) - 1)
'                 END IF
'                 prev = 256: matched = 0
'                 DO
'                     Pattern = MID$(Pattern , 2 , LEN(Pattern) - 1)
'                     IF (Pattern <> "") AND (esc <> 0 OR MID$(Pattern , 1 , 1) <> "]") THEN
'                         IF MID$(Pattern , 1 , 1) = "-" THEN
'                             Pattern = MID$(Pattern , 2 , LEN(Pattern) - 1)
'                             IF Pattern = "" THEN
'                                 Like = 0
'                                 EXIT FUNCTION
'                             END IF
'                             matched = matched OR (MID$(ParseString , 1 , 1) <= MID$(Pattern , 1 , 1) AND ASC(MID$(ParseString , 1 , 1)) >= prev)
'                         ELSE
'                             matched = matched OR (MID$(ParseString , 1 , 1) = MID$(Pattern , 1 , 1))
'                         END IF
'                         prev = ASC(MID$(Pattern , 1 , 1))
'                     ELSE
'                         EXIT DO
'                     END IF
'                     esc = 0
'                 LOOP
'                 IF (prev = 256 OR MID$(Pattern , 1 , 1) <> "]" OR ABS(matched) = ABS(reverse)) THEN
'                     Like = 0
'                     EXIT FUNCTION
'                 END IF
'             CASE ELSE
'                 IF MID$(ParseString , 1 , 1) <> MID$(Pattern , 1 , 1) THEN
'                     Like = 0
'                     EXIT FUNCTION
'                 END IF
'         END SELECT
'         ParseString = MID$(ParseString , 2 , LEN(ParseString) - 1)
'         Pattern = MID$(Pattern , 2 , LEN(Pattern) - 1)
'     WEND
' 
'     Like = ABS(LEN(ParseString) = 0)
' END FUNCTION

      '-- Test code
      'print "Like('24','##')=", Like("24","##")

      '?"Like(aBBBa, a*a)=", Like("aBBBa","a*a")
      '?Like("F","[!A-Z]")
      '?Like("a2a","a#a")
      '?Like("aM5b","a[A-GL-P]#[!c-e]")
      '?Like("BAT123khg","B?T*")
      '?Like("CAT123khg","B?T*")

      '?Like("Combine(10, 20) = 30", "*(*?,*?)*=*#")
      '-- **************************************************************************'
FUNCTION SecTime(cTime$ AS STRING) AS INTEGER
    DEFINT TimeHH = VAL(FIELD$(cTime$ , ":" , 1))
    DEFINT TimeMM = VAL(FIELD$(cTime$ , ":" , 2))
    DEFINT TimeSS = VAL(FIELD$(cTime$ , ":" , 3))
    Result = TimeHH * 3600 + TimeMM * 60 + TimeSS
END FUNCTION


      '-- **************************************************************************'
FUNCTION DayDate(cDate$ AS STRING) AS INTEGER

    DEFINT MM = VAL(FIELD$(cDate$ , "-" , 1))
    DEFINT Day = VAL(FIELD$(cDate$ , "-" , 2))
    DEFINT Year = VAL(FIELD$(cDate$ , "-" , 3))

    Result = 365 *(Year) + 30 *(MM) +(Day)
END FUNCTION

      '-- **************************************************************************'
' FUNCTION TimeString(TimSec AS INTEGER) AS STRING
' 
'     Hr% = TimSec / 3600
'     SecMin = TimSec - Hr% * 3600
'     Min% =(SecMin) / 60
'     Sec% = SecMin - Min% * 60
' 
'     Hr$ = RIGHT$("0" + STR$(Hr%) , 2)
'     Min$ = RIGHT$("0" + STR$(Min%) , 2)
'     Sec$ = RIGHT$("0" + STR$(Sec%) , 2)
' 
'     TimeString = Hr$ + ":" + Min$ + ":" + Sec$ + "   "
' 
' END FUNCTION

      '-- *********************************************************************'
FUNCTION GetWord(Oper$ AS STRING , getV$ AS STRING) AS LONG
          'return variable  position in checked string
          'getV$ - variable name
          'Oper$ - checked string
          'if getV$ commented,  or quoted (just text, not varname)  - return error code
    Result = - 1        'error
    DEFSTR Lsep$ = "([=><, :+-*\/;"
    DEFSTR Rsep$ = ")]=><, :'+-*\/;"
    DEFSTR qt = CHR$(34)
    DEFINT Wpos, QPos1, QPos2, CPos

    Oper$ = LCASE$(Oper$)
    getV$ = LCASE$(getV$)


    Wpos = INSTR(Oper$ , getV$)
          'print "Wpos=" ,Wpos
    IF Wpos = 0 THEN Result = 0: EXIT FUNCTION        'pattern not contained
          'check comment and string

    WHILE Wpos > 0
              'print "Wpos=" ,Wpos
              'print "Wpos+len(getV$)=" ,Wpos+len(getV$)
              'print "len(Oper$)=" ,len(Oper$)

        IF (INSTR(Lsep$ , Oper$[Wpos - 1]) > 0 OR Wpos = 1) AND (INSTR(Rsep$ , Oper$[Wpos + LEN(getV$) ]) > 0 OR Wpos + LEN(getV$) - 1 = LEN(Oper$)) THEN
                  'check string
            QPos1 = rinstr(Wpos , Oper$ , qt)       '1 quote pos
                  'print "QPos1=" ,QPos1
            QPos2 = INSTR(Wpos , Oper$ , qt)       '2 quote pos
                  'print "QPos2=" ,QPos2
            CPos = rinstr(Wpos , Oper$ , "'")       'comment pos
                  'print "CPos=" ,CPos

            IF QPos1 < Wpos AND QPos2 > Wpos AND QPos1 > 0 THEN        'it's string, not var
            ELSEIF (CPos < Wpos AND CPos > 0) AND QPos1 < CPos THEN        'it's comment and QPos2>0
            ELSE
                Result = Wpos
                      'print "Wpos1=" ,Wpos
                EXIT WHILE
            END IF
        ELSE
        END IF
        Wpos = INSTR(Wpos + 1 , Oper$ , getV$)
              'print "Wpos2=" ,Wpos
        Result = - 2        'present, but not var
    WEND

END FUNCTION