1: $cpu 80286 2: $com 2048 3: $compile exe "4.exe" 4: DECLARE SUB ExeC (oof$) 5: DECLARE SUB UnloadFont () 6: DECLARE SUB LoadFont (f$) 7: DECLARE SUB PRINT2 (t$, cv!) 8: DECLARE SUB Font (t$, cl!) 9: DECLARE SUB Errorr (Msg$) 10: DECLARE FUNCTION ReadLn$ (ln!) 11: DECLARE SUB Comport (Port$) 12: DECLARE SUB ClrBot () 13: DECLARE SUB Corr (n$) 14: DECLARE SUB ReadKey (prm$, t$, chrs!, brd$, rd!) 15: DECLARE FUNCTION GetPrmt$ (pt$) 16: DIM ENV(1 TO 500) AS shared STRING 17: DIM ENV1(1 TO 500) AS shared STRING 18: DIM mxenv AS shared INTEGER 19: SHARED wt$ 20: dim LastTyped AS shared STRING 21: DIM Lstln AS shared INTEGER 22: DIM HRes AS shared INTEGER 23: DIM txt(255) AS shared STRING 24: shared CPort$ 25: SHARED CMM 26: SHARED DFnt 27: SHARED CMmPrt 28: shared tmrr 29: shared Egaa 30: tmrr = 30 31: LoadFont "C:\ASCIN.FNT" 32: if ucase$(ltrim$(rtrim$(command$)))<>"EGA" then screen 12:HRes=1:DFnt=1:Lstln=30 else egaa=1 33: if ucase$(ltrim$(rtrim$(command$)))="EGA" then Screen 9:HRes = 1:DFnt = 1:LstLn=25:egaa=1 34: if ucase$(ltrim$(rtrim$(command$)))="TEXT" then screen 0:HRes=0:DFnt=0:Lstln=25 35: ver$ = "1.00" 36: PRINT 37: PRINT2 " RK-DOS Version " + ver$, 15 38: PRINT 39: ENV(1) = "$ $L$P$G" 40: ENV1(1) = "PATH" 41: mxenv = 1 42: nn = 0 43: OPEN "C:\YOUNICKS.FAT" for input as #4 44: wt$=curdir$ 45: 10 ReadKey GetPrmt(ENV(1)), cmd$, 70, Msg$, nn 46: wt$=curdir$ 47: cmd$ = LTRIM$(cmd$) 48: IF cmd$ = "" GOTO 10 49: IF MID$(cmd$, 1, INSTR(cmd$, " ")) = "" THEN ff$ = cmd$: cmdlne$ = "" ELSE ff$ = MID$(cmd$, 1, INSTR(cmd$, " ") - 1): cmdlne$ = MID$(cmd$, INSTR(cmd$, " ") + 1, LEN(cmd$) - INSTR(cmd$, " ")) 50: IF UCASE$(ff$) = "EXIT" THEN UnloadFont: END 51: if ucase$(ff$) = "FREE" then Print2 "Memmory left:"+str$(fre(-1))+" bytes",15:print:goto 10 52: if ucase$(ff$) = "SEND" then if cmdlne$="" then Print2 "Syntax: SEND msg",7:print :goto 10 else if cmm=1 then print #3,cmdlne$:goto 10 else print2 "Com port not open",7:Print "":goto 10 53: IF UCASE$(ff$) = "CLS" or ucase$(ff$)="CLEAR" THEN CLS : GOTO 10 54: IF UCASE$(ff$) = "PROMPT" THEN if cmdlne$="" then print2 ENV(1),7:print:goto 10 else ENV(1) = cmdlne$: GOTO 10 55: IF UCASE$(ff$) = "NOWAIT" THEN nn = 0: GOTO 10 56: IF UCASE$(ff$) = "WAIT" THEN IF cmdlne$ = "" THEN PRINT2 "WAIT message is"+Msg$, 7: PRINT : GOTO 10 ELSE nn = 1: Corr cmdlne$: Msg$ = cmdlne$: GOTO 10 57: IF UCASE$(ff$) = "DOS" THEN IF cmdlne$ = "" THEN PRINT2 "Syntax: DOS dos_prog", 7: PRINT : GOTO 10 ELSE ClrBot: SHELL (cmdlne$):wt$=curdir$: GOTO 10 58: IF UCASE$(ff$) = "COM_ON" THEN IF cmdlne$ = "" THEN PRINT2 "Syntax: COM_ON comport#: speed", 7: PRINT : GOTO 10 ELSE Comport cmdlne$:cmm=1: GOTO 10 59: IF UCASE$(ff$) = "LINES" THEN IF cmdlne$ <> "" AND (VAL(cmdlne$) = 25 OR VAL(cmdlne$) = 43 OR VAL(cmdlne$) = 50) THEN Screen 0:WIDTH 80, VAL(cmdlne$): Lstln = VAL(cmdlne$): HRes = 0: GOTO 10 ELSE PRINT2 "Syntax: LINES {25,43,50}", 7: PRINT:GOTO 10 60: IF UCASE$(ff$) = "LOWRES" THEN Lstln = 25: SCREEN 0: width 80,25:HRes = 0: GOTO 10 61: IF UCASE$(ff$) = "HIRES" AND HRes = 0 THEN Lstln = 30: SCREEN 12: HRes = 1: GOTO 10 62: IF UCASE$(ff$) = "VER" AND HRes = 1 THEN PRINT2 "RK-DOS Version " + ver$, 15: PRINT : PRINT : GOTO 10 63: IF UCASE$(ff$) = "VER" AND HRes = 0 THEN COLOR 15, 1: PRINT "RK-DOS Version " + ver$: PRINT : COLOR 7, 0: GOTO 10 64: IF UCASE$(ff$) = "FONT" THEN IF cmdlne$ <> "" AND (rtrim$(ltrim$(cmdlne$)) = "ON" OR rtrim$(ltrim$(cmdlne$)) = "OFF") THEN ExeC rtrim$(ltrim$(cmdlne$)): GOTO 10 ELSE PRINT2 "FONT is "+foro$, 7: PRINT : GOTO 10 65: if ucase$(ff$) = "LOADFONT" then if cmdlne$="" then print2 "Syntax: LOADFONT fontname",7:print :goto 10 else Unloadfont:LoadFont cmdlne$: goto 10 66: if ucase$(ff$) = "UNLOADFONT" then UnLoadFont: goto 10 67: if ucase$(ff$) = "MOVE" then if cmdlne$="" then print2 "X="+str$(csrlin-1)+" Y="+str$(pos(0)),7:print: goto 10 else locate val(mid$(cmdlne$,1,instr(cmdlne$," ")-1)),val(mid$(cmdlne$,instr(cmdlne$," ")+1,len(cmdlne$)-instr(cmdlne$," "))):goto 10 68: if ucase$(ff$) = "TERM" then gosub CMPRT:goto 10 69: if ucase$(ff$) = "COM_OFF" then if cmm=0 then print2 "Com port not open",7:print:goto 10 else close #3:cmm=0:com(cmmprt) off:goto 10 70: if ucase$(ff$) = "TIMER" then if cmdlne$="" then Print2 "TIMER ="+str$(tmrr),7:print:goto 10 else tmrr=val(cmdlne$):goto 10 71: if ucase$(ff$) = "DIR" then s$="dir "+cmdlne$:shell s$:s$="":goto 10'ListFls:goto 10 72: if mid$(ff$,1,3) = "!AT" then if cmm=0 then print2 "Com port not open",7:print else Print #3,mid$(ff$,2,len(ff$)-1)+ " "+cmdlne$ 73: if ucase$(ff$) = "AR" then Arch cmdlne$:goto 10 74: if ucase$(ff$) = "//?" then Hlppr:goto 10 75: PRINT2 "Unkown command:"+ ff$,7 76: PRINT 77: GOTO 10 78: 79: CMPRT: 80: if cmm=0 then Print2 "Com port not open",7:print:goto 121 81: Com (cmmprt) off 82: Connect 83: for q=1 to 39 84: Print2 chr$(219),8 85: print2 chr$(219),15 86: next q 87: print 88: 121 RETURN 89: 90: SUB ClrBot 91: x% = CSRLIN: y% = POS(0) 92: LOCATE Lstln, 1, 0 93: PRINT STRING$(80, 32); 94: LOCATE x%, y%, 1 95: END SUB 96: 97: SUB Comport (Port$) 98: close #3 99: f$ = "COM" + RTRIM$(LTRIM$(Port$)) 100: OPEN f$ AS #3 101: COM(VAL(Port$)) ON 102: ON COM(VAL(Port$)) GOSUB CMPRT 103: cmmprt=val(Port$) 104: cport$=port$ 105: END SUB 106: 107: SUB Corr (n$) 108: lnn$ = UCASE$(MID$(n$, 1, 1)) 109: FOR q = 2 TO LEN(n$) 110: IF MID$(n$, q, 1) = " " OR MID$(n$, q, 1) = chr$(255) THEN lnn$ = lnn$ + " ": GOTO 122 111: IF MID$(n$, q, 1) <> "&" AND cptl = 0 THEN lnn$ = lnn$ + LCASE$(MID$(n$, q, 1)) 112: IF cptl = 1 THEN lnn$ = lnn$ + UCASE$(MID$(n$, q, 1)): cptl = 0 113: IF MID$(n$, q, 1) = "." OR MID$(n$, q, 1) = "&" THEN cptl = 1 114: 122 NEXT q 115: n$ = lnn$ 116: 117: END SUB 118: 119: SUB Errorr (Msg$) 120: Print2 Msg$,14 121: END SUB 122: 123: SUB ExeC (oof$) 124: IF oof$ = "ON" THEN DFnt = 1 125: IF oof$ = "OFF" THEN DFnt = 0 126: END SUB 127: 128: SUB Font (t$, cl) 129: IF cl = -1 THEN ELSE f$ = "C" + LTRIM$(RTRIM$(STR$(cl))): DRAW "X" + VARPTR$(f$) 130: IF txt(32) = "" THEN LOCATE 1, 1: PRINT "System Error. Unable to continue.": END 131: FOR qww = 1 TO LEN(t$) 132: IF ASC(MID$(t$, qww, 1)) = 0 THEN DRAW "X" + VARPTR$(txt(32)) ELSE DRAW "X" + VARPTR$(txt(ASC(MID$(t$, qww, 1)))): DRAW "BL": GOTO 1011 133: 1011 NEXT qww 134: END SUB 135: 136: FUNCTION GetPrmt$ (pt$) 137: FOR q = 1 TO LEN(pt$) 138: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "P" THEN q = q + 1: mm$ = mm$ + wt$: GOTO nextl 139: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "G" THEN q = q + 1: mm$ = mm$ + ">": GOTO nextl 140: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "_" THEN q = q + 1: mm$ = mm$ + CHR$(10)+chr$(13): GOTO nextl 141: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "T" THEN q = q + 1: mm$ = mm$ + TIME$: GOTO nextl 142: IF MID$(pt$, q, 1) = "$" AND UCASE$(MID$(pt$, q + 1, 1)) = "D" THEN q = q + 1: mm$ = mm$ + DATE$: GOTO nextl 143: if mid$(pt$,q,1)="$" and ucase$(mid$(pt$,q+1,1))="L" then q=q+1:mm$=mm$+"<":goto nextl 144: mm$ = mm$ + MID$(pt$, q, 1) 145: nextl: 146: NEXT q 147: GetPrmt$ = mm$ 148: END FUNCTION 149: 150: SUB LoadFont (f$) 151: open f$ for random as #1 152: if lof(1)=0 then close 1:MakFnt f$ else close 1 153: if egaa=1 then screen 9 else screen 12 154: OPEN f$ FOR INPUT AS #1: t = 0 155: DO UNTIL EOF(1) 156: LINE INPUT #1, a$ 157: txt(t) = a$ 158: t = t + 1 159: LOOP 160: CLOSE 1 161: END SUB 162: 163: SUB PRINT2 (t$, cv) 164: IF HRes = 1 AND DFnt = 1 THEN ELSE GOTO 2111 165: x = -2: y = -2 166: IF x = -2 THEN x = (POS(0) * 8) - 7: g = -2 167: IF y = -2 THEN y = CSRLIN * 16: n = -2 168: d$ = "BM" + LTRIM$(RTRIM$(STR$(x))) + "," + LTRIM$(RTRIM$(STR$(y))) + " C" + LTRIM$(RTRIM$(STR$(cv))) 169: 3 DRAW "X" + VARPTR$(d$) 170: Font t$, cv 171: IF LEN(t$) >= 80 THEN EXIT SUB 172: LOCATE CSRLIN, POS(0) + LEN(t$) 173: if csrlin=lstln then clrbot:print:locate lstln-1,1 174: if pos(0)=80 then print 175: EXIT SUB 176: 2111 COLOR cv 177: PRINT t$; 178: END SUB 179: 180: SUB ReadKey (prm$, t$, chrs, brd$, rd) 181: brd$=ltrim$(rtrim$(brd$)) 182: if csrlin=lstln then clrbot:print:locate lstln-1,1 183: t$ = "" 184: PRINT2 prm$, 7 185: DO UNTIL i$ = CHR$(13) OR i$ = CHR$(27) 186: if q=tmrr and mid$(brd$,1,2)="$$" then t$=mid$(brd$,3,len(brd$)-2) : Print2 t$,7:print:clrbot:exit sub 187: IF q = tmrr and mid$(brd$,1,2)<>"$$" THEN IF POS(0) > 1 THEN PRINT : PRINT2 "Computer>" + brd$, 7: print:q = 0: PRINT2 prm$ + t$, 7: ELSE PRINT "IS2000>"; TAB(10); brd$: : q = 0: PRINT2 prm$ + t$, 7 188: IF i$ = CHR$(8) THEN IF LEN(t$) = 0 THEN i$ = "": GOTO 60 ELSE t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1 189: i$ = UCASE$(INKEY$) 190: x% = CSRLIN: y% = POS(0) 191: IF TIME$ <> oldtm$ AND HRes = 0 THEN COLOR 15, 1: LOCATE Lstln, 1, 0: PRINT TIME$; STRING$(80 - LEN(TIME$), 32); : COLOR 7, 0: LOCATE x%, y%, 1: oldtm$ = TIME$: IF q < tmrr AND rd = 1 THEN q = q + 1 192: IF TIME$ <> oldtm$ AND HRes = 1 THEN COLOR 15: LOCATE Lstln, 1, 0: PRINT TIME$ + STRING$(80 - LEN(TIME$), 32); : COLOR 7: LOCATE x%, y%, 1: oldtm$ = TIME$: IF q < tmrr AND rd = 1 THEN q = q + 1 193: 194: IF i$ = "" THEN GOTO 60 195: IF i$ = CHR$(0) + "=" THEN GOSUB 1009 196: if i$ = chr$(0) + ";" then SCRNSVR : cls : print2 prm$+t$,7 197: oldtm$ = TIME$ 198: q = 0 199: IF (ASC(i$) > -1 AND ASC(i$) < 32) THEN GOTO 60 200: IF i$ = CHR$(13) OR i$ = CHR$(27) THEN GOTO 70 201: IF HRes = 1 THEN PRINT2 UCASE$(i$), 7 202: IF HRes = 0 THEN PRINT UCASE$(i$); 203: t$ = t$ + i$ 204: IF LEN(t$) >= chrs THEN t$ = MID$(t$, 1, LEN(t$) - 1): LOCATE CSRLIN, POS(0) - 1: PRINT " "; : LOCATE CSRLIN, POS(0) - 1 205: 60 LOOP 206: 70 PRINT2 "", 7 207: LastTyped = t$ 208: if csrlin=Lstln-1 or csrlin=lstln then ClrBot:locate lstln,1 :print:locate lstln-1,1 else print 209: EXIT SUB 210: 211: 1009 t$ = t$ + MID$(LastTyped, 1, chrs - LEN(t$) - 1) 212: LOCATE CSRLIN, LEN(prm$) + 1, 1: PRINT2 t$, 7 213: RETURN 214: END SUB 215: 216: FUNCTION ReadLn$ (ln) 217: FOR q = 1 TO 80 218: mm$ = mm$ + CHR$(SCREEN(ln, q)) + CHR$(SCREEN(ln, q, 1)) 219: NEXT q 220: ReadLn$ = mm$ 221: END FUNCTION 222: 223: SUB UnloadFont 224: FOR q = 0 TO 255 225: txt(q) = "" 226: NEXT q 227: END SUB 228: 229: SUB WriteLn (Msg$, ln, bg) 230: x% = CSRLIN: y% = POS(0) 231: IF ln = 0 OR ln > 25 THEN EXIT SUB 232: LOCATE ln, 1, 0 233: FOR q = 1 TO LEN(Msg$) STEP 2 234: COLOR ASC(MID$(Msg$, q + 1, 1)), bg 235: PRINT MID$(Msg$, q, 1); 236: NEXT q 237: LOCATE x%, y%, 1 238: END SUB 239: 240: SUB connect 241: if cmm=0 then print2 "Com port not open",7:print:exit sub 242: Print2 "Terminal Emulation",14:print 243: DO UNTIL ch$ = CHR$(27) 244: ch$ = INKEY$ 245: if ch$=chr$(13) then ch$=chr$(13)+chr$(10) 246: IF ch$ <> "" THEN PRINT #3, ch$; 247: IF LOC(3) <> 0 THEN inchar$ = INPUT$(1, #3) ELSE inchar$ = "" 248: IF inchar$ = CHR$(8) AND POS(0) > 1 THEN 249: LOCATE csrlin, POS(0) - 1 250: PRINT " "; 251: LOCATE csrlin, POS(0) - 1 252: ELSEIF inchar$ = CHR$(8) AND POS(0) = 1 AND CSRLIN > 1 THEN 253: LOCATE CSRLIN - 1, 79 254: PRINT " "; 255: LOCATE , POS(0) - 1 256: end if 257: if inchar$=chr$(8) then inchar$="" 258: if pos(0)=79 then print 259: IF inchar$ = CHR$(13) then locate csrlin,1 ELSE if inchar$=chr$(10) then cxx%=pos(0):print:locate csrlin,cxx%:cxx%=0 else Print2 inchar$,14 260: 'IF inchar$ = CHR$(168) THEN END 261: LOOP 262: print #3,"+++" 263: PRINT #3, "ATH" 264: PRINT #3, "ATS0=0" 265: print 266: Print2 "Flushing com port buffer",8:print 267: close #3 268: cmm=0 269: cmm=1 270: delay 1 271: Comport cport$ 272: END SUB 273: 274: sub MakFnt (f$) 275: SCREEN 9: CLS 276: OPEN f$ FOR OUTPUT AS #1 277: FOR c = 0 TO 31: PRINT #1, "": NEXT c 278: FOR q = 32 TO 170 279: IF q = 0 THEN d = 32 ELSE d = q 280: LOCATE 1, 1: PRINT CHR$(d); 281: GetFnt 33, 15, 33, lt$ 282: CLS 283: tt = LEN(lt$) + tt 284: IF tt > 25000 THEN CLOSE 1:Exit sub 285: PRINT #1, lt$ 286: DRAW "X" + VARPTR$(lt$) 287: NEXT q 288: CLOSE 1 289: end sub 290: 291: SUB GetFnt (a, bg, os, f$) 292: 'LINE (d * 8, m)-((d + 1) * 8, 15 + m), 1, B 293: d = a - os: u = 15: r = 0 294: FOR x = (d) * 8 TO (1 + d) * 8 295: FOR y = 0 + m TO 15 + m 296: u = u - 1 297: IF POINT(x, y) = bg THEN ELSE GOTO 310 298: uh$ = LTRIM$(RTRIM$(STR$(u))) 299: ur$ = LTRIM$(RTRIM$(STR$(u - 1))) 300: lt$ = lt$ + "BU" + uh$ + "DBD" + ur$ 301: PSET (x, y), 14 302: 310 NEXT y 303: r = r + 1: u = 15 304: lt$ = lt$ + "br" 305: NEXT x 306: f$ = lt$ 307: END SUB 308: 309: sub Hlppr 310: print2 "-- COMMANDS --",15:print 311: dchk 312: print2 "EXIT - Quits RK-DOS",1:print 313: dchk 314: print2 "FREE - Displays the amount of free low memmory",2:print 315: dchk 316: print2 "SEND - Sends text to an open com port",3:print 317: dchk 318: print2 "CLS - Clears the screen",4:print 319: dchk 320: print2 "NOWAIT - Turns off the reminder",5:print 321: dchk 322: print2 "WAIT - Turns on the reminder",6:print 323: dchk 324: print2 "PROMPT - Changes the prompt",7:print 325: dchk 326: print2 "DOS - Runs a dos program",8:print 327: dchk 328: print2 "LINES - Changes the number of lines on the screen",9:print 329: dchk 330: print2 "COM_ON - Opens a com port",10:print 331: dchk 332: print2 "LOWRES - Changes to text mode",11:print 333: dchk 334: print2 "HIRES - Changes to VGA graphics mode",12:print 335: dchk 336: print2 "VER - Displays the RK-DOS version",13:print 337: dchk 338: print2 "FONT - Turns the Font on or off",14:print 339: dchk 340: print2 "LOADFONT - Loads a font",15:print 341: dchk 342: print2 "UNLOADFONT - Unloads the font from memmory",14:print 343: dchk 344: print2 "MOVE - Moves to a line and position on the screen",13:print 345: dchk 346: print2 "TERM - Activates the terminal emulation",12:print 347: dchk 348: print2 "COM_OFF - Closes the open com port",11:print 349: dchk 350: print2 "TIMER - Sets the timer for the WAIT statement",10:print 351: dchk 352: end sub 353: 354: SUB SCRNSVR 355: if hres=1 then else goto 102 356: cls 357: rot=240-45 358: if rtrim$(ltrim$(lcase$(command$)))="ega" then screen 9:mma=25:ht=100 else SCREEN 12:mma=30:ht=200 359: SZ = 200 360: 'HT = 200 361: WZ = 0 362: DO UNTIL INKEY$ = CHR$(13) 363: QW = RND * 43 + 1 364: QW = WZ * 5 365: FOR AD = 0 TO 16 366: LINE (320 - SZ + QW, ROT + HT + AD)-(320 + SZ - QW, 240 + HT + AD), 2 367: NEXT AD 368: IF WZ < 39 AND D = 0 THEN WZ = WZ + 1 ELSE D = 1 369: IF WZ > 0 AND D = 1 THEN WZ = WZ - 1 ELSE D = 0 370: LOCATE mma, 1: PRINT "" 371: LOOP 372: exit sub 373: 102 cls 374: a$= chr$(176)+chr$(177)+chr$(178)+chr$(219)+chr$(219)+chr$(178)+chr$(177)+chr$(176) 375: b$= chr$(219)+chr$(178)+chr$(177)+chr$(176)+chr$(176)+chr$(177)+chr$(178)+chr$(219) 376: for q=1 to 10 377: f$=f$+a$ 378: g$=g$+b$ 379: next q 380: color 15,1 381: locate ,,0 382: do until inkey$=chr$(13) 383: print f$; 384: delay .1 385: print g$; 386: delay .1 387: loop 388: color 7,0 389: locate ,,1 390: end sub 391: 392: SUB DCHK 393: if csrlin=lstln-1 or csrlin=lstln then locate lstln,1:print:locate lstln-1,1 394: end sub 395: 396: FUNCTION FORO$ 397: if DFnt=1 then FORO$="on" 398: if DFnt=0 then FORO$="off" 399: end function 400: 401: SUB WriteFat (f$, ext$, hh, mm, dd, mn, yy) 402: f$ = f$ + STRING$(8, 32): f$ = MID$(f$, 1, 8) 403: ext$ = ext$ + " ": ext$ = MID$(ext$, 1, 3) 404: tt$ = f$ + ext$ + CHR$(hh) + CHR$(mm) + CHR$(dd) + CHR$(mn) + CHR$(yy) 405: CLOSE 4 406: open "C:\YOUNICKS.FAT" for input as #4 407: do until eof(4) 408: line input #4,ff$ 409: if ucase$(ff$)=ucase$(tt$) then exst=1:close 4:goto 111 410: loop 411: close 4 412: OPEN "C:\YOUNICKS.FAT" FOR APPEND AS #4 413: PRINT #4, tt$ 414: CLOSE 4 415: 111 OPEN "C:\YOUNICKS.FAT" FOR INPUT AS #4 416: END SUB 417: 418: SUB ListFls 419: lbl$=dir$("*.*",8) 420: print " Label in drive C is "+lbl$ 421: do until eof(4) 422: line input #4,ffm$ 423: f$=mid$(ffm$,1,8) 424: ext$=mid$(ffm$,9,3) 425: hh$=rtrim$(ltrim$(str$(asc(mid$(ffm$,11,1))))) 426: mm$=rtrim$(ltrim$(str$(asc(mid$(ffm$,12,1))))) 427: dd$=rtrim$(ltrim$(str$(asc(mid$(ffm$,13,1))))) 428: mn$=rtrim$(ltrim$(str$(asc(mid$(ffm$,14,1))))) 429: yy$=rtrim$(ltrim$(str$(asc(mid$(ffm$,15,1))))) 430: if len(hh$)=1 then hh$="0"+hh$ 431: if len(mm$)=1 then mm$="0"+mm$ 432: if len(dd$)=1 then dd$="0"+dd$ 433: if len(mn$)=1 then mn$="0"+mn$ 434: if len(yy$)=1 then yy$="0"+yy$ 435: print2 f$+" "+ext$+" "+hh$+":"+mm$+" "+dd$+"/"+mn$+"/"+yy$,7:print 436: loop 437: RestFat 438: print 439: end sub 440: 441: sub RestFat 442: close 4 443: open "C:\YOUNICKS.FAT" for input as #4 444: end sub 445: 446: sub arch (dd$) 447: dim b as string * 1 448: if instr(dd$,"-")= 0 or dd$="" or instr(dd$,"A:") = 0 then print2 "Syntax: AR -{l|a|r} A:archive [F:file] ",7:print:exit sub else arcc$=mid$(dd$,instr(dd$,"A:")+2,len(dd$)-2-instr(instr(dd$,"A:"),dd$," ")) 449: if instr(dd$,"F:")=0 then fspc$="*.*" else fspc$=mid$(dd$,instr(dd$,"F:")+2,12) 450: crf$=dir$(fspc$) 451: if instr(arcc$,".")=0 then arcc$=arcc$+".A" 452: print2 "Opening archive "+arcc$,7:print 453: open arcc$ for binary as #5 454: if mid$(dd$,instr(dd$,"-")+1,1)="A" then goto 12 455: if mid$(dd$,instr(dd$,"-")+1,1)="L" then goto 13 456: if mid$(dd$,instr(dd$,"-")+1,1)="R" then goto 14 457: print2 "Invaild switch: "+mid$(dd$,instr(dd$,"-"),2) ,7:print:close 5:exit sub 458: 12 do until crf$="" 459: print2 "Proccessing "+crf$,7:print 460: open crf$ for binary as #6 461: put #5,,crf$ 462: ddd=lof(6) 463: put #5,,ddd 464: for q=0 to lof(6) 465: get #6,q,b 466: put #5,,b 467: next q 468: close 6 469: crf$=dir$ 470: loop 471: close 5 472: exit sub 473: 13 Print "Not availble yet (L)" 474: close 5 475: exit sub 476: 14 Print "Not availble yet (R)" 477: close 5 478: end sub |