Text Fetch Utility

new

« Prev
1
Next »

bplus
Global Moderator

b = b + ...

Posts: 798

Text Fetch Utility Nov 11, 2022 3:01:01 GMT

Quote

Post by bplus on Nov 11, 2022 3:01:01 GMT

Here is an InForm project I made a few years ago, might be handy for getting snatches of text from bas or txt files.

Update: oh this is a Windows Only app because of the way I am loading files and folders. Fellippe had direntry.h file included with InForm Projects folder? Or had I intended to modifify code for cross platform Files and Folders and I put the Direntry.h file in there? (doubt it). Let me check the other InForm projects...

I am curious if still works with current versions of QB64. It's working in my system. It uses 4 List boxes First 2 for navigating folders and selecting files.
3rd show files contents from which you can select a start and end line to copy a block of text to the Clipboard. Once it is showing in 4th List box, it's in you clipboard ready to paste where needed.

Option _Explicit 'Text Fetch.bas started b+ 2019-11-12 from other work with Dirs and Files loading

ReDim Shared Dir(0) As String, File(0) As String

': This program uses
': InForm - GUI library for QB64 - v1.0
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
': https://github.com/FellippeHeitor/InForm
'-----------------------------------------------------------

': Controls' IDs: ------------------------------------------------------------------
Dim Shared frmTextFetch As Long
Dim Shared lbCWD As Long
Dim Shared lbDirs As Long
Dim Shared ListDirs As Long
Dim Shared lbFiles As Long
Dim Shared ListFiles As Long
Dim Shared lbFile As Long
Dim Shared ListFile As Long
Dim Shared lbTxt As Long
Dim Shared ListTxt As Long
Dim Shared BtnStart As Long
Dim Shared BtnEnd As Long
Dim Shared lbStart As Long
Dim Shared lbEnd As Long
Dim Shared tmpDir As String '  establish a permanent spot for temp files

If Environ$("TEMP") <> "" Then 'Thanks to Steve McNeill use user temp files directory
    tmpDir = Environ$("TEMP")
ElseIf Environ$("TMP") <> "" Then
    tmpDir = Environ$("TMP")
Else 'Thanks to Steve McNeill this should be very unlikely
    If _DirExists("C:\temp") Then Else MkDir "C:\temp"
    tmpDir = "C:\temp"
End If

': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm\InForm.ui'
'$INCLUDE:'InForm\xp.uitheme'
'$INCLUDE:'Text Fetch.frm'

Sub loadText
    Dim i As Integer, b$, clip$
    ResetList ListTxt
    For i = Val(Caption(lbStart)) To Val(Caption(lbEnd))
        b$ = GetItem$(ListFile, i)
        AddItem ListTxt, GetItem$(ListFile, i)
        If clip$ = "" Then clip$ = b$ Else clip$ = clip$ + Chr$(13) + Chr$(10) + b$
    Next
    _Clipboard$ = clip$
    Caption(lbTxt) = "Selected Text (in Clipboard):"
End Sub

Sub loadDirsFilesList 'f or this form
    Dim i As Integer
    Caption(lbCWD) = "Current Directory: " + _CWD$
    loadDIR Dir()
    ResetList ListDirs
    For i = LBound(Dir) To UBound(Dir)
        AddItem ListDirs, Dir(i)
    Next
    loadFiles File()
    ResetList ListFiles
    For i = LBound(File) To UBound(File)
        AddItem ListFiles, File(i)
    Next
End Sub

