ちょっとは面白い ファイルコピープログラム <全ソースリスト>　for 標準BASIC
1 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
2 '
3 ' BASIC専用
4 ' 特定ディレクトリ間
5 ' コピープログラム
6 '
7 ' 1987年10月24日 03時08分 制作
8 '
9 ' プログラム制作 不破 秀夫
10 '
11 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
12 '
13 ' kill "copy": save "copy"
14 '
100 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
110 ' 初期化
120 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
130 option screen 4
140 clear &H4000
150 '
160 init "mem:128,0"
170 OFFSET=&H4000
180 S_DRV$="1:"
190 D_DRV$="2:"
200 F$=""
210 '
220 on error goto *ERROR
230 cls
240 print tab(10);"BASIC専用コピープログラム"
250 print "コピー元をドライブ";akcnv$(S_DRV$);"に入れてください。"
260 print "コピー先をドライブ";akcnv$(D_DRV$);"に入れてください。"
270 '
280 ' ------ コピーを行うディレクトリの入力 ------
290 '
300 *INPUT_DIR
310 repeat
320 locate 0,4
330 print "コピー元のディレクトリ名を入力して下さい。"
340 input " ルートディレクトリの場合は .. です。";S_DIR$
350 print "コピー先のディレクトリ名を入力して下さい。"
360 input " コピー元と同じディレクトリ名のときはそのままリターンキー";D_DIR$
370 input "以上の事柄に間違いはありませんね。(Y or N)";OK$
380 until (OK$="y" or OK$="Y")
390 if S_DIR$="" then *INPUT_DIR
400 if S_DIR$=".." then S_DEV$=S_DRV$ else S_DEV$=S_DRV$+S_DIR$+"/"
410 if D_DIR$="" then D_DIR$=S_DIR$
420 if D_DIR$=".." then D_DEV$=D_DRV$ else D_DEV$=D_DRV$+D_DIR$+"/"
430 console 12,13
440 '
450 ' ------ ディレクトリ情報取り込み ------
460 '
470 locate 20,10
480 print [4] "ディレクトリ情報転送中"
490 color 0
500 files S_DEV$+F$
510 color 7
520 for I=&H0 to &H7FF
530 poke I+OFFSET,peek(I+&H1000)
540 next
550 locate 20,10
560 print [4] "ディレクトリ情報転送終了"
570 '
580 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
590 '
600 ' コピープログラムメイン部
610 '
620 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
630 '
640 locate 20,10
650 print [3] "ファイルの転送中"
660 locate 0,11
670 print " ファイル名 ファイル長 実行アドレス 読み込みアドレス"
680 cls
690 for I=0 to 63
700 F_P=I*&H20+OFFSET
710 P=F_P
720 '
730 ' ----- ファイルの種類の取り出し -----
740 '
750 F_MODE=peek(P)
760 if F_MODE>0 and F_MODE<5 then
770 P=P+1
780 '
790 ' ----- 目的のファイルネームの取り出し -----
800 '
810 F_NAME$=""
820 while peek(P)<>13
830 F_NAME$=F_NAME$+chr$(peek(P))
840 P=P+1
850 wend
860 LOAD_ADDRESS=peek(F_P+&H16)+peek(F_P+&H17)*256
870 '
880 ' ------ ファイル長の取り出し ------
890 '
900 LENGTH_L=peek(F_P+&H14)
910 LENGTH_H=peek(F_P+&H15)
920 ' if LENGTH_L<>0 then LENGTH_L=0:LENGTH_H=LENGTH_H+1
930 LENGTH=LENGTH_L+LENGTH_H*256
940 '
950 START_ADDRESS=peek(F_P+&H18)+peek(F_P+&H19)*256
960 LENGTH$=akcnv$(right$("0000"+hex$(LENGTH),4))
970 START$=akcnv$(right$("0000"+hex$(START_ADDRESS),4))
980 LOAD$=akcnv$(right$("0000"+hex$(LOAD_ADDRESS),4))
990 '
1000 ' ----- ファイルの読み込み -----
1010 '
1020 print [5] using " & & & & & & & & 読み込み中";F_NAME$,LENGTH$,START$,LOAD$
1030 '
1040 ER=0
1050 on F_MODE gosub *BLOAD,*BLOAD,*OPENI,*OPENRI
1060 if ER=40 or ER=5 then
1070 print [6] using " & & ";F_NAME$;:print [6] "これではコピーできません "
1080 else
1090 '
1100 ' ----- ファイルの書き込み -----
1110 '
1120 print [3] using " & & & & & & & & 書き込み中";F_NAME$,LENGTH$,START$,LOAD$
1130 '
1140 ER=0
1150 on F_MODE gosub *BSAVE,*BSAVE,*OPENO,*OPENRO
1160 if ER=42 then
1170 print [6] using " & & ";F_NAME$;:print [6] "同じファイル名が存在します "
1180 else
1190 '
1200 print [4] using " & & & & & & & & 転送終了";F_NAME$,LENGTH$,START$,LOAD$
1210 end if
1220 end if
1230 end if
1240 next
1250 '
1260 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
1270 ' 終了処理
1280 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
1290 '
1300 print [4] "ファイルの転送は総て終わりました。"
1310 print [4] "御苦労様でした。"
1320 '
1330 ' ------ bload & bsave が正常に出来るように元のデータに戻す ------
1340 '
1350 poke &H3A63,&H1: poke &H3C25,&H1
1360 '
1370 console 0,25:locate 0,24
1380 clear max
1390 end
1400 '
1410 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
1420 ' エラー処理
1430 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
1440 '
1450 *ERROR
1460 if err=42 and erl=1980 then ER=42:resume 2000
1470 if err=42 then ER=42:resume next
1480 if err=5 and erl=1900 then ER=5:resume next
1490 on error goto 0
1500 '
1510 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
1520 ' サブルーチン
1530 ' ＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝＝
1540 '
1550 ' --------------------------------------------------
1560 ' bload & bsaveで読み書き出来るファイルモードの変更
1570 '
1580 '
1590 ' 3A63番地 bload時のファイル種類を確認するデータが書き込まれている場所
1600 ' 3C25番地 bsave時のファイル種類を確認するデータが書き込まれている場所
1610 '
1620 ' 上記のアドレスに書き込むデータ
1630 '
1640 ' 1=機械語ファイルの場合
1650 ' 2=BASICテキストファイルの場合
1660 '
1670 ' --------------------------------------------------
1680 '
1690 '
1700 ' －－－－ BASICテキスト ＆ 機械語ファイルの読み込み －－－－
1710 *BLOAD
1720 poke &H3A63,F_MODE
1730 bload S_DEV$+F_NAME$,OFFSET+&H1000
1740 poke &H3A63,1
1750 return
1760 '
1770 ' －－－－ ＢＡＳＩＣテキスト ＆ 機械語ファイルの書き込み －－－－
1780 '
1790 *BSAVE
1800 poke &H3C25,F_MODE
1810 bsave D_DEV$+F_NAME$,OFFSET+&H1000,LENGTH,START_ADDRESS,LOAD_ADDRESS
1820 poke &H3C25,1
1830 return
1840 '
1850 ' －－－－ シーケンシャルファイルの読み込み －－－－
1860 '
1870 *OPENI
1880 open "i",#1,S_DEV$+F_NAME$
1890 open "o",#2,"mem:"+F_NAME$
1900 if eof(#1)=0 then line input #1,A$:print #2,A$:goto 1900
1910 close
1920 return
1930 '
1940 ' －－－－ シーケンシャルファイルの書き込み －－－－
1950 '
1960 *OPENO
1970 open "i",#1,"mem:"+F_NAME$
1980 open "o",#2,D_DEV$+F_NAME$
1990 if eof(#1)=0 then line input #1,A$:print #2,A$:goto 1990
2000 close
2010 kill "mem:"+F_NAME$
2020 return
2030 '
2040 ' －－－－ ランダムファイルの読み込み －－－－
2050 '
2060 *OPENRI
2070 open "r",#1,S_DEV$+F_NAME$,32
2080 open "r",#2,"mem:"+F_NAME$,32
2090 field #1,32 as A$
2100 field #2,32 as B$
2110 if lof(#1)>3840 then ER=40:return
2120 for RECORD=1 to lof(#1)
2130 get #1,RECORD
2140 lset B$=A$
2150 put #2,RECORD
2160 next
2170 close
2180 return
2190 '
2200 ' －－－－ ランダムファイルの書き込み －－－－
2210 '
2220 *OPENRO
2230 open "r",#1,"mem:"+F_NAME$,32
2240 open "r",#2,D_DEV$+F_NAME$,32
2250 field #1,32 as A$
2260 field #2,32 as B$
2270 for RECORD=1 to lof(#1)
2280 get #1,RECORD
2290 lset B$=A$
2300 put #2,RECORD
2310 next
2320 close
2330 kill "mem:"+F_NAME$
2340 return
前のページに戻る