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 ">>>>>>>>>>>> ＭＥＮＵ <<<<<<<<<<<<<" 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"Ｑｐｏｎ ＤｉｒＩｎｆｏ" 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$(127) THEN MID$(IN$,P,1)=P$:P=P+1 870 IF P$=CHR$(28) THEN P=P+1 880 IF P$=CHR$(29) OR P$=CHR$(8) THEN P=P-1 890 IF 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 "「Ｑｐｏｎ ＤｉｒＩｎｆｏ」を閉じますか 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 "ＭＳ−ＤＯＳバッチファイル作成中"; 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 "ＭＳ−ＤＯＳバッチファイル実行中"; 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$,"<DIR>")>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 "ＭＳ−ＤＯＳバッチファイル作成中"; 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 "ＭＳ−ＤＯＳバッチファイル実行中"; 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$,"<DIR>")>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"ファイルが作成されていません。ＭＥＮＵ�@を実行して作成して下さい"; 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 YY<DYY-1 THEN GOSUB *DIR.PRINT:GOSUB *LINE.PRINT:GOTO 2680 2660 IF YY<>DYY 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 "ＭＳ−ＤＯＳバッチファイル作成中"; 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 "ＭＳ−ＤＯＳバッチファイル実行中"; 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 "ＭＳ−ＤＯＳバッチファイル実行中"; 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