'This SUB will take a given N delimited string, and delimiter$ and create an array of N+1 strings using the LBOUND of the given dynamic array to load.
'notes: the loadMeArray() needs to be dynamic string array and will not change the LBOUND of the array it is given.  rev 2019-08-27
Sub Split (SplitMeString As String, delim As String, loadMeArray() As String)
    Dim curpos As Long, arrpos As Long, LD As Long, dpos As Long 'fix use the Lbound the array already has
    curpos = 1: arrpos = LBound(loadMeArray): LD = Len(delim)
    dpos = InStr(curpos, SplitMeString, delim)
    Do Until dpos = 0
        loadMeArray(arrpos) = Mid$(SplitMeString, curpos, dpos - curpos)
        arrpos = arrpos + 1
        If arrpos > UBound(loadMeArray) Then ReDim _Preserve loadMeArray(LBound(loadMeArray) To UBound(loadMeArray) + 1000) As String
        curpos = dpos + LD
        dpos = InStr(curpos, SplitMeString, delim)
    Loop
    loadMeArray(arrpos) = Mid$(SplitMeString, curpos)
    ReDim _Preserve loadMeArray(LBound(loadMeArray) To arrpos) As String 'get the ubound correct
End Sub

Function fileStr$ (txtFile$)
    Dim rtn$
    If _FileExists(txtFile$) Then
        Open txtFile$ For Binary As #1
        rtn$ = Space$(LOF(1))
        Get #1, , rtn$
        Close #1
        fileStr$ = rtn$
    End If
End Function 'last line 317 + CRLF always added at end of .bas files

Sub loadDIR (fa() As String)
    Dim tmpFile As String, Index%, fline$, d$
    tmpFile = tmpDir + "\DIR$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
    Shell _Hide "DIR /a:d >" + tmpFile 'get directories  but have to do a little pruning
    Open tmpFile For Input As #1
    Index% = -1
    Do While Not EOF(1)
        Line Input #1, fline$
        If InStr(fline$, "<DIR>") Then
            d$ = _Trim$(rightOf$(fline$, "<DIR>"))
            Index% = Index% + 1
            ReDim _Preserve fa(Index%)
            fa(Index%) = d$
        End If
    Loop
    Close #1
    Kill tmpFile
End Sub

Sub loadFiles (fa() As String)
    Dim tmpFile As String, Index%
    tmpFile = tmpDir + "\FILE$INF0.INF" 'aha!, not a fully pathed file to user directory but here is good!
    Shell _Hide "DIR *.* /a:-d /b /o:-gen > " + tmpFile
    Open tmpFile$ For Input As #1
    Index% = -1
    Do While Not EOF(1)
        Index% = Index% + 1
        ReDim _Preserve fa(Index%) As String
        Line Input #1, fa(Index%)
    Loop
    Close #1
    Kill tmpFile$
End Sub

Function rightOf$ (source$, of$)
    If InStr(source$, of$) > 0 Then rightOf$ = Mid$(source$, InStr(source$, of$) + Len(of$))
End Function

': Event procedures: ---------------------------------------------------------------
Sub __UI_BeforeInit

End Sub

Sub __UI_OnLoad
    loadDirsFilesList
End Sub

Sub __UI_BeforeUpdateDisplay
    'This event occurs at approximately 30 frames per second.
    'You can change the update frequency by calling SetFrameRate DesiredRate%

End Sub

Sub __UI_BeforeUnload
    'If you set __UI_UnloadSignal = False here you can
    'cancel the user's request to close.

End Sub

Sub __UI_Click (id As Long)
    Dim dir$, fi$, fs$, i As Integer, value As Integer
    Select Case id
        Case frmTextFetch

        Case lbCWD

        Case lbDirs

        Case ListDirs
            dir$ = GetItem$(ListDirs, Control(ListDirs).Value)
            If _DirExists(dir$) Then
                ChDir dir$
                Caption(lbCWD) = "Current Directory: " + _CWD$
                loadDirsFilesList
            End If

        Case lbFiles

        Case ListFiles
            fi$ = GetItem$(ListFiles, Control(ListFiles).Value)
            If _FileExists(fi$) Then
                fs$ = fileStr$(fi$)
                ReDim fa$(0)
                Split fs$, Chr$(13) + Chr$(10), fa$()
                ResetList ListFile
                For i = LBound(fa$) To UBound(fa$)
                    AddItem ListFile, fa$(i)
                Next
                'clear
                Caption(lbStart) = "Line Start"
                Caption(lbEnd) = "Line End"
                Caption(lbFile) = "Selected File: Path = " + _CWD$ + ",  Name = " + fi$
            End If

        Case lbFile

        Case ListFile

        Case lbTxt

        Case ListTxt

        Case BtnStart
            value = Control(ListFile).Value
            Caption(lbStart) = Str$(value) + " Start Line"
            If Val(Caption(lbStart)) - Val(Caption(lbEnd)) > 0 Then loadText

        Case BtnEnd
            value = Control(ListFile).Value
            Caption(lbEnd) = Str$(value) + " End Line"
            If Val(Caption(lbEnd)) - Val(Caption(lbStart)) > 0 Then loadText

        Case lbStart

        Case lbEnd

    End Select
