BASFILE - Converts small files to BAS code.

Code: (Select All)

'=================

'BASFILE.BAS v0.25

'=================

'Coded by Dav for QB64PE 3.8, SEP/2023



'v0.25  - More friendly and purely dialog handled app now, no window.

'       - Added DIM line to output FUNCTION for OPTION _EXPLICIT users.

'       - Saves the encoded filename in output FUNCTION for information.



'======

'ABOUT :

'======



'BASFILE helps you include binary files INSIDE your QB64 compiled programs.

'It does this by converting file to BAS code that you add to your program

'that will recreate the file when you wish to use it.



'BASFILE will ask you for a file to convert, and will output the BAS code.



'=========================================================================



_ScreenMove _Middle: _ScreenHide



length& = 160 '<-- Length of data lines in output code. !! MUST BE DIV BY 4!!

'             Smaller number means shorter lines, but bigger output code.

'

'Make sure length& is divisble by 4.  If not, then adjust it so it is.

If length& Mod 4 <> 0 Then length& = length& - (length& Mod 4)

If length& < 4 Then length& = 4



cr$ = Chr$(13)

m$ = "BASFILE v.25 - Binary file to .BAS converter." + cr$ + cr$

m$ = m$ + "Converts a file to .BAS code to include in QB64 programs." + cr$

m$ = m$ + "BASFILE will first ask you for a file to convert, then it will" + cr$

m$ = m$ + "will ask you for a .BAS filename to create." + cr$ + cr$

m$ = m$ + "Proceed?"



If _MessageBox("BASFILE v.25", m$, "yesno", "question") = 0 Then System



IN$ = _OpenFileDialog$("Open File to encode...", "", "", "All files", -1)

If IN$ = "" Then

    _MessageBox "BASFILE v.25", "No file selected.  BASFILE will close.", "info"

    System

End If



m$ = "You selected: " + IN$ + cr$ + cr$

m$ = m$ + "Now select a .BAS filename to create."

_MessageBox "BASFILE v.25", m$, "info"



OUT$ = _SaveFileDialog$("Save Encoded file as ", "", "*.bas", "BAS files")

If OUT$ = "" Then

    _MessageBox "BASFILE v.25", "No filename given.  BASFILE will close.", "info"

    System

End If



m$ = "You have selected..." + cr$ + cr$

m$ = m$ + "Input file: " + IN$ + cr$

m$ = m$ + "Output file: " + OUT$ + cr$ + cr$

m$ = m$ + "Proceed?"



If _MessageBox("BASFILE v.25", m$, "yesno", "question") = 0 Then

    _MessageBox "BASFILE v.25", "Ok.  BASFILE will close.", "info"

    System

End If



'Grab whole file as a string

Open IN$ For Binary As 1

INDATA$ = (Input$(LOF(1), 1))



'Original size

OrigSize& = Len(INDATA$)



'Compress it

INDATA$ = _Deflate$(INDATA$)

CompSize& = Len(INDATA$)



Open OUT$ For Output As 2



INDATA$ = E$(INDATA$)



Q$ = Chr$(34) 'quotation mark

Print #2, "'==================================="

Print #2, "'EXAMPLE: SAVING BASFILE$ TO DISK"

Print #2, "'==================================="

Print #2, "'OPEN "; Q$; IN$; Q$; " FOR OUTPUT AS #1"

Print #2, "'PRINT #1, BASFILE$;"

Print #2, "'CLOSE #1"

Print #2, ""

Print #2, "Function BASFILE$()"

Print #2, "    'Returns decoded file as BASFILE$"

Print #2, "    'Encoded file: "; IN$

Print #2, "    DIM A$, c$, o$, btemp$, a&, j&, p&, oc&, i, i&, a, c&"

Print #2, "    A$ = SPACE$("; LTrim$(RTrim$(Str$(Len(INDATA$)))); "): a& = 1"

Print #2, "    Mid$(A$, a&, "; LTrim$(RTrim$(Str$(length&))); ") = "; Q$;



BC& = 1

