Ok You shits.
DECLARE SUB con.atrbar (x%, y%, w%, h%, atr%)
DECLARE FUNCTION enumdrives% (arr%())
DECLARE SUB setdrv (drvno%)
DECLARE FUNCTION getdrv% ()
DECLARE FUNCTION setcwd% (path$)
DECLARE FUNCTION getcwd$ ()
DECLARE SUB con.atrseg (x%, y%, w%, atr%)
DECLARE SUB con.box (x%, y%, w%, h%, atr%)
DECLARE SUB con.putstrxy (st$, x%, y%)
DECLARE FUNCTION findnext% (fi AS ANY)
DECLARE FUNCTION RequestFile% (dest$)
DECLARE FUNCTION findfirst% (spec$, attrib%, fi AS ANY)
DEFINT A-Z
'$INCLUDE: 'QB.BI'
'Beni Requester
'brought to You by the mega-mighty SLEEPING PENNER PRODUCTIONS in 2003
'You need to declare only one function in Your program:
'DECLARE FUNCTION RequestFile%(dest$)
'Return values are 0 (requester was aborted) or 1 (file was chosen).
'If a file was chosen, dest$ holds the full path.
'This was programmed for 50 lines mode, to enter 50 lines mode:
'SCREEN 0: WIDTH 80, 50
'The constant HIGHFILE below stands for the number of files the
'requester will maximally handle minus 1. You might want to change
'it when You run out of memory. If a directory contains more than
'HIGHFILE+1 objects, some of the files won't be displayed.
'Navigation is with cursor, (shift+)tab, enter and esc. You can
'enter a file name by hand by just typing it.
'Ok folks, this is POSTCARDWARE. When You use it in Your program,
'You should send a postcard to tr0ubelin/SPP who is in jail ATM.
'The address:
' Strafanstalt Schöngrün
' z.Hd. Benedict Jäggi
' Postfach
' 4500 Solothurn
' SWITZERLAND
'(He shall be very reachable there until *at least* September 2003.)
'Meet the Sleeping Penner Productions on the major QuickBASIC boards
'out there...
'
'MAY THE SCHWARTZ BE WITH YOU
CONST HIGHFILE = 1110
CONST ATR.RDONLY = 1
CONST ATR.HIDDEN = 2
CONST ATR.SYSTEM = 4
CONST ATR.VOLUME = 8
CONST ATR.DIR = 16
CONST ATR.ARCHIV = 32
TYPE FileInfo
attrib AS INTEGER
size AS LONG
spec AS STRING * 13
END TYPE
DIM zbi AS FileInfo
DIM foo(0 TO 25)
Alphabet:
DATA 0,33,35,36,37,38,39,40,41,45,46,48,49,50,51,52,53,54
DATA 55,56,57,64,65,66,67,68,69,70,71,72,73,74,75,76
DATA 77,78,79,80,81,82,83,84,85,86,87,88,89,90,94,95
DATA 96,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
DATA 112,113,114,115,116,117,118,119,120,121,122,123,125,126,127,128
DATA 129,130,131,132,133,134,135,136,137,138,139,140,141,142,143,144
DATA 145,146,147,148,149,150,151,152,153,154,155,156,157,158,159,160
DATA 161,162,163,164,165,166,167,168,169,170,171,172,173,174,175,176
DATA 177,178,179,180,181,182,183,184,185,186,187,188,189,190,191,192
DATA 193,194,195,196,197,198,199,200,201,202,203,204,205,206,207,208
DATA 209,210,211,212,213,214,215,216,217,218,219,220,221,222,223,224
DATA 225,226,227,228,229,230,231,232,233,234,235,236,237,238,239,240
DATA 241,242,243,244,245,246,247,248,249,250,251,252,253,254,255
SUB con.atrbar (x, y, w, h, atr)
DEF SEG = &HB800
ofs = (2 * ((80 * y) + x)) + 1
mdo = 2 * (80 - w)
lh = h
WHILE lh
lw = w
WHILE lw
POKE ofs, atr
ofs = ofs + 2
lw = lw - 1
WEND
ofs = ofs + mdo
lh = lh - 1
WEND
END SUB
SUB con.atrseg (x, y, w, atr)
DEF SEG = &HB800
ofs = (2 * ((80 * y) + x)) + 1
lw = w
WHILE lw
POKE ofs, atr
ofs = ofs + 2
lw = lw - 1
WEND
END SUB
SUB con.box (x, y, w, h, atr)
h = h - 2
ow = w
w = w - 1
IF h < 1 THEN EXIT SUB
IF w < 2 THEN EXIT SUB
o1 = 2 * ((80 * y) + x)
o2 = o1 + w + w
o3 = o1
w = w - 1
DEF SEG = &HB800
POKE o1, 218: POKE o1 + 1, atr
POKE o2, 191: POKE o2 + 1, atr
o1 = o1 + 160
o2 = o2 + 160
WHILE h
h = h - 1
POKE o1, 179: POKE o1 + 1, atr
POKE o2, 179: POKE o2 + 1, atr
o1 = o1 + 160
o2 = o2 + 160
WEND
POKE o1, 192: POKE o1 + 1, atr
POKE o2, 217: POKE o2 + 1, atr
WHILE w
w = w - 1
o3 = o3 + 2
o2 = o2 - 2
POKE o3, 196: POKE o3 + 1, atr
POKE o2, 196: POKE o2 + 1, atr
WEND
w = ow
END SUB
SUB con.putstrxy (st$, x, y)
DEF SEG = &HB800
ofs = 2 * ((80 * y) + x)
FOR p = 1 TO LEN(st$)
POKE ofs, ASC(MID$(st$, p, 1))
ofs = ofs + 2
NEXT p
END SUB
FUNCTION enumdrives (arr())
DIM regsx AS RegTypeX
ndrives = 0
FOR drvno = 1 TO 26
regsx.ax = &H440E
regsx.bx = drvno
INTERRUPTX &H21, regsx, regsx
IF regsx.ax <> 15 THEN
arr(ndrives) = drvno - 1
ndrives = ndrives + 1
END IF
NEXT drvno
enumdrives = ndrives
END FUNCTION
FUNCTION findfirst (spec$, attrib, fi AS FileInfo)
DIM regsx AS RegTypeX
STATIC dtaseg, dtaoff
IF dtaseg = 0 THEN
regsx.ax = &H2F00
INTERRUPTX &H21, regsx, regsx
dtaseg = regsx.es
dtaoff = regsx.bx
END IF
s$ = spec$ + CHR$(0)
regsx.ax = &H4E00
regsx.cx = attrib
regsx.ds = VARSEG(s$)
regsx.dx = SADD(s$)
INTERRUPTX &H21, regsx, regsx
IF (regsx.ax = 2) OR (regsx.ax = 3) OR (regsx.ax = 18) THEN
findfirst = 0
EXIT FUNCTION
END IF
DEF SEG = dtaseg
fi.attrib = PEEK(dtaoff + &H15)
fi.size = PEEK(dtaoff + &H1A) OR (256& * PEEK(dtaoff + &H1B)) OR (65536 * PEEK(dtaoff + &H1C)) OR (16777216 * PEEK(dtaoff + &H1D))
soff = dtaoff + &H1E: p = 1
DO
b = PEEK(soff): soff = soff + 1
MID$(fi.spec, p, 1) = CHR$(b)
p = p + 1
LOOP WHILE b
WHILE p < 13
MID$(fi.spec, p, 1) = CHR$(0)
p = p + 1
WEND
findfirst = 1
END FUNCTION
FUNCTION findnext (fi AS FileInfo)
DIM regsx AS RegTypeX
STATIC dtaseg, dtaoff
IF dtaseg = 0 THEN
regsx.ax = &H2F00
INTERRUPTX &H21, regsx, regsx
dtaseg = regsx.es
dtaoff = regsx.bx
END IF
regsx.ax = &H4F00
INTERRUPTX &H21, regsx, regsx
IF regsx.ax = 18 THEN
findnext = 0
EXIT FUNCTION
END IF
DEF SEG = dtaseg
fi.attrib = PEEK(dtaoff + &H15)
fi.size = PEEK(dtaoff + &H1A) OR (256& * PEEK(dtaoff + &H1B)) OR (65536 * PEEK(dtaoff + &H1C)) OR (16777216 * PEEK(dtaoff + &H1D))
soff = dtaoff + &H1E: p = 1
DO
b = PEEK(soff): soff = soff + 1
MID$(fi.spec, p, 1) = CHR$(b)
p = p + 1
LOOP WHILE b
WHILE p < 13
MID$(fi.spec, p, 1) = CHR$(0)
p = p + 1
WEND
findnext = 1
END FUNCTION
FUNCTION getcwd$
DIM regsx AS RegTypeX
DIM buf AS STRING
buf = SPACE$(64)
regsx.ax = &H4700
regsx.dx = 0
regsx.ds = VARSEG(buf)
regsx.si = SADD(buf)
INTERRUPTX &H21, regsx, regsx
IF regsx.ax = 15 THEN
getcwd = ""
ELSE
p = 1
DO
b = ASC(MID$(buf, p, 1))
p = p + 1
LOOP WHILE b <> 32
getcwd$ = LEFT$(buf, p - 2)
END IF
END FUNCTION
FUNCTION getdrv
DIM regsx AS RegTypeX
regsx.ax = &H1900
INTERRUPTX &H21, regsx, regsx
getdrv = regsx.ax AND 255
END FUNCTION
FUNCTION RequestFile (dest$) STATIC
DIM fi(0 TO HIGHFILE) AS FileInfo
DIM alph(0 TO 150)
DIM driv(0 TO 25)
IF ndrives = 0 THEN
ndrives = enumdrives(driv())
RESTORE Alphabet
FOR a = 0 TO 150
READ alph(a)
NEXT a
END IF
con.atrbar 20, 1, 18, 48, 7
con.atrbar 50, 49 - ndrives, 7, ndrives, 7
con.box 19, 0, 20, 3, &H5E
con.box 19, 0, 20, 50, &H5E
con.box 49, 48 - ndrives, 7, ndrives + 2, &H5E
con.putstrxy SPACE$(18), 20, 1
row = 49 - ndrives
FOR a = 0 TO ndrives - 1
con.putstrxy "[-" + CHR$(65 + driv(a)) + "-]", 50, row
row = row + 1
NEXT a
cdrv = getdrv
cpath$ = getcwd
specpos = 1
con.atrseg 50, 49 - ndrives + cdrv, 5, &H2E
NewDir:
nfiles = 0
IF findfirst("*.*", 63, fi(0)) THEN
DO
nfiles = nfiles + 1
IF nfiles > HIGHFILE THEN EXIT DO
LOOP WHILE findnext(fi(nfiles))
END IF
GOSUB Sort
FOR row = 3 TO 48
con.putstrxy SPACE$(18), 20, row
NEXT row
top = 0
GOSUB Rethink
curs = 0
con.atrseg 20, 3, 18, &H2E
spec$ = fi(top + curs).spec
con.putstrxy spec$, 20, 1
specpos = 1
GetKei:
i$ = ""
WHILE i$ = "": i$ = INKEY$: WEND
kei = CVI(i$ + CHR$(0))
SELECT CASE kei
CASE &H4800:
IF curs THEN
con.atrseg 20, curs + 3, 18, 7
curs = curs - 1
con.atrseg 20, curs + 3, 18, &H2E
ELSEIF top THEN
top = top - 1
GOSUB Rethink
END IF
spec$ = fi(top + curs).spec
con.putstrxy spec$, 20, 1
specpos = 1
CASE &H5000:
IF (curs < 45) AND (curs < nfiles - 1) THEN
con.atrseg 20, curs + 3, 18, 7
curs = curs + 1
con.atrseg 20, curs + 3, 18, &H2E
ELSEIF top + 46 < nfiles THEN
top = top + 1
GOSUB Rethink
END IF
spec$ = fi(top + curs).spec
con.putstrxy spec$, 20, 1
specpos = 1
CASE &H4900:
IF curs > 15 THEN
con.atrseg 20, curs + 3, 18, 7
curs = curs - 16
con.atrseg 20, curs + 3, 18, &H2E
ELSE
top = top - 16
IF top < 0 THEN
con.atrseg 20, curs + 3, 18, 7
curs = 0
con.atrseg 20, 3, 18, &H2E
top = 0
END IF
GOSUB Rethink
END IF
spec$ = fi(top + curs).spec
con.putstrxy spec$, 20, 1
specpos = 1
CASE &H5100:
IF (curs < 30) AND (nfiles >= 46) THEN
con.atrseg 20, curs + 3, 18, 7
curs = curs + 16
con.atrseg 20, curs + 3, 18, &H2E
ELSE
top = top + 16
IF top > nfiles - 46 THEN
con.atrseg 20, curs + 3, 18, 7
IF nfiles < 46 THEN
curs = nfiles - 1
top = 0
ELSE
curs = 45
top = nfiles - 46
END IF
con.atrseg 20, curs + 3, 18, &H2E
END IF
GOSUB Rethink
END IF
spec$ = fi(top + curs).spec
con.putstrxy spec$, 20, 1
specpos = 1
CASE &HD:
IF (fi(curs).attrib AND ATR.DIR) AND (spec$ = fi(curs).spec) THEN
agi = setcwd(fi(curs).spec)
con.atrseg 20, curs + 3, 18, 7
GOTO NewDir
ELSE
path$ = getcwd
p = 1
DO
b = ASC(MID$(path$, p, 1))
p = p + 1
LOOP WHILE b
path$ = LEFT$(path$, p - 2)
p = 1
DO
b = ASC(MID$(spec$, p, 1))
p = p + 1
LOOP WHILE b
spec$ = LEFT$(spec$, p - 2)
dest$ = CHR$(65 + driv(cdrv)) + ":\" + path$ + "\" + spec$
RequestFile = 1
GOTO EndstationEmmenspitz
END IF
CASE 9, &HF00:
con.atrseg 20, curs + 3, 18, 7
GOSUB SelektDrive
CASE &H1B:
RequestFile = 0
GOTO EndstationEmmenspitz
CASE ELSE:
IF specpos < 13 THEN
zbi = kei AND 255
IF zbi THEN
IF zbi >= 33 THEN
okai = 0
FOR bsc = 0 TO 150
IF zbi = alph(bsc) THEN
okai = 1
EXIT FOR
END IF
NEXT bsc
IF okai THEN
IF specpos = 1 THEN spec$ = SPACE$(13)
MID$(spec$, specpos, 1) = CHR$(zbi)
specpos = specpos + 1
MID$(spec$, specpos, 1) = CHR$(0)
con.putstrxy spec$, 20, 1
END IF
ELSEIF zbi = 8 THEN
IF specpos > 1 THEN
specpos = specpos - 1
MID$(spec$, specpos, 1) = CHR$(0)
con.putstrxy spec$, 20, 1
END IF
END IF
END IF
END IF
END SELECT
GOTO GetKei
Sort:
con.atrseg 59, 1, 10, &H87
con.putstrxy "Sorting...", 59, 1
Bub:
okai = 1
FOR f = 0 TO nfiles - 2
IF fi(f + 1).spec < fi(f).spec THEN
SWAP fi(f), fi(f + 1)
okai = 0
END IF
NEXT f
IF okai = 0 THEN GOTO Bub
i = 0
FOR f = 0 TO nfiles - 1
IF (fi(f).attrib AND ATR.DIR) THEN
SWAP fi(f), fi(i)
i = i + 1
END IF
NEXT f
con.putstrxy SPACE$(10), 59, 1
con.atrseg 59, 1, 10, 7
RETURN
Rethink:
row = 3
FOR f = top TO nfiles - 1
con.putstrxy fi(f).spec, 20, row
IF (fi(f).attrib AND ATR.DIR) THEN
con.putstrxy "(Dir)", 33, row
ELSE
con.putstrxy SPACE$(5), 33, row
END IF
row = row + 1
IF row = 49 THEN EXIT FOR
NEXT f
RETURN
SelektDrive:
con.atrseg 50, 49 - ndrives + cdrv, 5, &H4E
odrv = cdrv
SelektDrive0:
i$ = ""
WHILE i$ = "": i$ = INKEY$: WEND
kei = CVI(i$ + CHR$(0))
SELECT CASE kei
CASE &H4800:
IF cdrv THEN
con.atrseg 50, 49 - ndrives + cdrv, 5, 7
cdrv = cdrv - 1
con.atrseg 50, 49 - ndrives + cdrv, 5, &H4E
END IF
CASE &H5000:
IF cdrv < ndrives - 1 THEN
con.atrseg 50, 49 - ndrives + cdrv, 5, 7
cdrv = cdrv + 1
con.atrseg 50, 49 - ndrives + cdrv, 5, &H4E
END IF
CASE &HD:
con.atrseg 50, 49 - ndrives + cdrv, 5, &H2E
setdrv driv(cdrv)
GOTO NewDir
CASE 9, &HF00:
con.atrseg 50, 49 - ndrives + cdrv, 5, 7
con.atrseg 50, 49 - ndrives + odrv, 5, &H2E
con.atrseg 20, curs + 3, 18, &H2E
cdrv = odrv
GOTO GetKei
CASE &H1B:
GOTO EndstationEmmenspitz
END SELECT
GOTO SelektDrive0
RETURN
EndstationEmmenspitz:
END FUNCTION
FUNCTION setcwd (path$)
DIM regsx AS RegTypeX
p = 1
DO
b = ASC(MID$(path$, p, 1))
p = p + 1
LOOP WHILE b
p$ = LEFT$(path$, p - 2) + CHR$(0)
regsx.ax = &H3B00
regsx.ds = VARSEG(p$)
regsx.dx = SADD(p$)
INTERRUPTX &H21, regsx, regsx
IF regsx.ax = 3 THEN
setcwd = 0
ELSE
setcwd = 1
END IF
END FUNCTION
SUB setdrv (drvno)
DIM regsx AS RegTypeX
regsx.ax = &HE00
regsx.dx = drvno
INTERRUPTX &H21, regsx, regsx
END SUB
|