End Sub

Sub __UI_MouseEnter (id As Long)
    Select Case id
        Case frmTextFetch

        Case lbCWD

        Case lbDirs

        Case ListDirs

        Case lbFiles

        Case ListFiles

        Case lbFile

        Case ListFile

        Case lbTxt

        Case ListTxt

        Case BtnStart

        Case BtnEnd

        Case lbStart

        Case lbEnd

    End Select
End Sub

Sub __UI_MouseLeave (id As Long)
    Select Case id
        Case frmTextFetch

        Case lbCWD

        Case lbDirs

        Case ListDirs

        Case lbFiles

        Case ListFiles

        Case lbFile

        Case ListFile

        Case lbTxt

        Case ListTxt

        Case BtnStart

        Case BtnEnd

        Case lbStart

        Case lbEnd

    End Select
End Sub

Sub __UI_FocusIn (id As Long)
    Select Case id
        Case ListDirs

        Case ListFiles

        Case ListFile

        Case ListTxt

        Case BtnStart

        Case BtnEnd

    End Select
End Sub

Sub __UI_FocusOut (id As Long)
    'This event occurs right before a control loses focus.
    'To prevent a control from losing focus, set __UI_KeepFocus = True below.
    Select Case id
        Case ListDirs

        Case ListFiles

        Case ListFile

        Case ListTxt

        Case BtnStart

        Case BtnEnd

    End Select
End Sub

Sub __UI_MouseDown (id As Long)
    Select Case id
        Case frmTextFetch

        Case lbCWD

        Case lbDirs

        Case ListDirs

        Case lbFiles

        Case ListFiles

        Case lbFile

        Case ListFile

        Case lbTxt

        Case ListTxt

        Case BtnStart

        Case BtnEnd

        Case lbStart

        Case lbEnd

    End Select
End Sub

Sub __UI_MouseUp (id As Long)
    Select Case id
        Case frmTextFetch

        Case lbCWD

        Case lbDirs

        Case ListDirs

        Case lbFiles

        Case ListFiles

        Case lbFile

        Case ListFile

        Case lbTxt

        Case ListTxt

        Case BtnStart

        Case BtnEnd

        Case lbStart

        Case lbEnd

    End Select
End Sub

Sub __UI_KeyPress (id As Long)
    'When this event is fired, __UI_KeyHit will contain the code of the key hit.
    'You can change it and even cancel it by making it = 0
    Select Case id
        Case ListDirs

        Case ListFiles

        Case ListFile

        Case ListTxt

        Case BtnStart

        Case BtnEnd

    End Select
End Sub

Sub __UI_TextChanged (id As Long)
    Select Case id
    End Select
End Sub

Sub __UI_ValueChanged (id As Long)
    Select Case id
        Case ListDirs

        Case ListFiles

        Case ListFile

        Case ListTxt

    End Select
End Sub

Sub __UI_FormResized

End Sub

'==============================================  Failed Again! but took longer this time =============================================

