home *** CD-ROM | disk | FTP | other *** search
/ CBM Funet Archive / cbm-funet-archive-2003.iso / cbm / demodisks / drives / 1581-demo.lzh / filecopy (.txt) < prev    next >
Commodore BASIC  |  1994-10-19  |  4KB  |  111 lines
  1. 11 f$="filecopy.bin":u=8
  2. 13 gosub9100:gosub9050
  3. 14 if f=0 then load f$,u,1:goto25
  4. 20 (NULL)1,1
  5. 21 (NULL)(f$),p(ba)onu(u):if(NULL)(0)<5then(NULL)0
  6. 25 gosub9000
  7. 40 input "[155]your source disk unit[146]  8[157][157][157]";su
  8. 50 input "[155]destination disk unit[146]  9[157][157][157]";du:print
  9. 60 : if su<4 or su>31 or du<4 or du>31 or su=du then 10
  10. 70 print "[155] enter template or <return> [146] ";:m$="":inputm$
  11. 72 w=0:ww=0:for i=1tolen(m$):if "*"=mid$(m$,i,1) then w=i:ww=ww+1
  12. 73 next: if ww>1 then print"[155]bad template": goto 120
  13. 74 w$=right$(m$,len(m$)-w)
  14. 80 dim n$(200),t$(200),ce(200):q$=chr$(34):e$=","
  15. 90 open14,su,15,"i": sc=14:u=sc: gosub8000: ifs then print"[155]"su":";s$: goto120
  16. 95 open15,du,15,"i": dc=15:u=dc: gosub8000: if s then print""du":";s$: goto120
  17. 100 gosub 9000: gosub 1000: gosub 2000
  18. 110 if k then gosub 9000: gosub 3000
  19. 120 print:print" more (y/n) ? [146] ";:gosub4000: if a$="n" then clr: end
  20. 130 clr:gosub9100:goto25
  21. 1000 rem  read directory into n$,t$: n=num files+1
  22. 1010 print "[155]reading directory.";
  23. 1020 n=0: f$="$": if len(m$)<>0 then f$="$:"+m$
  24. 1030 open 8,su,0,f$: u=sc: gosub8000
  25. 1035 : if s then print: print"";s$: close8: return
  26. 1040 get#8,a$,b$
  27. 1050 : get#8,a$,a$,a$,a$ :print ".";
  28. 1060 :   get#8,a$: if len(a$)=0 or st then 1130
  29. 1065 :   if asc(a$)=0 then 1130
  30. 1070 :   if a$<>q$ then 1060
  31. 1080 : get#8,a$: if a$<>q$ and st=0 then n$(n)=n$(n)+a$: goto 1080
  32. 1090 : get#8,a$: if a$=" " then 1090
  33. 1100 : t$(n)=t$(n)+a$: get#8,a$: if a$<>" " and st=0 then 1100
  34. 1110 : get#8,a$:a$=a$+chr$(0):if asc(a$)<>0 and st=0 then 1110
  35. 1116 : if n=0 or w=0 then 1120
  36. 1117 : if len(n$(n)) < (w-1+len(w$)) then n$(n)="":t$(n)="": goto 1050
  37. 1119 : if w$<>right$(n$(n), len(w$)) then n$(n)="":t$(n)="":goto1050
  38. 1120 : n=n+1: goto1050
  39. 1130 print:close 8: gosub8000: if s then print"...";s$
  40. 1140 print:print n-1;"files targeted" :print : return
  41. 2000 rem   display files & ask user which ones to copy
  42. 2010 k=0: if n<2 then print" no files found.":return
  43. 2020 for i=1ton-1:ce(i)=0
  44. 2030 : print q$;n$(i);q$;tab(19);t$(i);tab(25);: if m$<>"*" then 2070
  45. 2040 : print:ce(i)=1: k=k+1: next: print
  46. 2050 print " continue (y/n) ? [146] ";: gosub4000 :if a$="y" then return
  47. 2060 k=0: return
  48. 2070 print "copy ? (y/n) ";:gosub4000 :if a$="y" then ce(i)=1: k=k+1
  49. 2080 : next: return
  50. 3000 rem   copy the files
  51. 3010 for i=1ton-1:if ce(i)=0 then next: return
  52. 3020 :t$(i) = left$(t$(i),1): f$=q$+n$(i)+q$
  53. 3030 open9,du,9,n$(i): u=dc: gosub8000: close9
  54. 3040 : if s=62 then 3100
  55. 3050 : print f$;" exists, replace? ";: gosub4000:gosub 4500
  56. 3060 : if a$="n" then print f$;" not copied":next:return
  57. 3070 :   print  "scratching old ";f$
  58. 3080 :   print#15,"s0:";n$(i): gosub8000:gosub 4500:if s>1 then 3170
  59. 3090 :   goto 3030
  60. 3100 : if t$(i)="r" then gosub 5000:goto 3170:rem  copy rel files
  61. 3110 :  print "now copying ";f$
  62. 3120 :  open9,du,1,n$(i)+","+t$(i)+",w": u=dc: gosub8000 : if s then 3170
  63. 3140 :  open8,su,0,n$(i)+","+t$(i)+",r": u=sc: gosub8000 : if s then 3170
  64. 3160 :  sys ba: close 8: close 9:u=dc:gosub 8000
  65. 3170 :  if s then print "copy failed: [146]";s$ : goto 3180
  66. 3175 :  u=sc:gosub 8000
  67. 3176 :  if s then print "copy failed: [146]";s$
  68. 3180 next: return
  69. 4000 get a$: if a$<>"y" and a$<>"n" then 4000
  70. 4010 printa$: return
  71. 4500 print "[145]                                       "+chr$(13)+"[145]";:return
  72. 5000 rem   copy rel files.
  73. 5010 print "scanning ";f$
  74. 5020 open8,su,8,n$(i): u=sc: gosub 8000: if s then return
  75. 5030 l=0:for rn=7to0step-1:rg=2^rn: rem scan for reclen
  76. 5040 : r=1:l=l+rg:gosub 6000:if s then l=l-rg
  77. 5050 : next
  78. 5060 r=0:forrn=15to0step-1:rg=2^rn: rem scan for numrec
  79. 5070 : r=r+rg: gosub 6000: if s then r=r-rg
  80. 5080 : next
  81. 5100 gosub 4500:print "creating ";f$
  82. 5110 open9,du,9,n$(i)+",l,"+chr$(l)
  83. 5120 :  u=dc: gosub 8000: if s then return
  84. 5130 a$="p"+chr$(96+8)+chr$(1)+chr$(0)+chr$(1): print#14,a$: print#14,a$
  85. 5140 :  u=sc: gosub 8000: if s then return
  86. 5150 a$="p"+chr$(96+9)+chr$(rl)+chr$(rh)+chr$(1): print#15,a$: print#15,a$
  87. 5160 :  print#9,chr$(255);: rem write end record
  88. 5170 a$="p"+chr$(96+9)+chr$(1)+chr$(0)+chr$(1): print#15,a$: print#15,a$
  89. 5180 :  u=dc: gosub 8000: if s then return
  90. 5200 gosub 4500:print "now copying ";f$
  91. 5210 for rn=1tor: sysba: next
  92. 5220 close8: close9: u=dc: gosub 8000
  93. 5230 return
  94. 6000 rh=int(r/256):rl=r-rh*256 :rem  send src p cmd.  r=rec#, l=offset
  95. 6010 a$="p"+chr$(96+8)+chr$(rl)+chr$(rh)+chr$(l): print#14,a$: print#14,a$
  96. 6020 : u=sc: goto8000          :rem get disk stat and return
  97. 8000 input#u,a$,b$,c$,d$: s=val(a$): s$=a$+e$+b$+e$+c$+e$+d$ :return
  98. 9000 poke53280,0:poke53281,0:print"[147]";
  99. 9010 print"[155][176][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][174]
  100. 9020 [153]"list(NULL)  openfilecopy utility - v021887list (NULL)
  101. 9030 print"[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]":print
  102. 9040 return
  103. 9045 ifu=12thenprint"[155]"f$" "b$:end
  104. 9050 open15,u,15:open2,u,2,f$+",p,r":close2:input#15,a,b$,c,d
  105. 9055 close15:ifa>19thenu=u+1:goto9045
  106. 9060 return
  107. 9100 f=abs(peek(65533)=255)           :rem f=0 if c64, f=1 if c128
  108. 9101 if f=0 and ba=0 then ba=12*4096
  109. 9102 if f=1 and ba=0 then ba=(NULL)("c00")
  110. 9103 return
  111.