DEFINT A-Z DECLARE SUB drawtabs () DECLARE SUB redit () DECLARE SUB drawdir () DECLARE FUNCTION getfiles (pp$, arr() AS STRING) DIM SHARED f(10) AS LONG f(0) = &H1EE58955 f(1) = &HB80656C5 f(2) = &H21CD1A00 f(3) = &H4CA5D1F f(5) = &H8BE58955 f(6) = &H4E8B0656 f(7) = &HA768B08 f(8) = &H21CD048B f(9) = &HCA5D0489 f(10) = &H6 DEF SEG = VARSEG(f(0)) TYPE dtatype reserved AS STRING * 21 a AS STRING * 1 time AS INTEGER date AS STRING * 2 size AS LONG fname AS STRING * 13 END TYPE DIM SHARED dta AS dtatype DEF SEG = VARSEG(f(0)) CALL absolute(SEG dta, VARPTR(f(0))) DIM SHARED t AS INTEGER, at AS INTEGER t = 1 at = 1 DIM SHARED tt(10) DIM SHARED ef(10) AS STRING DIM SHARED es(10) AS INTEGER DIM SHARED ex(10) AS INTEGER DIM SHARED ey(10) AS INTEGER DIM SHARED ms(10) AS INTEGER DIM SHARED c(100, 7) AS STRING * 80 DIM SHARED cf(10) AS STRING DIM SHARED cs AS INTEGER DIM SHARED df(500) AS STRING DIM SHARED d AS STRING DIM SHARED dn AS INTEGER, ds AS INTEGER, dss AS INTEGER d = "C:\" dn = getfiles(d$, df()) ds = 0 dss = 0 SCREEN 0 VIEW PRINT 1 TO 25 CLS drawtabs drawdir DO k$ = RIGHT$(INKEY$, 1) IF k$ <> "" THEN IF (ASC(k$) > 58) AND (ASC(k$) < (59 + t)) THEN at = ASC(k$) - 58 drawtabs IF at = 1 THEN CLS drawtabs drawdir ELSE SELECT CASE tt(at) CASE 1 'CLS 'drawtabs redit END SELECT END IF END IF END IF SELECT CASE at CASE 1 SELECT CASE k$ CASE "P" IF dss < 23 THEN IF dss < (dn - 1) THEN dss = dss + 1 ELSE IF (ds + dss) < (dn - 1) THEN ds = ds + 1 END IF drawdir CASE "H" IF dss > 0 THEN dss = dss - 1 ELSE IF ds > 0 THEN ds = ds - 1 END IF drawdir CASE CHR$(13) LOCATE 3, 20 PRINT df(ds + dss) + SPACE$(13) IF RTRIM$(df(ds + dss)) = "..\" THEN IF RIGHT$(d, 2) <> ":\" THEN FOR i = LEN(d) TO 2 STEP -1 IF MID$(d, i - 1, 1) = "\" THEN EXIT FOR NEXT d = LEFT$(d, i - 1) dn = getfiles(d$, df()) END IF ds = 0 dss = 0 CLS drawtabs drawdir ELSEIF RIGHT$(RTRIM$(df(ds + dss)), 1) = "\" THEN d = d + df(dss + ds) dn = getfiles(d$, df()) ds = 0 dss = 0 CLS drawtabs drawdir ELSEIF RIGHT$(RTRIM$(df(ds + dss)), 3) = "BAS" THEN t = t + 1 at = t tt(at) = 1 ef(at) = d + df(ds + dss) OPEN ef(at) FOR INPUT AS #1 FOR i = 1 TO 100 IF EOF(1) THEN EXIT FOR LINE INPUT #1, c(i, at) NEXT ms(at) = i CLOSE 'CLS 'drawtabs redit END IF END SELECT CASE ELSE SELECT CASE tt(at) CASE 1 ''''''''' redit DO k$ = INKEY$ SELECT CASE k$ CASE CHR$(0) + "M" IF ex(at) < 79 THEN ex(at) = ex(at) + 1 redit CASE CHR$(0) + "K" IF ex(at) > 0 THEN ex(at) = ex(at) - 1 redit CASE CHR$(0) + "P" IF ey(at) < 23 THEN ey(at) = ey(at) + 1 ELSE IF es(at) < ms(at) THEN es(at) = es(at) + 1 END IF redit CASE CHR$(0) + "H" IF ey(at) > 0 THEN ey(at) = ey(at) - 1 ELSE IF es(at) > 0 THEN es(at) = es(at) - 1 END IF redit CASE CHR$(8) IF ex(at) > 0 THEN ex(at) = ex(at) - 1 tt$ = c(ey(at) + es(at) + 1, at) c(ey(at) + es(at) + 1, at) = LEFT$(tt$, ex(at)) + RIGHT$(tt$, 79 - ex(at)) redit END IF CASE CHR$(13) IF ey(at) < 23 THEN ey(at) = ey(at) + 1 ELSE IF es(at) < ms THEN es(at) = es(at) + 1 END IF tt$ = RIGHT$(c(ey(at) + es(at), at), 80 - ex(at)) c(ey(at) + es(at), at) = LEFT$(c(ey(at) + es(at), at), ex(at)) FOR i = ms(at) - 1 TO (ey(at) + es(at) + 1) STEP -1 c(i + 1, at) = c(i, at) NEXT c(ey(at) + es(at) + 1, at) = tt$ ex(at) = 0 redit CASE CHR$(32) TO CHR$(128) ex(at) = ex(at) + 1 tt$ = RIGHT$(c(ey(at) + es(at) + 1, at), 81 - ex(at)) MID$(c(ey(at) + es(at) + 1, at), ex(at)) = k$ + tt$ redit END SELECT k$ = RIGHT$(k$, 1) IF k$ <> "" THEN IF (ASC(k$) > 58) AND (ASC(k$) < (59 + t)) THEN at = ASC(k$) - 58 drawtabs IF at = 1 THEN CLS drawtabs drawdir EXIT DO ELSE SELECT CASE tt(at) CASE 1 CLS drawtabs redit END SELECT EXIT DO END IF END IF END IF IF INP(&H60) = 1 THEN SYSTEM LOOP ''''''''' END SELECT END SELECT LOOP UNTIL INP(&H60) = 1 SYSTEM SUB drawdir FOR i = 0 TO 23 IF (i + ds) > (dn - 1) THEN EXIT FOR LOCATE i + 2, 1 IF dss = i THEN COLOR 0, 7 ELSE COLOR 7, 0 PRINT df(i + ds) + SPACE$(13 - LEN(df(i + ds))); COLOR 7, 0 NEXT LOCATE 2, 20 PRINT d + SPACE$(60 - LEN(d)) END SUB DEFSNG A-Z SUB drawtabs COLOR 0, 7 LOCATE 1, 1 PRINT SPACE$(80); FOR i = 1 TO t LOCATE 1, ((80 \ t) * i) - (80 \ t \ 2) PRINT LTRIM$(STR$(i)); NEXT COLOR 0, 4 i = (80 \ t) * (at - 1) IF i < 1 THEN i = 1 LOCATE 1, i PRINT SPACE$(80 \ t) LOCATE 1, ((80 \ t) * at) - (80 \ t \ 2) PRINT LTRIM$(STR$(at)); COLOR 7, 0 END SUB DEFINT A-Z FUNCTION getfiles (pp$, arr() AS STRING) DEF SEG = VARSEG(f(0)) p$ = pp$ + "*.*" + CHR$(0) ax = &H4E00 CALL absolute(ax, BYVAL 16, BYVAL SADD(p$), VARPTR(f(5))) FOR i = 0 TO UBOUND(arr) - 1 ax = &H4F00 CALL absolute(ax, 0, 0, VARPTR(f(5))) IF ax AND &HF <> 0 THEN EXIT FOR arr(i) = LEFT$(dta.fname, INSTR(dta.fname, CHR$(0)) - 1) + CHR$(32 + (dta.a = CHR$(16)) * -60) NEXT getfiles = i END FUNCTION SUB redit SCREEN , , 1, 0 VIEW PRINT 1 TO 25 CLS drawtabs FOR i = es(at) + 1 TO es(at) + 23 PRINT c(i, at); NEXT COLOR 0, 7 LOCATE ey(at) + 2, ex(at) + 1 PRINT CHR$(SCREEN(ey(at) + 2, ex(at) + 1)); COLOR 7, 0 PCOPY 1, 0 SCREEN , , 0, 0 END SUB
Free Web Hosting