Sub loadDirsFilesList_BLAHHHHHHHHHHHHHHH 'modified Steve's that uses
    'Below needed for Steves load dirs and files which fails ????? for some strange reason
    ''''this needs to be somewhere QB64 can find, I have direntry.h in file folder as well as QB64.exe root
    Declare CustomType Library "direntry"
        Function load_dir& (s As String)
        Function has_next_entry& ()
        Sub close_dir ()
        Sub get_next_entry (s As String, flags As Long, file_size As Long)
    End Declare

    Dim nDirs As Integer, i As Integer, cntTrys As Integer
    Caption(lbCWD) = "Current Directory: " + _CWD$
    While nDirs = 0
        ReDim Dir(0), File(0)
        nDirs = GetCurDirLists(Dir(), File())
        cntTrys = cntTrys + 1
        _Delay .1
        If cntTrys > 100 Then Exit Sub
    Wend
    ResetList ListDirs
    For i = LBound(Dir) To UBound(Dir)
        AddItem ListDirs, Dir(i)
    Next
    ResetList ListFiles
    For i = LBound(File) To UBound(File)
        AddItem ListFiles, File(i)
    Next
End Sub

' once again this thing from Steve fails, this time it got further than with my other test
Function GetCurDirLists% (DirList() As String, FileList() As String)
    Dim DirCount As Integer, FileCount As Integer, lengtht As Long, nam$, d$
    Dim flags As Long, file_size As Long

    ReDim _Preserve DirList(100), FileList(100)
    DirCount = 0: FileCount = 0
    d$ = _CWD$
    If load_dir(d$) Then
        Do
            lengtht = has_next_entry
            If lengtht > -1 Then
                nam$ = Space$(lengtht)
                get_next_entry nam$, flags, file_size
                'IF (flags AND 1) OR _DIREXISTS(d$ + nam$) THEN
                If (flags And 1) Then
                    DirCount = DirCount + 1
                    If DirCount > UBound(DirList) Then ReDim _Preserve DirList(UBound(DirList) + 100)
                    DirList(DirCount) = nam$
                    'ELSEIF (flags AND 2) OR _FILEEXISTS(d$ + nam$) THEN
                ElseIf (flags And 2) Then
                    FileCount = FileCount + 1
                    If FileCount > UBound(FileList) Then ReDim _Preserve FileList(UBound(FileList) + 100)
                    FileList(FileCount) = nam$
                End If
            End If
        Loop Until lengtht = -1
        close_dir
    Else
    End If
    ReDim _Preserve DirList(DirCount)
    ReDim _Preserve FileList(FileCount)
    GetCurDirLists% = DirCount
End Function

Attached Project file with h files needed for the project in zip oops need to update v2 Functions in zip.

Oh a screen shot:

Clipboard contents:

Sub loadText
    Dim i As Integer, b$, clip$
    ResetList ListTxt
    For i = Val(Caption(lbStart)) To Val(Caption(lbEnd))
        b$ = GetItem$(ListFile, i)
        AddItem ListTxt, GetItem$(ListFile, i)
        If clip$ = "" Then clip$ = b$ Else clip$ = clip$ + Chr$(13) + Chr$(10) + b$
    Next
    _Clipboard$ = clip$
    Caption(lbTxt) = "Selected Text (in Clipboard):"
End Sub

update: Just checked the downloaded zip and seems to be working fine.

Attachments:

Text Fetch pkg.zip (87.42 KB)

Last Edit: Nov 11, 2022 3:45:25 GMT by bplus

Cheers! to the stars of Basic where ever they shine!

bplus
Global Moderator

b = b + ...

Posts: 798

Text Fetch Utility Nov 11, 2022 4:06:08 GMT

Quote

Post by bplus on Nov 11, 2022 4:06:08 GMT

Hmm... looks like I added the Direntry.h file to folder because it looks like Fellippe had a differnent File and Folder method, see here his Executor

': This program was generated by
': InForm - GUI system for QB64 - Beta version 6
': Fellippe Heitor, 2016/2018 - fellippe@qb64.org - @fellippeheitor
'-----------------------------------------------------------

': Controls' IDs: ------------------------------------------------------------------
Dim Shared Executar As Long
Dim Shared PictureBox3 As Long
Dim Shared Icon300pxpngPX As Long
Dim Shared TypeTheNameOfAProgramFolderDoLB As Long
Dim Shared OpenLB As Long
Dim Shared ResourceTB As Long
Dim Shared uacicon200x200pngPX As Long
Dim Shared ThisTaskWillBeCreatedWithAdminisLB As Long
Dim Shared OKBT As Long
Dim Shared CancelBT As Long
Dim Shared BrowseBT As Long


'Code for default file dialog courtesy of Jobert14
'http://qb64.org/wiki/Windows_Libraries#File_Open_and_Save_Dialog
Const OFN_ALLOWMULTISELECT = &H200& '  Allows the user to select more than one file, not recommended!
Const OFN_CREATEPROMPT = &H2000& '     Prompts if a file not found should be created(GetOpenFileName only).
Const OFN_EXTENSIONDIFFERENT = &H400& 'Allows user to specify file extension other than default extension.
Const OFN_FILEMUSTEXIST = &H1000& '    Chechs File name exists(GetOpenFileName only).
Const OFN_HIDEREADONLY = &H4& '        Hides read-only checkbox(GetOpenFileName only)
Const OFN_NOCHANGEDIR = &H8& '         Restores the current directory to original value if user changed
Const OFN_NODEREFERENCELINKS = &H100000& 'Returns path and file name of selected shortcut(.LNK) file instead of file referenced.
Const OFN_NONETWORKBUTTON = &H20000& ' Hides and disables the Network button.
Const OFN_NOREADONLYRETURN = &H8000& ' Prevents selection of read-only files, or files in read-only subdirectory.
Const OFN_NOVALIDATE = &H100& '        Allows invalid file name characters.
Const OFN_OVERWRITEPROMPT = &H2& '     Prompts if file already exists(GetSaveFileName only)
Const OFN_PATHMUSTEXIST = &H800& '     Checks Path name exists (set with OFN_FILEMUSTEXIST).
Const OFN_READONLY = &H1& '            Checks read-only checkbox. Returns if checkbox is checked
Const OFN_SHAREAWARE = &H4000& '       Ignores sharing violations in networking
Const OFN_SHOWHELP = &H10& '           Shows the help button (useless!)
'--------------------------------------------------------------------------------------------

DefInt A-Z
Type FILEDIALOGTYPE
    lStructSize As Long '        For the DLL call
    hwndOwner As Long '          Dialog will hide behind window when not set correctly
    hInstance As Long '          Handle to a module that contains a dialog box template.
    lpstrFilter As _Offset '     Pointer of the string of file filters
    lpstrCustFilter As _Offset
    nMaxCustFilter As Long
    nFilterIndex As Long '       One based starting filter index to use when dialog is called
    lpstrFile As _Offset '       String full of 0's for the selected file name
    nMaxFile As Long '           Maximum length of the string stuffed with 0's minus 1
    lpstrFileTitle As _Offset '  Same as lpstrFile
    nMaxFileTitle As Long '      Same as nMaxFile
    lpstrInitialDir As _Offset ' Starting directory
    lpstrTitle As _Offset '      Dialog title
    flags As Long '              Dialog flags
    nFileOffset As Integer '     Zero-based offset from path beginning to file name string pointed to by lpstrFile
    nFileExtension As Integer '  Zero-based offset from path beginning to file extension string pointed to by lpstrFile.
    lpstrDefExt As _Offset '     Default/selected file extension
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As _Offset
End Type

Declare Dynamic Library "comdlg32" ' Library declarations using _OFFSET types
    Function GetOpenFileNameA& (DIALOGPARAMS As FILEDIALOGTYPE) ' The Open file dialog
    Function GetSaveFileNameA& (DIALOGPARAMS As FILEDIALOGTYPE) ' The Save file dialog
End Declare

': External modules: ---------------------------------------------------------------
'$INCLUDE:'InForm\InForm.ui'
'$INCLUDE:'InForm\xp.uitheme'
'$INCLUDE:'Executar.frm'

': Event procedures: ---------------------------------------------------------------
SUB __UI_BeforeInit

END SUB

SUB __UI_OnLoad
    __UI_Focus = ResourceTB
    __UI_DefaultButtonID = OKBT
END SUB

SUB __UI_BeforeUpdateDisplay

END SUB

SUB __UI_BeforeUnload

END SUB

SUB __UI_Click (id AS LONG)
    SELECT CASE id
        CASE Executar

        CASE PictureBox3

        CASE Icon300pxpngPX

        CASE TypeTheNameOfAProgramFolderDoLB

        CASE OpenLB

        CASE ResourceTB

        CASE uacicon200x200pngPX

        CASE ThisTaskWillBeCreatedWithAdminisLB

        CASE OKBT
            SHELL _DONTWAIT Text(ResourceTB)
            SYSTEM
        CASE CancelBT
            SYSTEM
        CASE BrowseBT
            Filter$ = "Batch files (*.bat)|*.BAT|Executable files (*.com)|*.COM|Executable files (*.exe)|*.EXE|All files (*.*)|*.*" + CHR$(0)
            Flags& = OFN_FILEMUSTEXIST + OFN_EXTENSIONDIFFERENT + OFN_NOCHANGEDIR '    add flag constants here
            hWnd& = _WINDOWHANDLE
            OFile$ = GetOpenFileName$(".\", Filter$, 3, Flags&, hWnd&)

            IF LEN(OFile$) THEN Text(ResourceTB) = OFile$
    END SELECT
END SUB

SUB __UI_MouseEnter (id AS LONG)
    SELECT CASE id
        CASE Executar

        CASE PictureBox3

        CASE Icon300pxpngPX

        CASE TypeTheNameOfAProgramFolderDoLB

        CASE OpenLB

        CASE ResourceTB

        CASE uacicon200x200pngPX

        CASE ThisTaskWillBeCreatedWithAdminisLB

        CASE OKBT

        CASE CancelBT

        CASE BrowseBT

    END SELECT
END SUB

SUB __UI_MouseLeave (id AS LONG)
    SELECT CASE id
        CASE Executar

        CASE PictureBox3

        CASE Icon300pxpngPX

        CASE TypeTheNameOfAProgramFolderDoLB

        CASE OpenLB

        CASE ResourceTB

        CASE uacicon200x200pngPX

        CASE ThisTaskWillBeCreatedWithAdminisLB

        CASE OKBT

        CASE CancelBT

        CASE BrowseBT

    END SELECT
END SUB

SUB __UI_FocusIn (id AS LONG)
    SELECT CASE id
        CASE ResourceTB

        CASE OKBT

        CASE CancelBT

        CASE BrowseBT

    END SELECT
END SUB

SUB __UI_FocusOut (id AS LONG)
    SELECT CASE id
        CASE ResourceTB

        CASE OKBT

        CASE CancelBT

        CASE BrowseBT

    END SELECT
END SUB

SUB __UI_MouseDown (id AS LONG)
    SELECT CASE id
        CASE Executar

        CASE PictureBox3

        CASE Icon300pxpngPX

        CASE TypeTheNameOfAProgramFolderDoLB

        CASE OpenLB

        CASE ResourceTB

        CASE uacicon200x200pngPX

        CASE ThisTaskWillBeCreatedWithAdminisLB

        CASE OKBT

        CASE CancelBT

        CASE BrowseBT

    END SELECT
END SUB

SUB __UI_MouseUp (id AS LONG)
    SELECT CASE id
        CASE Executar

        CASE PictureBox3

        CASE Icon300pxpngPX

        CASE TypeTheNameOfAProgramFolderDoLB

        CASE OpenLB

        CASE ResourceTB

        CASE uacicon200x200pngPX

        CASE ThisTaskWillBeCreatedWithAdminisLB

        CASE OKBT

        CASE CancelBT

        CASE BrowseBT

    END SELECT
END SUB

SUB __UI_KeyPress (id AS LONG)
    SELECT CASE id
        CASE ResourceTB

        CASE OKBT

        CASE CancelBT

        CASE BrowseBT

    END SELECT
END SUB

SUB __UI_TextChanged (id AS LONG)
    SELECT CASE id
        CASE ResourceTB

    END SELECT
END SUB

SUB __UI_ValueChanged (id AS LONG)
    SELECT CASE id
    END SELECT
END SUB

SUB __UI_FormResized

END SUB

FUNCTION GetOpenFileName$ (InitialDir$, Filter$, FilterIndex, Flags&, hWnd&)
    '  InitialDir$ - If this left blank, it will use the directory where the last opened file is
    '  located. Specify ".\" if you want to always use the current directory.
    '  Filter$     - File filters separated by pipes (|) in the same format as using VB6 common dialogs.
    '  FilterIndex - The initial file filter to use. Will be altered by user during the call.
    '  Flags&      - Dialog flags. Will be altered by the user during the call.
    '  hWnd&       - Your program's window handle that should be aquired by the FindWindow function.
    '
    ' Returns: Blank when cancel is clicked otherwise, the file name selected by the user.
    ' FilterIndex and Flags& will be changed depending on the user's selections.

    DIM OpenCall AS FILEDIALOGTYPE ' Needed for dialog call

    fFilter$ = Filter$
    FOR R = 1 TO LEN(fFilter$) ' Replace the pipes with character zero
        IF MID$(fFilter$, R, 1) = "|" THEN MID$(fFilter$, R, 1) = CHR$(0)
    NEXT R
    fFilter$ = fFilter$ + CHR$(0)

    lpstrFile$ = STRING$(2048, 0) ' For the returned file name
    lpstrDefExt$ = STRING$(10, 0) ' Extension will not be added when this is not specified
    OpenCall.lStructSize = LEN(OpenCall)
    OpenCall.hwndOwner = hWnd&
    OpenCall.lpstrFilter = _OFFSET(fFilter$)
    OpenCall.nFilterIndex = FilterIndex
    OpenCall.lpstrFile = _OFFSET(lpstrFile$)
    OpenCall.nMaxFile = LEN(lpstrFile$) - 1
    OpenCall.lpstrFileTitle = OpenCall.lpstrFile
    OpenCall.nMaxFileTitle = OpenCall.nMaxFile
    OpenCall.lpstrInitialDir = _OFFSET(InitialDir$)
    Title$ = "Browse..." + CHR$(0)
    OpenCall.lpstrTitle = _OFFSET(Title$)
    OpenCall.lpstrDefExt = _OFFSET(lpstrDefExt$)
    OpenCall.flags = Flags&

    Result = GetOpenFileNameA&(OpenCall) '            Do Open File dialog call!

    IF Result THEN ' Trim the remaining zeros
        GetOpenFileName$ = LEFT$(lpstrFile$, INSTR(lpstrFile$, CHR$(0)) - 1)
        Flags& = OpenCall.flags
        FilterIndex = OpenCall.nFilterIndex
    END IF

END FUNCTION

This was nice little program for browsing and running but doesn't work on my current system.

Last Edit: Nov 11, 2022 4:15:00 GMT by bplus

Cheers! to the stars of Basic where ever they shine!

bplus
Global Moderator

b = b + ...

Posts: 798

Text Fetch Utility Nov 11, 2022 18:48:44 GMT

Quote

Post by bplus on Nov 11, 2022 18:48:44 GMT

Update: I decided to test this with this forum's version of QB64 v2.1

So for Text Fetch to work you have to copy the Falcon.h file AND the Direntry.h file into the Folder your QB64 exe version is at.

Text Fetch doesn't even use the DirEntry method of getting file and folder lists because it's wasn't working at the time of testing Text Fetch code.
If that code were commented out the direntry.h file probably wouldn't be needed in QB64 exe folder.

I am having no difficulty reading text or text size with v 2.1 2022-09-08-07-14-00 blah bah balh (can you make the version number longer? ;-))

Last Edit: Nov 11, 2022 18:55:36 GMT by bplus

Cheers! to the stars of Basic where ever they shine!