home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / qb_pds / advbas / monkey / monkey.bas next >
Encoding:
BASIC Source File  |  1988-03-14  |  4.1 KB  |  126 lines
  1.    REM  Disk Monkey v1.4  Public Domain  Thomas G. Hanlin III
  2.    REM  Requires the shareware ADVBAS library to compile
  3.  
  4.    DEFINT A-Z
  5.    DEF fnf$ (x) = RIGHT$("0" + MID$(STR$(x), 2), 2)
  6.  
  7.    seekattr = 23 ' seek read-only, normal, hidden, system, and directory files
  8.  
  9.    cmd$ = COMMAND$
  10.    IF cmd$ = "" THEN GOTO BadMonkey
  11.  
  12.    i = INSTR(cmd$, " ")
  13.    IF i THEN fil$ = LEFT$(cmd$, i - 1): cmd$ = MID$(cmd$, i + 1) ELSE fil$ = cmd$: GOTO DoIt
  14.  
  15.    i = INSTR(cmd$, " ")
  16.    IF i THEN parm1$ = LEFT$(cmd$, i - 1): cmd$ = MID$(cmd$, i + 1) ELSE parm1$ = cmd$: GOTO DoIt
  17.  
  18.    i = INSTR(cmd$, " ")
  19.    IF i THEN parm2$ = LEFT$(cmd$, i - 1): parm3$ = MID$(cmd$, i + 1) ELSE parm2$ = cmd$
  20.  
  21. DoIt:
  22.    IF parm1$ = "" THEN GOTO Display
  23.    IF INSTR(parm1$, "/") THEN p$ = parm1$: GOSUB ExtractDate ELSE IF INSTR(parm1$, ":") THEN p$ = parm1$: GOSUB ExtractTime ELSE p$ = parm1$: GOSUB ExtractAttr
  24.  
  25.    IF parm2$ = "" THEN GOTO Display
  26.    IF INSTR(parm2$, "/") THEN p$ = parm2$: GOSUB ExtractDate ELSE IF INSTR(parm2$, ":") THEN p$ = parm2$: GOSUB ExtractTime ELSE p$ = parm2$: GOSUB ExtractAttr
  27.  
  28.    IF parm3$ = "" THEN GOTO Display
  29.    IF INSTR(parm3$, "/") THEN p$ = parm3$: GOSUB ExtractDate ELSE IF INSTR(parm3$, ":") THEN p$ = parm3$: GOSUB ExtractTime ELSE p$ = parm3$: GOSUB ExtractAttr
  30.  
  31. Display:
  32.    fil$ = fil$ + CHR$(0)
  33.    CALL FindFirstF(fil$, seekattr, ercd)
  34.    IF ercd THEN CALL upcase(fil$): PRINT "No such file as "; fil$: END
  35.    WHILE ercd = 0
  36.       GOSUB DisplayFile
  37.       CALL FindNextF(ercd)
  38.    WEND
  39.    END
  40.  
  41. BadMonkey:
  42.    PRINT "Disk Monkey v1.4      Public Domain 03/14/88    by Thomas Hanlin III"
  43.    PRINT
  44.    PRINT "Allows you to monkey with file date, time, and attributes."
  45.    PRINT
  46.    PRINT "Format: MONKEY filename.ext [date] [time] [attributes]"
  47.    PRINT "Filename may include wildcards.  Date/time/attr may be in any order."
  48.    PRINT "Attributes: N normal, H hidden, S system, D directory, R read-only, A archive."
  49.    END
  50.  
  51. ExtractTime:
  52.    i = INSTR(p$, ":")
  53.    hour = VAL(p$)
  54.    p$ = MID$(p$, i + 1)
  55.    minute = VAL(p$)
  56.    i = INSTR(p$, ":")
  57.    IF i THEN second = VAL(MID$(p$, i + 1))
  58.    stime = -1
  59.    RETURN
  60.  
  61. ExtractDate:
  62.    i = INSTR(p$, "/")
  63.    month = VAL(p$)
  64.    p$ = MID$(p$, i + 1)
  65.    day = VAL(p$)
  66.    i = INSTR(p$, "/")
  67.    IF i THEN year = VAL(MID$(p$, i + 1)) ELSE year = VAL(MID$(DATE$, 7))
  68.    sdate = -1
  69.    RETURN
  70.  
  71. ExtractAttr:
  72.    attr = 0
  73.    CALL upcase(p$)
  74.    IF INSTR(p$, "R") THEN attr = attr + 1
  75.    IF INSTR(p$, "H") THEN attr = attr + 2
  76.    IF INSTR(p$, "S") THEN attr = attr + 4
  77.    IF INSTR(p$, "D") THEN attr = attr + 16
  78.    IF INSTR(p$, "A") THEN attr = attr + 32
  79.    sattr = -1
  80.    RETURN
  81.  
  82. DisplayFile:
  83.    ky$ = INKEY$
  84.    IF ky$ = CHR$(19) THEN WHILE INKEY$ = "": WEND  '  handle CTRL-S for pause
  85.  
  86.    dname$ = SPACE$(12)
  87.    CALL GetNameF(dname$, dlen)
  88.    CALL GetTimeF(dhour, dmin, dsec)
  89.    CALL GetDateF(dmonth, dday, dyear)
  90.    CALL GetAttrF(dattr)
  91.  
  92.    PRINT dname$; "   "; fnf$(dmonth); "/"; fnf$(dday); "/"; fnf$(dyear); "   ";
  93.    PRINT fnf$(dhour); ":"; fnf$(dmin); ":"; fnf$(dsec); "   ";
  94.    pattr = dattr: GOSUB DisplayAttr
  95.  
  96.    IF NOT (sdate OR stime OR sattr) THEN RETURN
  97.  
  98.    dname$ = LEFT$(dname$, dlen) + CHR$(0)
  99.    PRINT "   ------>     ";
  100.  
  101.    IF sdate AND NOT stime THEN hour = dhour: minute = dmin: second = dsec
  102.    IF stime AND NOT sdate THEN day = dday: month = dmonth: year = dyear
  103.  
  104.    IF sdate OR stime THEN _
  105.       foo = month:_
  106.       CALL setftd(dname$, month, day, year, hour, minute, second):_
  107.       month = foo
  108.    IF sdate THEN PRINT fnf$(month); "/"; fnf$(day); "/"; fnf$(year); "   "; ELSE PRINT SPACE$(11);
  109.    IF stime THEN PRINT fnf$(hour); ":"; fnf$(minute); ":"; fnf$(second); "   ";  ELSE PRINT SPACE$(11);
  110.  
  111.    IF NOT sattr THEN PRINT : PRINT : RETURN
  112.    IF sattr THEN CALL SetFattr(dname$, attr)
  113.    pattr = attr: GOSUB DisplayAttr
  114.    PRINT
  115.    RETURN
  116.  
  117. DisplayAttr:
  118.    IF pattr = 0 THEN PRINT "N";
  119.    IF pattr AND 1 THEN PRINT "R";
  120.    IF pattr AND 2 THEN PRINT "H";
  121.    IF pattr AND 4 THEN PRINT "S";
  122.    IF pattr AND 16 THEN PRINT "D";
  123.    IF pattr AND 32 THEN PRINT "A";
  124.    PRINT
  125.    RETURN
  126.