Do

    a$ = Mid$(INDATA$, BC&, 4)

    BC& = BC& + 4: LL& = LL& + 4

    If LL& >= length& Then

        LL& = 0

        Print #2, a$;: Print #2, Q$; ": a& = a& + "; LTrim$(RTrim$(Str$(length&)))

        Print #2, "    Mid$(A$, a&, "; LTrim$(RTrim$(Str$(length&))); ") = "; Q$;

    Else

        Print #2, a$;

    End If

    If Len(INDATA$) - BC& < 4 Then

        a$ = Mid$(INDATA$, Len(INDATA$) - BC&, 1)

        a$ = a$ + Q$

        Print #2, a$;: Exit Do

    End If

Loop



Print #2, ""

Print #2, "    o$ = Space$("; LTrim$(RTrim$(Str$(CompSize&))); "): oc& = 1"

Print #2, "    For i = 39 To 125"

Print #2, "        If i <> 64 And i <> 96 Then c$ = c$ + Chr$(i)"

Print #2, "    Next: Dim v As _Unsigned Long"

Print #2, "    a = Val(Mid$(a$, 1, 1))"

Print #2, "    For i& = 2 To Len(a$) Step 5: v = 0"

Print #2, "        For j& = 0 To 4: p& = 85 ^ (4 - j&)"

Print #2, "            c& = InStr(c$, Mid$(a$, i& + j&, 1)) - 1"

Print #2, "        v = v + c& * p&: Next: Mid$(o$, oc&, 4) = MKL$(v)"

Print #2, "        oc& = oc& + 4"

Print #2, "    Next: btemp$ = Mid$(o$, 1, Len(o$) - a + 1)"

Print #2, "    BASFILE$ = _INFLATE$(btemp$, "; LTrim$(RTrim$(Str$(OrigSize&))); ")"

Print #2, "End Function"



_MessageBox "BASFILE v.25", OUT$ + " created!", "info"

System



Function E$ (in$)

    For i = 39 To 125 'Make 85 character set to use

        If i <> 64 And i <> 96 Then c$ = c$ + Chr$(i)

    Next

    Dim v As _Unsigned Long

    t$ = in$ 'make a working copy so in$ isn't changed

    If Len(t$) Mod 4 > 0 Then 'pad needed bytes on end

        a = 5 - Len(t$) Mod 4

        t$ = t$ + Space$(a - 1)

    End If

    out$ = Space$(Len(t$) * 1.25): outb& = 1

    For i& = 1 To Len(t$) Step 4

        v = CVL(Mid$(t$, i&, 4))

        For j& = 4 To 0 Step -1

            p& = 85 ^ j&

            r& = v \ p&

            v = v Mod p&

            Mid$(out$, outb&, 1) = Mid$(c$, r& + 1, 1)

            outb& = outb& + 1

        Next

    Next

    E$ = LTrim$(RTrim$(Str$(a))) + out$

End Function

Code: (Select All)

'an example program that uses Dav's Basfile





Print unpackstring$



thestring:

Data ""

Data "hailDQbC\H5:9e::AQ<cCQ4E8]<c9E5B>aLb9eDD8h4c]PLBE_BZX4mhU[lb"

Data "_L5lDQ4cEQlb74G##0PH%%L2"

Data "/END"

' i added /END as a flag, I use it a lot for reading string data of variable length with the read statment



Print BASFILE$



Function unpackstring$

    a$ = ""

    Restore thestring

    Do

        Read in$

        a$ = a$ + in$

    Loop Until InStr(in$, "/END") 'stop at the endflag for the flag

    a$ = Left$(a$, (Len(a$) - 4)) 'take the endflag out of the string

    btemp$ = ""

    For i& = 1 To Len(a$) Step 4: B$ = Mid$(a$, i&, 4)

        If InStr(1, B$, "%") Then

            For C% = 1 To Len(B$): F$ = Mid$(B$, C%, 1)

                If F$ <> "%" Then C$ = C$ + F$

            Next: B$ = C$: End If: For j = 1 To Len(B$)

            If Mid$(B$, j, 1) = "#" Then

        Mid$(B$, j) = "@": End If: Next

        For t% = Len(B$) To 1 Step -1

            B& = B& * 64 + Asc(Mid$(B$, t%)) - 48

            Next: X$ = "": For t% = 1 To Len(B$) - 1

            X$ = X$ + Chr$(B& And 255): B& = B& \ 256

    Next: btemp$ = btemp$ + X$: Next

    unpackstring$ = _Inflate$(btemp$): btemp$ = ""



End Function