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