10 'save "dirlha.bas",a
20 WIDTH 80,25
30 '===========
40 FIL.NAME$="dirdt.txt" '<----ファイル名一覧表を出力するファイル
50 US$="##### &"+STRING$(70," ")+"&"
60 '============
70 DIM FIL$(2500),FLG(2500),DR$(300),SUB.DR$(300)
80 GOSUB *START.SET:ME=0
90 '--
100 *MENU
110 CLS
120 *MENU.DT
130 ME.N=6
140 DATA ">>>>>>>>>>>> MENU <<<<<<<<<<<<<"
150 DATA "(1)フォルダ内のファイル一覧データ作成 "
160 DATA "(2)ファイル一覧の表示と圧縮ファイル指定"
170 DATA "(3)ファイルの圧縮( qpon.LZH )に出力 "
180 DATA "(4)圧縮( qpon.LZH )ファイルの確認 "
190 DATA "(5)フォルダ変更 "
200 DATA "(6)終了 "
210 RESTORE *MENU.DT
220 FOR I=0 TO ME.N
230 READ MENU$(I)
240 LOCATE 20,I*2+3
250 PRINT USING "& &";MENU$(I);
260 NEXT I
270 PRINT:PRINT:LOCATE 20:PRINT USING">>>>>>& &<<<<<<<";DR$
280 M$="":MOUSE(2) ON:ON MOUSE(2) GOSUB *MOUSE.SET:GOTO 410
290 ME=ME+1:DM=ME
300 IF ME<1 THEN ME=6
310 IF ME>6 THEN ME=1
315 IF DM<1 THEN DM=1
316 IF DM>6 THEN DM=6
320 LOCATE 20,DM*2+3:COLOR 7,0:PRINT USING "& &";MENU$(DM);
330 LOCATE 20,ME*2+3:COLOR 0,5:PRINT USING "& &";MENU$(ME);
340 COLOR 7,0
350 'line(20*8,(dm*2+3)*16)-(60*8,(dm*2+4)*16),0,b
360 'line(20*8,(me*2+3)*16)-(60*8,(me*2+4)*16),2,b
370 DM=ME
380 M$=INKEY$:IF M$<>"" THEN 380
390 M$=INKEY$
400 GOSUB *MOUSE.XY:IF MM>0 AND MM<>ME THEN ME=MM:GOTO 300
410 IF M$="" THEN 390
420 IF M$=CHR$(30) THEN ME=ME-1
430 IF M$=CHR$(31) THEN ME=ME+1
440 IF M$<>CHR$(13) THEN 300
450 CLS:MOUSE(2) OFF
460 ON ME GOSUB *MENU1,*MENU2,*MENU3,*MENU4,*MENU5,*MENU6
470 GOTO *MENU
480 '-
490 *MOUSE.SET
500 CLS:MOUSE(1) OFF:M$=CHR$(13):RETURN
510 ON ME GOSUB *MENU1,*MENU2,*MENU3,*MENU4,*MENU5,*MENU6
520 RETURN *MENU
530 '-
540 *MOUSE.XY
550 MX=INT(MOUSE(0)/8):MY=INT(MOUSE(1)/16)
560 IF MX<20 OR MX>60 THEN MM=0:RETURN
570 IF MY MOD 2=0 THEN MM=0:RETURN
580 MM=(MY\2-1)
590 IF MM<1 OR MM>6 THEN MM=0
600 RETURN
610 '-
620 *START.SET
630 ' 保存先は対象としたしたフォルダー
640 CLS:LOCATE 30,6:PRINT"Qpon DirInfo"
650 'locate 30,8:line input "フォルダ名",dr$
660 GOSUB *DIR.IN
670 COLOR 0,7:LOCATE 30,9:PRINT USING "& &";DR$;:COLOR 7,0
680 LOCATE 30,10:PRINT "確認して下さい [y/n]";:YN$=INPUT$(1)
690 IF INSTR("Yyン"+CHR$(13),YN$)=<0 THEN 640
700 IF DR$="" THEN DR$="."
710 IF RIGHT$(DR$,1)<>"\" THEN DR$=DR$+"\"
720 LOCATE 30,10:PRINT "子、孫フォルダーを ";
730 LOCATE 30,12:PRINT "含めますか? [y/n]";
740 YN$=INPUT$(1)
750 IF INSTR("Yyン"+CHR$(13),YN$)>0 THEN SUB.DR=1:P$="y" ELSE SUB.DR=0:P$="n"
760 LOCATE 45,12:PRINT USING "[ &&]";P$
770 RETURN
780 '--
790 *DIR.IN
800 IN$=STRING$(30," "):P=1:MID$(IN$,1)=DR$
810 LOCATE 30,8:PRINT"フォルダ名";
820 IF P<1 THEN P=1
830 IF P>LEN(IN$) THEN P=LEN(IN$)
840 COLOR 0,7:LOCATE 30,9:PRINT IN$;
850 LOCATE 29+P,9:COLOR 0,2:PRINT MID$(IN$,P,1);
855 COLOR 7,0
860 P$=INPUT$(1):IF P$>=" " AND P$CHR$(13) THEN 820
900 P=INSTR(IN$," ")-1:IF P<0 THEN P=0
910 DR$=LEFT$(IN$,P)
920 RETURN
930 '--
940 *MENU1
950 CLS
960 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "=====親フォルダの処理をします=====";
970 GOSUB *MAIN.DIR
980 GOSUB *MAIN.LOAD
990 SOU=0
1000 IF SUB.DR=0 THEN 1080
1010 SOU=SOU+1:SOU$=AKCNV$(HEX$(SOU))
1020 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "=====第";SOU$;"階層フォルダの処理をします=====";
1030 DT.S=1:DT.N=FIL.N:GOSUB *SUB.DIR
1040 DT.S=DT.N+1:DT.N=FIL.N
1050 SOU=SOU+1:SOU$=AKCNV$(HEX$(SOU))
1060 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "=====第";SOU$;"階層フォルダの処理をします=====";
1070 IF DT.S<=DT.N THEN SOU=SOU+1:GOSUB *SUB.DIR:GOTO 1040
1080 GOSUB *DIR.SAVE
1090 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "「";FIL.NAME$;"」に保存しました";
1100 RETURN
1110 '--
1120 *MENU2
1130 GOSUB *DIR.LOAD
1140 Y=1:YY=0:DY=Y:DYY=YY
1150 GOSUB *DIR.PRINT:GOSUB *LINE.PRINT
1160 GOSUB *DIR.XY
1170 RETURN
1180 '-
1190 *MENU3
1200 GOSUB *LHA.SET:RETURN
1210 '--
1220 *MENU4
1230 CLS:GOSUB *LHA.LIST
1240 RETURN
1250 '-
1260 *MENU5
1270 CLS:GOSUB *START.SET
1280 RETURN
1290 '--
1300 *MENU6
1310 CLS:PRINT "「Qpon DirInfo」を閉じますか y/n";
1320 YN$=INPUT$(1):IF INSTR("yY"+CHR$(13),YN$)>0 THEN CLS:SYSTEM
1330 CLS:END
1340 '======
1350 *MAIN.DIR
1360 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル作成中";
1370 CLOSE #1:OPEN "dirinfo.bat" FOR OUTPUT AS #1
1380 PRINT #1,"dir "+DR$+"*.* > dirinfo.txt"
1390 'print #1,"dir "+dr$+"*.*"
1400 PRINT #1,"exit"
1410 CLOSE #1
1420 FOR I=1 TO 100:DM=1:NEXT I
1430 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル実行中";
1440 CHILD "dirinfo.bat"
1450 FOR I=1 TO 100:DM=1:NEXT I
1460 KILL "dirinfo.bat"
1470 RETURN
1480 '--
1490 *MAIN.LOAD
1500 PRINT:PY=CSRLIN
1510 FOR I=1 TO 100:DM=1:NEXT I
1520 FIL.N=0
1530 CLOSE #1:OPEN "dirinfo.txt" FOR INPUT AS #1
1540 IF EOF(1) THEN 1640
1550 LINE INPUT #1,A$
1560 B$=MID$(A$,45)
1570 IF LEFT$(B$,1)<"0" THEN 1540
1580 C$=B$
1590 IF INSTR(A$,"")>0 THEN C$=B$+"\"
1600 FIL.N=FIL.N+1
1610 FIL$(FIL.N)=C$
1620 LOCATE 0,PY:PRINT USING "ファイル名読込み中######";FIL.N;
1630 GOTO 1540
1640 CLOSE #1
1650 KILL "dirinfo.txt"
1660 RETURN
1670 '=====
1680 *DIR.SAVE
1690 PRINT:PY=CSRLIN
1700 CLOSE #1:OPEN DR$+FIL.NAME$ FOR OUTPUT AS #1
1710 FOR I=1 TO FIL.N
1720 LOCATE 0,PY:PRINT USING "ファイル名保存中#####";I;
1730 A$=FIL$(I)
1740 IF RIGHT$(A$,4)=".lnk" THEN 1780
1750 IF LEFT$(A$,1)<"0" THEN 1780
1760 IF RIGHT$(A$,1)="\" THEN 1780
1770 PRINT #1,A$
1780 NEXT I
1790 CLOSE #1
1800 RETURN
1810 '--
1820 *SUB.DIR
1830 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル作成中";
1840 SUB.N=0
1850 CLOSE #1:OPEN "dirinfo.bat" FOR OUTPUT AS #1
1860 FOR II=DT.S TO DT.N
1870 AA$=FIL$(II):'print dir$+aa$
1880 IF RIGHT$(AA$,1)="\" THEN GOSUB *SUB.DIR.SUB
1890 NEXT II
1900 PRINT #1,"exit"
1910 CLOSE #1
1920 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル実行中";
1930 FOR I=1 TO 100:DM=1:NEXT I
1940 CHILD "dirinfo.bat"
1950 DM=0:FOR I=1 TO 1000:DM=DM+1:NEXT I
1960 KILL "dirinfo.bat"
1970 GOSUB *SUB.DIR.ADD
1980 CLOSE:RETURN
1990 '--
2000 *SUB.DIR.SUB
2010 SUB.DR$=AA$:SUB.N=SUB.N+1:SUB.DR$(SUB.N)=SUB.DR$
2020 PRINT #1,"dir "+DR$+SUB.DR$+"*.* > dirinf"+HEX$(SUB.N)+".txt"
2030 'print #1,"dir "+dr$+sub.dr$+"*.*"
2040 RETURN
2050 '--
2060 *SUB.DIR.ADD
2070 PRINT:PY=CSRLIN
2080 FOR II=1 TO SUB.N
2090 CLOSE #1:OPEN "dirinf"+HEX$(II)+".txt" FOR INPUT AS #1
2100 SUB.DR$=SUB.DR$(II)
2110 IF EOF(1) THEN 2210
2120 LINE INPUT #1,A$
2130 B$=MID$(A$,45)
2140 IF LEFT$(B$,1)<"0" THEN 2110
2150 C$=SUB.DR$+B$
2160 IF INSTR(A$,"")>0 THEN C$=SUB.DR$+B$+"\"
2170 FIL.N=FIL.N+1
2180 FIL$(FIL.N)=C$
2190 LOCATE 0,PY:PRINT USING"ファイル名読込み中#####";FIL.N;
2200 GOTO 2110
2210 CLOSE #1
2220 KILL "dirinf"+HEX$(II)+".txt"
2230 NEXT II
2240 RETURN
2250 '--
2260 *DIR.LOAD.ERROR
2270 CLOSE #1
2280 PRINT:PY=CSRLIN:PRINT"ファイルが作成されていません。MENU@を実行して作成して下さい";
2290 PRINT "ok=[Enter]";:DM$=INPUT$(1)
2300 RESUME 2310
2310 ON ERROR GOTO 0
2320 ME=0:RETURN *MENU
2330 '-
2340 *DIR.LOAD
2350 PRINT:PY=CSRLIN
2360 ON ERROR GOTO *DIR.LOAD.ERROR
2370 CLOSE #1:OPEN DR$+FIL.NAME$ FOR INPUT AS #1
2380 ON ERROR GOTO 0
2390 FIL.N=0
2400 IF EOF(1) THEN CLOSE #1:RETURN
2410 LOCATE 0,PY::PRINT USING"ファイル名読込中#####";FIL.N;
2420 LINE INPUT #1,A$:FIL.N=FIL.N+1:FIL$(FIL.N)=A$
2430 GOTO 2400
2440 '-
2450 *DIR.PRINT
2460 CLS
2470 FOR I=1 TO 25
2480 LOCATE 0,I-1
2490 NO=YY+I
2500 IF NO>FIL.N THEN PRINT STRING$(79," ");:GOTO 2540
2510 COLOR 7-(FLG(NO)*5),0
2520 PRINT USING US$;NO,FIL$(NO);
2530 COLOR 7
2540 NEXT I
2550 RETURN
2560 '--
2570 *DIR.XY
2580 MOUSE(2) ON:ON MOUSE(2) GOSUB *FLG.SET
2590 MOUSE(3) ON:ON MOUSE(3) GOSUB *FLG.RESET
2600 IF Y<1 THEN Y=1:YY=YY-1
2610 IF Y>FIL.N THEN Y=FIL.N:IF Y<1 THEN Y=1
2620 IF Y>25 THEN Y=25:YY=YY+1
2630 IF YY>FIL.N-24 THEN YY=FIL.N-24
2640 IF YY<0 THEN YY=0
2650 IF YY>DYY+1 OR YYDYY THEN NO=YY+Y:GOSUB *DIR.PRINT.SUB:GOTO 2680
2670 IF Y<>DY THEN NO=YY+Y:GOSUB *LINE.PRINT
2680 DY=Y:DYY=YY
2690 XY$=INKEY$:IF XY$<>"" THEN 2690
2700 XY$=INKEY$
2710 GOSUB *MOUSE.UD
2715 IF MX>60 OR MX<1 THEN 2730
2716 IF MY>25 OR MY<1 THEN Y=MY:GOTO *DIR.XY
2720 IF MY<>Y THEN IF DMY<>MY THEN Y=MY:GOTO *DIR.XY
2730 IF XY$="" THEN 2700
2740 IF XY$=CHR$(30) THEN Y=Y-1
2750 IF XY$=CHR$(31) THEN Y=Y+1
2760 IF XY$="+" THEN YY=YY+25
2770 IF XY$="-" THEN YY=YY-25
2780 IF XY$=CHR$(12) THEN YY=0
2790 IF XY$=CHR$(1) THEN YY=FIL.N-24
2800 IF XY$=CHR$(13) THEN GOSUB *FLG.SET:Y=Y+1
2810 IF XY$=CHR$(127) THEN GOSUB *FLG.RESET:Y=Y+1
2820 IF XY$=CHR$(27) THEN 2840
2830 GOTO *DIR.XY
2840 '--
2850 MOUSE(2) OFF:MOUSE(3) OFF:RETURN
2860 '--
2870 *MOUSE.UD
2875 DMY=MY
2880 MX=INT(MOUSE(0)/8):MY=INT((MOUSE(1)-8)/16)+1
2890 RETURN
2900 '--
2910 *FLG.SET
2920 NO=YY+Y:FLG(NO)=1:GOTO *DIR.PRINT.SUB
2930 '--
2940 *FLG.RESET
2950 NO=YY+Y:FLG(NO)=0:GOTO *DIR.PRINT.SUB
2960 '--
2970 *DIR.PRINT.SUB
2980 LOCATE 0,DY-1:COLOR 7-(FLG(DYY+DY)*5),0:PRINT USING US$;DYY+DY,FIL$(DYY+DY);
2990 R=YY-DYY:IF R<>0 THEN ROLL R*16
3000 '--
3010 LOCATE 0,Y-1:COLOR 7-(FLG(YY+Y)*5),5: PRINT USING US$;NO,FIL$(NO);
3020 COLOR 7,0
3030 'line(0,y*16)-(80*8,y*16),2
3040 RETURN
3050 '-
3060 *LINE.PRINT
3070 'line(0,dy*16)-(80*8,dy*16),0
3080 LOCATE 0,DY-1:COLOR 7-(FLG(DYY+DY)*5),0:PRINT USING US$;DYY+DY,FIL$(DYY+DY);
3090 LOCATE 0,Y-1:COLOR 7-(FLG(YY+Y)*5),5:PRINT USING US$;NO,FIL$(NO);
3100 COLOR 7,0
3110 'line(0,y*16)-(80*8,y*16),2
3120 RETURN
3130 '--
3140 *LHA.SET:
3150 CLS
3160 FLG=0:FOR I=1 TO FIL.N:FLG=FLG+FLG(I):NEXT I
3170 IF FLG=0 THEN PRINT "対象ファイルがありません、MENU2で設定して下さい ok=[ret]";:YN$=INPUT$(1):RETURN
3180 OPEN "qpon.LZH" FOR OUTPUT AS #1:CLOSE #1
3190 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル作成中";
3200 OPEN "dirinfo.bat" FOR OUTPUT AS #1
3210 FOR I=1 TO FIL.N
3220 IF FLG(I)=0 THEN 3240
3230 PRINT #1,"LHA a -x1 qpon.LZH "+DR$+FIL$(I)
3240 NEXT I
3250 'print #1,"pause"
3260 PRINT #1,"exit"
3270 CLOSE #1
3280 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル実行中";
3290 FOR I=1 TO 100:DM=1:NEXT I
3300 CHILD "dirinfo.bat"
3310 DM=0:FOR I=1 TO 1000:DM=DM+1:NEXT I
3320 KILL "dirinfo.bat"
3330 RETURN
3340 '-
3350 *LHA.LIST
3360 OPEN "dirinfo.bat" FOR OUTPUT AS #1
3370 PRINT #1,"LHA l qpon.LZH "
3380 PRINT #1,"pause"
3390 PRINT #1,"exit"
3400 CLOSE #1
3410 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル実行中";
3420 FOR I=1 TO 100:DM=1:NEXT I
3430 CHILD "dirinfo.bat"
3440 DM=0:FOR I=1 TO 1000:DM=DM+1:NEXT I
3450 KILL "dirinfo.bat"
3460 RETURN
|