Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Postit Self Extractor

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Postit Self Extractor

    ' moved here on behalf of the original poster, thomas gohel
    ' see http://www.powerbasic.com/support/pb...ead.php?t=1036
    [CODE]
    $compile exe

    defint a-z

    '--- postit! subroutines.
    declare sub parsecmdline (cmd$, params$(), found%)
    declare sub seppath (a$, drive$, path$, tname$)
    declare function decode% (oswitch%, inspec$, outspec$)
    declare function encode% (op%, iswitch%, cswitch%, aswitch%, tswitch%, sswitch%, pswitch%, lswitch%, oswitch%, bswitch%, inspec$, outspec$)
    declare sub expandline (a$, lines$(), linelength%, numlines%)
    declare function fasc% (a$)
    declare function grabnum& (a$, lower&, upper&, default&)
    declare function untab$ (b$, tabstops%)

    '--- importit! subroutines.
    declare sub importit (bbsid$, msgfiles$(), toname$, fromname$,_
    titlefile$, conference%)
    declare sub createrep (bbsid$, arccommand$)
    declare sub addtorep (bbsid$, msgfiles$(), toname$, fromname$, titlefile$, conference%, errorcode$)
    declare sub iiparse (cmd$, toname$, fromname$, conference%, bbsid$)

    '
    ' --- beta test release --- released by calvin french, august 1993 ---
    '
    ' this should work perfectly. please test it, tangle it, and report any
    ' bugs you find in it to victor, me, or (lastly only because he is very
    ' very busy), rich.
    '
    ' - calvin -
    '
    ' --------------------------------------------------------------------
    '
    ' postit! v7.2 script encoder/decoder-public domain-august 1993
    ' by rich geldreich & victor yiu. many contributions, fixups, and
    ' features by mark h. butler, quinn tyler jackson, and scott wunsch.
    ' qwk compatable .rep file support by calvin french.
    '
    ' postit! can encode any binary file into a series of self-
    ' extracting script files that can be reliably distributed on
    ' text-only conferences or networks. the script files can be
    ' extracted with this program, or with any microsoft quickbasic
    ' language (dos 5's qbasic, qb4.5, pds, vb-dos) because each script
    ' contains its own small quickbasic decoder.
    '
    ' postit! can also format quickbasic source code suitable for
    ' distribution on conferences, and reconstruct source code formatted
    ' by this program. this allows quickbasic programmers to easily
    ' exchange basic source code without worrying about the annoying line
    ' length and message limitations of most networks.
    '
    ' importit!, a new part of postit!, can toss the output files created
    ' by postit! into a qwk compatable .rep file.
    '
    ' new 7.2 features:
    '
    ' o qwk compatable .rep file support has been included! no more
    ' importing tons of files into your reply packets via your offline
    ' mail reader!
    '
    ' new 7.1 features:
    '
    ' o totally rewritten source code!
    ' o much more efficient encoding algorithm (mod 86 encoding) with
    ' a smaller and faster self extractor!
    ' o huge binary scripts now supported, up to 150k!
    ' o the script decoding & unfiltering functions are now automated!
    ' as long as a few simple rules are followed (see the notes on
    ' the decode command), no user intervention is needed to extract
    ' multiple scripts from the same capture file.
    ' o postit! is finally a command line utility! error codes can be
    ' returned to batch files if you're compiling with vbdos or
    ' qbx. look at the source to find out which error code means
    ' which.
    ' o the format of postit!'s message headers has finally been well
    ' thought out and (hopefully) finalized. although compatibility
    ' with previous versions of postit! has been sacrificed, scripts
    ' created by newer versions of postit! should be decodable by
    ' this version because of a common message header format.
    '
    ' explanation of commands
    '
    ' e = encodes any binary file less than 150k into a self-extracting
    ' text-only script. if the -s option is used with this command,
    ' the entire script will be written to one output file; otherwise
    ' the script will be split into multiple output files, where each
    ' output file contains one message. (note: scripts created by
    ' this command cannot be extracted by previous versions of
    ' postit!.)
    '
    ' f = filters quickbasic source code for posting on a conference.
    ' this command actually performs two filtering functions. it
    ' splits very long lines with continuation characters (special
    ' precautions are taken to ensure quoted strings and remarks are
    ' split correctly), and chops the source code into multiple files
    ' so each file corresponds to one message (unless the -s option
    ' is used).the filtered file can still be executed or compiled by
    ' quickbasic, just as the original could. (note: data statements
    ' split by filtering cannot be unsplit correctly by qb! this will
    ' hopefully be fixed soon... files filtered by this command
    ' cannot by unfiltered by previous versions of postit!.)
    '
    ' d = decodes binary/text scripts. multiple scripts can be decoded
    ' from the same input file with this function. the decoding
    ' algorithm automatically decides which method was used to
    ' encode the source file(binary script or source code filtering).
    '
    ' if any errors are encountered during decoding the script is
    ' skipped and the partly decoded file is deleted.
    '
    ' binary and text scripts created by previous versions of postit!
    ' cannot be decoded with this command, because of the new header
    ' format employed by this version of postit!.
    '
    ' (notes: pages of a script must appear in increasing order. in
    ' other words, page 2 must follow page 1, page 3 must follow page
    ' 2, etc. when posting files created by the e or f commands,
    ' don't modify or remove the message headers because the decoding
    ' algorithm expects these to indicate the beginning and ending of
    ' each page. (all message headers begin with a "'>>>" sequence.)
    ' finally, if an output file is specified on the command line,
    ' for example "postit d capture.txt c:\q\coolcode.zip", only the
    ' specified output file (coolcode.zip in the example) will be
    ' decoded if its script can be located. the pathname of the
    ' output file will be the destination path specified on the
    ' command line. in the example, the file coolcode.zip will be
    ' written to the c:\q directory.)
    '
    ' -q this switch will cause postit! to invoke importit!, a new
    ' feature available with version 7.2. importit! will toss all the
    ' files that postit! creates into a qwk compatable reply packet
    ' (.rep file.) you must specify at least three more paramaters
    ' for this capability, however. they are:
    '
    ' [to:to_name] (optional)
    ' this is the name that you would like in the "to" field (who you
    ' are sending the message to.) if it is not specified, importit!
    ' will substitute the name "all".
    '
    ' from:from_name
    ' this is the name that you would like in the "from" field (which
    ' is, more often than not, your own name)
    '
    ' note: with both names, if a space is needed, use a period in
    ' the command line (e.g., to:victor.yiu from:calvin.french) and
    ' importit! will translate it to a space.
    '
    ' conf:conf_number
    ' this is the number of the fidonet echomail conference that you
    ' would like the the messages to be tossed into. this is really
    ' the only very important thing you need to remember in order to
    ' use importit! note: this is not the name of the echomail
    ' conference (e.g., quik_bas), but rather the number (e.g., 32).
    ' it should also be mentioned that sometimes this number is not
    ' the same number as may appear on your bbs's message base list.
    ' it is suggested that you check this number carefully via your
    ' offline mail reader as the wrong number will toss all the
    ' messages into the wrong area.
    '
    ' bbsid:bbsid
    ' this is the bbs identification name of the bbs you will be
    ' uploading your reply packet to. according to the naming
    ' conventions outlined in the qwk format (version 1.6), this will
    ' be the file name (not including the extention) of your .qwk and
    ' .rep file (qwk mail packet and reply packet). importit! will
    ' use this name to access the reply packet, so it is important to
    ' get it right.
    '
    ' completely stupid and irrelevant examples for the average fool
    '
    ' postit e maim.zip -p95 -b20 c:\scripts\mc
    ' (encodes a binary script of maim.zip. all output file(s) are written
    ' to the c:\scripts directory and begin with the "mc" suffix. the
    ' message length is 95 lines, and 20 blank lines are reserved on the
    ' first message.)
    ' postit -a f x-ray.bas -o -s
    ' (filters the file x-ray.bas for posting. all blank lines are padded
    ' with a space, no prompting is done for file overwrites, and no
    ' message splitting is performed.)
    ' postit d zebra.txt q\
    ' (decodes all scripts from the file zebra.txt to the q directory.)
    ' postit e graphics.zip -p95 -b0 -q to:you from:me conf:32 bbsid:mybbs
    ' (encodes a binary script of graphics.zip. output files are then
    ' attached, or rather merged into mybbs.rep. the messages will be from
    ' you to me in fidonet conference are #32. if to: was not specified,
    ' it would be from you to all.) tip: since importit! tosses files
    ' directly into the .rep file, there is usually no need to reserve
    ' blank lines on the first message.
    '
    type msgheadertype
    status as string * 1
    confnumascii as string * 7
    msgdate as string * 8
    msgtime as string * 5
    tofield as string * 25
    fromfield as string * 25
    subjectfield as string * 25
    password as string * 12
    msgrefnumber as string * 8
    numblocks as string * 6
    flag as string * 1
    confnum as integer ' should be unsigned integer
    packetmsgnumber as string * 2
    networktag as string * 1
    end type

    ' change the following to the name of the archiver you would like
    ' to use. must be zip, arj or lha

    preferredarchivemethod$ = "zip"
    'preferredarchivemethod$ = "arj"
    'preferredarchivemethod$ = "lha"

    dim outputfile(256) as shared string

    defint a-z
    shared true, false, debug%

    shared sswitch%, pswitch%, lswitch%, defaultlinelength%
    shared tswitch%, oswitch%, bswitch%, aswitch%
    shared iswitch%, cswitch%, qswitch%, op%
    shared pbccswitch%

    true = -1
    false = 0
    debug% = false

    dim gerr as shared integer

    'on error goto errhandler

    locate , , 1
    print "postit! v7.3 quickbasic compatible encoder/decoder"
    print "public domain by rich geldreich and victor yiu"
    print "powerbasic dos/cc update by thomas gohel"
    print

    if fre(-1) < 65536 then
    errlvl% = 1
    print "not enough memory"
    goto alldone
    end if

    dim params$(1 to 10)

    'the following line must be modified for dos 5 qbasic.
    parsecmdline ucase$(command$), params$(), numparams%
    if numparams% = 0 then errlvl% = 2: goto showhelp
    for i% = 1 to numparams%
    q$ = params$(i%)
    if left$(q$, 1) <> "-" and len(q$) = 1 then
    command% = instr("efd", q$)
    if command% <> 0 then
    params$(i%) = ": exit for
    else
    print "bad command: "; q$: print : errlvl% = 3: goto showhelp
    end if
    end if
    next
    if command% = 0 then print "no command specified.": print : errlvl% = 4: goto showhelp
    if command% = 2 then defaultlinelength% = 72 else defaultlinelength% = 65
    sswitch% = false: pswitch% = 200: lswitch% = defaultlinelength%
    tswitch% = 4: oswitch% = false: bswitch% = 0: aswitch% = false
    iswitch% = false: cswitch% = false: qswitch = 0
    pbccswitch% = false

    for i% = 1 to numparams%
    q$ = params$(i%): z$ = mid$(q$, 3)
    if len(q$) then
    if left$(q$, 1) = "-" or left$(q$, 3) = "to:" or left$(q$, 5) = "from:" or left$(q$, 5) = "conf:" or left$(q$, 6) = "bbsid:" then
    if left$(q$, 3) <> "to:" and left$(q$, 5) <> "from:" and left$(q$, 5) <> "conf:" and left$(q$, 6) <> "bbsid:" then
    select case mid$(q$, 2, 1)
    case "s": sswitch% = true
    case "p": pswitch% = grabnum&(z$, 45, 1000, 85)
    case "l": lswitch% = grabnum&(z$, 60, 80, clng(defaultlinelength%))
    case "t": tswitch% = grabnum&(z$, 1, 8, 4)
    case "o": oswitch% = true
    case "b": bswitch% = grabnum&(z$, 0, 30, 0)
    case "a": aswitch% = true
    case "i": iswitch% = true
    case "c": cswitch% = true
    case "w": pbccswitch% = true
    beep
    case "q"
    qswitch% = true
    iiparse command$, toname$, fromname$, conference%, bbsid$
    qerror$ = "
    if fromname$ = " then
    qerror$ = "from name not specified! "
    elseif conference% = 0 then
    qerror$ = qerror$ + "conference not specified! "
    elseif bbsid$ = " then
    qerror$ = qerror$ + "bbsid not specified! "
    end if
    if qerror$ <> " then
    print ltrim$(qerror$)
    errlvl = 3
    qswitch = false
    goto showhelp
    end if
    case else: print "bad switch: "; q$: print : errlvl% = 3: goto showhelp
    end select
    end if
    else
    select case j%
    case 0: inputspec$ = q$
    case 1: outputspec$ = q$
    case else: print "too many filenames.": print : errlvl% = 5: goto showhelp
    end select: j% = j% + 1
    end if
    end if
    next
    if j% < 1 then print "must specify input file.": print : errlvl% = 5: goto showhelp
    seppath inputspec$, inputdrive$, inputpath$, inputname$
    if instr(inputname$, ".") = 0 then
    if command% = 1 then 'encoding .zip
    inputspec$ = inputspec$ + ".zip"
    elseif command% = 2 then 'filtering .bas
    inputspec$ = inputspec$ + ".bas"
    elseif command% = 3 then 'decoding .txt
    inputspec$ = inputspec$ + ".txt"
    end if
    else
    if command% = 1 then
    select case mid$(inputname$, instr(inputname$, ".") + 1, 3)
    case "zip", "lzh", "arj", "gif", "sqz", "zoo", "arc", "hap", "jpg"
    case else: print "warning: uncompressed files should not be" + " encoded" + " into binary scripts!": print
    end select
    end if
    end if
    open inputspec$ for input as #1: close #1
    if gerr% then print "can't open "; inputspec$: errlvl% = 6: goto alldone
    seppath outputspec$, outdrive$, outpath$, outname$
    testfile$ = outdrive$ + outpath$ + "pi742875.2yz"
    open testfile$ for output as #1: close #1
    if gerr% then print "bad output specification.": errlvl% = 7: goto alldone
    kill testfile$
    select case command%
    case 1: status% = encode%(0, iswitch%, cswitch%, aswitch%, tswitch%, sswitch%, pswitch%, lswitch%, oswitch%, bswitch%, inputspec$, outputspec$)
    case 2: status% = encode%(1, iswitch%, cswitch%, aswitch%, tswitch%, sswitch%, pswitch%, lswitch%, oswitch%, bswitch%, inputspec$, outputspec$)
    case 3: status% = decode%(oswitch%, inputspec$, outputspec$)
    end select
    if status% < 0 then errlvl% = 8 else if status% > 0 then errlvl% = 9 else errlvl% = 0
    goto alldone
    showhelp:
    print "usage: postit [switch] command inputfile [outputfile] [-q" + " options]"
    print
    print "commands:"
    print "e [e]ncode any file <150k into a self extracting binary script"
    print "f [f]ilter qb source into a text script"
    print "d [d]ecode captured text or binary script(s)"
    print
    print "switches:"
    print "-s don't split output file into multiple messages"
    print "-o don't prompt for file overwrites"
    print "-b# reserve # blank lines on first message (0-30, default=0)"
    print "-t# set tab stops to # characters (1-8, default=4)"
    print "-l# set line length to # characters (60-80, default=65 or 72)"
    print "-p# set message length to # lines (45-1000, default=200)"
    print "-a padd blank lines with a space when filtering"
    print "-i ignore blank lines when filtering"
    print "-c crush space characters from start of lines when filtering"
    print "-w powerbasic/win32 sources for console compiler
    print
    print "importit! (qwk compatable .rep file support):"
    print "-q [to:to_name] from:from_name conf:conf_num bbsid:bbsid"
    alldone:
    if qswitch = true then
    if gerr < 0 then
    if debug% then print "exiting with an errorlevel of"; errlvl%
    end
    end if
    for n = 1 to 256
    a$ = outputfile$(n)
    if a$ = " then exit for
    next n
    numfiles = n - 1
    dim msgfiles$(1 to numfiles)
    for n = 1 to numfiles
    msgfiles$(n) = outputfile$(n)
    next n
    for n = len(inputspec$) to 1 step -1
    if mid$(inputspec$, n, 1) = "\" then startfname = n + 1
    next n
    if startfname <> 0 then
    titlefile$ = mid$(inputspec$, startfname, 1)
    else
    titlefile$ = inputspec$
    end if
    for n = 1 to len(toname$)
    if mid$(toname$, n, 1) = "." then mid$(toname$, n, 1) = " "
    next n
    for n = 1 to len(fromname$)
    if mid$(fromname$, n, 1) = "." then mid$(fromname$, n, 1) = " "
    next n
    importit bbsid$, msgfiles$(), toname$, fromname$, titlefile$,_
    conference%
    end if
    if debug% then print "exiting with an errorlevel of"; errlvl%
    end

    errhandler:
    gerr% = err
    if debug% then if gerr% <> 53 then print "global error #"; gerr%
    resume next

    sub addtorep (bbsid$, msgfiles$(), toname$, fromname$, titlefile$, conference, errorcode$)
    dim msgheader as msgheadertype
    dim qwkrecbuff as string * 128
    dim qwkbytebuff as string * 1
    dim archeader as string * 3
    ' test for file
    open bbsid$ + ".rep" for binary as #1
    if lof(1) = 0 then
    close #1
    kill bbsid$ + ".rep"
    errorcode$ = "reply packet (.rep file) not found!"
    exit sub
    end if
    ' test for messages
    nummessages = ubound(msgfiles$)
    if nummessages = 0 then
    close #1
    errorcode$ = "no files to add to reply (.rep) packet!"
    exit sub
    end if
    ' check toname$
    if toname$ = " then
    toname$ = "all"
    end if
    ' check fromname$
    if fromname$ = " then
    close #1
    errorcode$ = "no from field (name) specified!"
    exit sub
    end if
    close #1
    ' process mail packet
    print
    print "unarchiving "; bbsid$ + ".rep";
    ' determine archive type
    open bbsid$ + ".rep" for binary as #1
    ' pkzip file?
    seek 1, 1
    get #1, , archeader
    if archeader = "pk" + chr$(3) then
    dearccommand$ = "pkunzip"
    arccommand$ = "pkzip"
    arctype$ = "zip"
    end if
    ' lzh file?
    seek 1, 3
    get #1, , archeader
    if archeader = "-lh" then
    dearccommand$ = "lha e"
    arccommand$ = "lha a /m"
    arctype$ = "lzh"
    end if
    ' arj file?
    seek 1, 1
    get #1, , archeader
    if left$(archeader, 2) = "'" + chr$(234) then
    dearccommand$ = "arj e"
    arccommand$ = "arj a -y"
    arctype$ = "arj"
    end if
    ' dearchive file
    print " using "; arctype$
    shell dearccommand$ + " " + bbsid$ + ".rep"
    close #1
    ' test for file
    open bbsid$ + ".msg" for binary as #1
    if lof(1) = 0 then
    errorcode$ = "error occured during dearchiving. file " + bbsid$ + ".msg not found in archive"
    close #1
    kill bbsid$ + ".msg"
    exit sub
    end if
    ' read messages
    print
    print "reading messages from "; bbsid$; ".msg..."
    seek 1, 1
    get #1, , qwkrecbuff
    do
    get #1, , msgheader
    newhighest = val(msgheader.msgrefnumber)
    if newhighest > highest then highest = newhighest
    ' read until next message
    for n = 1 to val(msgheader.numblocks) - 1
    get #1, , qwkrecbuff
    next n
    loop until seek(1) >= lof(1)
    print
    print "writing new messages..."
    print
    print "to: "
    print "from: "
    print "subj: "
    print "conf: "
    print "date: "
    print "time: "
    print "number: "
    startlin = csrlin - 7
    for msg = 1 to nummessages
    locate startlin, 1
    subj$ = "[" + ltrim$(str$(msg)) + "/" + ltrim$(str$(nummessages)) + "] " + titlefile$
    conf$ = ltrim$(str$(conference))
    num$ = ltrim$(str$(msg + highest - 1))
    dat$ = left$(date$, 6) + right$(date$, 2)
    tim$ = left$(time$, 5)
    print "to: "; toname$
    print "from: "; fromname$
    print "subj: "; subj$
    print "conf: "; conf$
    print "date: "; dat$
    print "time: "; tim$
    print "number: "; num$
    print "writing file: "; msgfiles$(msg);
    totallen& = 0
    open msgfiles$(msg) for input as #2
    open "~iibeta.tmp" for binary as #3
    do while not eof(2)
    line input #2, text$
    text$ = text$ + chr$(227)
    put #3, , text$
    loop
    totallen& = seek(3)
    totallen& = totallen& + 128 ' for tagline
    qwkrecbuff = chr$(227) + " * importit! v1.0b [beta] * importit!" + " [pd] by calvin french, august 1993" + chr$(227) + chr$(227)
    put #3, , qwkrecbuff
    extrastring$ = space$(128 - (totallen& mod 128))
    totallen& = totallen& + len(extrastring$)
    put #3, , extrastring$
    blocks$ = ltrim$(str$((totallen& / 128) + 1))
    msgheader.status = "-" ' public, read
    msgheader.confnumascii = conf$ ' conference (.rep only)
    msgheader.msgdate = dat$ ' date
    msgheader.msgtime = tim$ ' time
    msgheader.tofield = toname$ ' to
    msgheader.fromfield = fromname$ ' from
    msgheader.subjectfield = subj$ ' subject
    msgheader.password = space$(12) ' password
    msgheader.msgrefnumber = num$ ' message number
    msgheader.numblocks = blocks$ ' blocks in message
    msgheader.flag = chr$(225) ' active flag
    msgheader.confnum = conference ' conference (.rep and .qwk)
    msgheader.packetmsgnumber = " " ' not sure what this is.
    msgheader.networktag = " " ' network tagline
    put #1, , msgheader
    seek 3, 1
    for n = 1 to totallen& / 128
    get #3, , qwkrecbuff
    put #1, , qwkrecbuff
    next n
    close #3
    close #2
    kill "~iibeta.tmp"
    next msg
    close #1
    print
    print
    print "rearchiving packet..."
    shell arccommand$ + " " + bbsid$ + ".rep " + bbsid$ + ".msg"
    print
    print "deleting " + bbsid$ + ".msg..."
    print
    kill bbsid$ + ".msg"
    errorcode$ = "packet successfully processed!"
    end sub

    sub createrep (bbsid$, arccommand$)

    dim qwkrecbuff as string * 128

    print
    print "creating message data file (.msg file)..."
    print

    open bbsid$ + ".msg" for binary as #1

    qwkrecbuff = ucase$(bbsid$)

    put #1, , qwkrecbuff

    close #1

    print "archiving file..."

    shell arccommand$ + " " + bbsid$ + ".rep " + bbsid$ + ".msg"

    print
    print "deleting message data file (.msg file)..."

    kill bbsid$ + ".msg"

    end sub

    function decode% (oswitch%, inspec$, outspec$)
    dim lines$(1 to 256), validchar%(255)
    for q% = 0 to 85 'valid encoding characters
    if q% = 27 then
    validchar%(asc("#")) = true
    elseif q% = 59 then
    validchar%(asc("$")) = true
    else
    validchar%(q% + 37) = true
    end if
    next
    gerr% = 0: z$ = "open " + chr$(34) + "o" + chr$(34) + ",1," + chr$(34)
    seppath outspec$, outdrive$, outpath$, outname$
    outpath$ = outdrive$ + outpath$
    inputhandle% = freefile
    open inspec$ for input as inputhandle% len = 8192
    outputhandle% = freefile
    do
    if foundnewscript% = false then
    do until eof(inputhandle%)
    m% = m% + 1: if m% = 16 then gosub abortcheck
    linenum& = linenum& + 1
    line input #1, a$: a$ = ltrim$(rtrim$(ucase$(a$)))
    if gerr% then print "error while reading from input file!": goto decodeexit
    if left$(a$, 14) = "'>>> page 1 of" and instr(a$, "begins" + " here") > 0 and instr(a$, "type:") > 0 then exit do
    loop
    if eof(inputhandle%) then exit do
    end if
    foundnewscript% = false
    outfile$ = ltrim$(mid$(a$, 15))
    outfile$ = rtrim$(left$(outfile$, instr(outfile$, "begins") - 1))
    if len(outfile$) = 0 then goto findnext
    if len(outname$) = 0 or outfile$ = outname$ then
    filescrc% = -1: fileslength& = -1: scrdone% = false
    badscript% = false: numlines% = 0: k% = 0: s% = 0: b& = 0
    q% = instr(a$, "type:") + 5
    select case mid$(a$, q%, 3)
    case "bas": scripttype% = 0
    case "bin"
    scripttype% = 1
    encodever% = fasc%(mid$(a$, q% + 3, 1)) - 65
    extractver% = fasc%(mid$(a$, q% + 4, 1)) - 65
    if extractver% <> 0 then print "unsupported encoding algorithm"+" + " + " for file "; outfile$: print : goto findnext
    case else: print "unsupported script type for file "; outfile$: print : goto findnext
    end select
    gosub checkline
    open outpath$ + outfile$ for input as outputhandle%: close outputhandle%
    if gerr% = 0 then
    if oswitch% = false then
    print outpath$ + outfile$; " already exists. [o]verwrite, or"+" " + " + " [a]bort(o/a)? ";
    do: do: a$ = inkey$: loop until len(a$): a$ = ucase$(a$)
    loop until instr("oa" + chr$(27), a$)
    locate , 1: print space$(78); : locate , 1
    select case a$
    case "a", chr$(27): gerr% = -1: print "aborted by user!": goto decodeexit
    end select
    end if
    end if
    gerr% = 0: open outpath$ + outfile$ for output as outputhandle%
    if gerr% then print "error while opening "; outpath$ + outfile$; "!": goto decodeexit
    outspecopened% = true
    if scripttype% = 0 then
    print "unfiltering ";
    else
    print "decoding ";
    end if
    print outpath$ + outfile$; "... ";
    lookingfornextpage% = false
    currentpage% = 1
    do until eof(inputhandle%)
    if gerr% then print "error #"; str$(gerr%); " while processing"+ " + " + " file!": goto decodeexit
    m% = m% + 1: if m% = 16 then gosub abortcheck
    linenum& = linenum& + 1
    line input #inputhandle%, a$: a$ = rtrim$(a$)
    if scripttype% = 1 then a$ = ltrim$(a$)
    if left$(a$, 4) = "'>>>" then
    gosub checkline
    if ucase$(left$(a$, 10)) = "'>>> page " then
    a$ = ucase$(a$)
    if left$(a$, 15) = "'>>> page 1 of " and instr(a$, "begins"+" + " + " here") > 0 then
    print "premature end of script on line"; linenum&
    foundnewscript% = true: badscript% = true: exit do
    end if
    if grabnum&(mid$(a$, 11), 1, 256, -1) <> currentpage% then print "page out of sync on line"; linenum&: badscript% = true: exit do
    if instr(a$, "begins here") then
    if lookingfornextpage% = false then print "page"; currentpage%; " was encountered more than once on line"; linenum&: badscript% = true: exit do
    lookingfornextpage% = false
    elseif instr(a$, "ends here") then
    if lookingfornextpage% = true then print "page"; currentpage%; "was terminated prematurely on line"; linenum&: badscript% = true: exit do
    lookingfornextpage% = true
    currentpage% = currentpage% + 1
    if instr(a$, "last page") then scrdone% = true: exit do
    else
    print "bad page header on line"; linenum&: badscript% = true: exit do
    end if
    end if
    else
    if lookingfornextpage% = false then
    if scripttype% = 0 then
    gosub shrinkline
    else
    if left$(a$, 1) = "u" and left$(ltrim$(mid$(a$, 2)), 1) = chr$(34) then gosub decodeline
    end if
    end if
    end if
    loop
    if badscript% = false then
    if scrdone% = false then print "premature end of script on" + " line"; linenum&: badscript% = true: goto decodedone
    goodscripts% = goodscripts% + 1
    if scripttype% = 0 then
    if numlines% > 0 then a$ = ": gosub shrinkline
    print "ok"
    else
    if fileslength& = -1 then
    print "warning: file's length could not be located!"
    elseif fileslength& <> b& then
    print "warning: decoded file's length is incorrect."
    elseif filescrc% = -1 then
    print "warning: file's checksum could not be located!"
    elseif filescrc% <> s% then
    print "warning: decoded file's checksum is incorrect."
    else
    print "ok"
    end if
    end if
    end if
    decodedone:
    close outputhandle%
    if gerr% then print "error while writing to output file!": goto decodeexit
    if badscript% then kill outpath$ + outfile$
    outspecopened% = false
    print : if outfile$ = outname$ then exit do
    end if
    findnext:
    loop until eof(inputhandle%)
    '----------------------------------------------------------
    decodeexit:
    q% = gerr%: close inputhandle%: close outputhandle%
    if q% = 0 then print ltrim$(str$(goodscripts%)); " script(s) decoded"+" + " + " successfully."
    if q% <> 0 and outspecopened% then kill outpath$ + outfile$
    decode% = q%
    exit function
    '----------------------------------------------------------
    shrinkline:
    foundit% = fasc(right$(a$, 1)) = 95
    if foundit% then
    inquote% = false
    for i% = 1 to len(a$)
    if mid$(a$, i%, 1) = chr$(34) then inquote% = not inquote%
    next
    'don't combine lines that are part of binary scripts
    if inquote% then foundit% = false
    end if
    if foundit% or numlines% > 0 then
    if numlines% = 256 then
    print "too many line continuations!": badscript% = true: goto decodedone
    end if
    numlines% = numlines% + 1: lines$(numlines%) = a$
    if foundit% = false then 'last line?
    a$ = "
    for a% = 1 to numlines%
    b$ = lines$(a%)
    'can we combine two quoted strings together?
    combinequote% = false
    if right$(a$, 2) = "+_" and len(a$) > 3 then
    if right$(rtrim$(left$(a$, len(a$) - 2)), 1) = chr$(34) then
    if fasc(ltrim$(b$)) = 34 then combinequote% = true
    end if
    end if
    if combinequote% then
    a$ = rtrim$(left$(a$, len(a$) - 2))
    a$ = left$(a$, len(a$) - 1) + mid$(ltrim$(b$), 2)
    else
    inquote% = false
    'can we combine two remarks together?
    for i% = 1 to len(a$)
    q$ = mid$(a$, i%, 1)
    if q$ = chr$(34) then
    inquote% = not inquote%
    elseif inquote% = false then
    if q$ = "'" or ucase$(mid$(a$, i%, 4)) = "rem " then
    if left$(ltrim$(b$), 1) = "'" then b$ = mid$(b$, 2)
    exit for
    end if
    end if
    next
    'eradicate trailing "_" character
    if len(a$) then a$ = left$(a$, len(a$) - 1)
    a$ = a$ + b$
    end if
    next
    print #outputhandle%, a$: numlines% = 0
    end if
    else
    print #outputhandle%, a$
    end if
    if gerr% then print "error while writing to output file!": goto decodeexit
    return
    '----------------------------------------------------------
    decodeline: '**mod 86 decoder**
    a$ = mid$(ltrim$(mid$(a$, 2)), 2)
    if right$(a$, 1) = chr$(34) then a$ = left$(a$, len(a$) - 1)
    for a% = 1 to len(a$)
    c% = asc(mid$(a$, a%, 1))
    if validchar%(c%) = false then print "illegal character found on" + " line"; linenum&: badscript% = true: goto decodedone
    c% = c% - 37: if c% < 0 then c% = 91 + c% * 32
    if k% < 4 then
    if c% > 80 then print "decode out of sync/illegal character" + " found" + " on line"; linenum&: badscript% = true: goto decodedone
    k% = c% + 243
    else
    t% = c% + (k% mod 3) * 86: if t% > 255 then print "illegal" + " character found on line"; linenum&: badscript% = true: goto decodedone
    print #outputhandle%, chr$(t%);
    if gerr% then print "error while writing to output file!": goto decodeexit
    b& = b& + 1: k% = k% \ 3
    end if
    s% = (s% + c%) and 255
    next
    return
    '----------------------------------------------------------
    checkline:
    q% = instr(a$, "tlen:")
    if q% then fileslength& = grabnum&(mid$(a$, q% + 5), 1, 153600, -1)
    q% = instr(a$, "tchk:")
    if q% then filescrc% = grabnum&(mid$(a$, q% + 5), 0, 255, -1)
    return
    '----------------------------------------------------------
    abortcheck:
    m% = 0: k$ = inkey$
    if k$ = chr$(27) or k$ = chr$(0) + chr$(0) then gerr% = -1: print "aborted by user!": goto decodeexit
    return
    end function

    function encode% (op%, iswitch%, cswitch%, aswitch%, tswitch%, sswitch%, pswitch%, lswitch%, oswitch%, bswitch%, inspec$, outspec$)
    ' following shared is for importit!

    dim bucket%(1 to 4), lines$(64)
    gerr% = 0: q$ = chr$(34)
    '----------------------------------------------------------
    seppath inspec$, outdrive$, outpath$, inname$
    seppath outspec$, outdrive$, outpath$, outname$

    if len(outname$) = 0 then
    outname$ = inname$
    if instr(outname$, ".") then outname$ = left$(outname$, instr(outname$, ".") - 1)
    end if

    if instr(outname$, ".") then
    outext$ = mid$(outname$, instr(outname$, "."))
    outname$ = left
Working...
X