10 'save "dirinfo.bas",a 20 '=========== 30 FIL.NAME$="dirdt.txt" '<----ファイル名一覧表を出力するファイル 40 '============ 50 DIM FIL$(2500),FLG(2500),DR$(300),SUB.DR$(300) 60 GOSUB *START.SET 70 '-- 80 *MENU 90 CLS 100 LOCATE 20,3:PRINT ">>>>>>>>>>>> MENU <<<<<<<<<<<<<" 110 LOCATE 20,5:PRINT "(1)フォルダ内のファイル一覧データ作成 " 120 LOCATE 20,7:PRINT "(2)ファイル一覧の表示と閲覧 " 130 LOCATE 20,9:PRINT "(3)ファイル一覧の表示と閲覧 " 140 LOCATE 20,11:PRINT "(4)終了 " 150 LOCATE 20,13:PRINT ">>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<" 160 ME=1:DM=ME 170 IF ME<1 THEN ME=4 180 IF ME>4 THEN ME=1 190 LINE(20*8,(DM*2+3)*16)-(60*8,(DM*2+4)*16),0,B 200 LINE(20*8,(ME*2+3)*16)-(60*8,(ME*2+4)*16),2,B 210 DM=ME 220 M$=INKEY$:IF M$<>"" THEN 220 230 M$=INKEY$:IF M$="" THEN 230 240 IF M$=CHR$(30) THEN ME=ME-1 250 IF M$=CHR$(31) THEN ME=ME+1 260 IF M$<>CHR$(13) THEN 170 270 LINE(20*8,(DM*2+3)*16)-(60*8,(DM*2+4)*16),0,B 280 ON ME GOSUB *MENU1,*MENU2,*MENU3,*MENU4 290 GOTO *MENU 300 '- 310 *START.SET 320 ' 保存先は対象としたしたフォルダー 330 CLS 3:LOCATE 30,4:PRINT"Qpon ListSearch" 340 LINE(40*8, 6*16-1)-(60*8,7*16),7,BF 350 LOCATE 30,6:PRINT "抽出文字列:"; 354 LINE(40*8,8* 16-1)-(44*8, 9*16),7,BF 355 LOCATE 30, 8:PRINT "ドライブ名:"; 360 LINE(40*8,10*16-1)-(60*8,11*16),7,BF 370 LOCATE 30,10:PRINT "フォルダ名:"; 390 COLOR 0:LOCATE 41,6:LINE INPUT PRG$:COLOR 7 400 LINE(40*8, 6*16-1)-(60*8,7*16),0,BF 410 LOCATE 40,6:PRINT "[";PRG$;"] "; 412 LOCATE 41,8::COLOR 0:LINE INPUT DK$:COLOR 7 413 LINE(40*8, 8*16-1)-(60*8,9*16),0,BF 414 LOCATE 40,8:PRINT "[";DK$;"] "; 420 LOCATE 41,8::COLOR 0:LINE INPUT FD$:COLOR 7 430 LINE(40*8, 8*16-1)-(60*8,9*16),0,BF 440 LOCATE 40,8:PRINT "[";FD$;"] "; 445 DR$=DK$+":\"+FD$ 450 LOCATE 30,10:PRINT "確認して下さい [y/n]";:YN$=INPUT$(1) 460 IF INSTR("Yyン"+CHR$(13),YN$)=<0 THEN 330 470 IF DR$="" THEN DR$="." 480 IF RIGHT$(DR$,1)<>"\" THEN DR$=DR$+"\" 490 LOCATE 30,10:PRINT "子、孫フォルダーを "; 500 LOCATE 30,12:PRINT "含めますか? [y/n]"; 510 YN$=INPUT$(1) 520 IF INSTR("Yyン"+CHR$(13),YN$)>0 THEN SUB.DR=1:P$="y" ELSE SUB.DR=0:P$="n" 530 LOCATE 45,12:PRINT USING "[ &&]";P$ 540 RETURN 550 '-- 560 *MENU1 570 CLS 580 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "=====親フォルダの処理をします====="; 590 GOSUB *MAIN.DIR 600 GOSUB *MAIN.LOAD 610 SOU=0 620 IF SUB.DR=0 THEN 700 630 SOU=SOU+1:SOU$=AKCNV$(HEX$(SOU)) 640 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "=====第";SOU$;"階層フォルダの処理をします====="; 650 DT.S=1:DT.N=FIL.N:GOSUB *SUB.DIR 660 DT.S=DT.N+1:DT.N=FIL.N 670 SOU=SOU+1:SOU$=AKCNV$(HEX$(SOU)) 680 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "=====第";SOU$;"階層フォルダの処理をします====="; 690 IF DT.S<=DT.N THEN SOU=SOU+1:GOSUB *SUB.DIR:GOTO 660 700 GOSUB *DIR.SAVE 710 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "「";FIL.NAME$;"」に保存しました"; 720 RETURN 730 '-- 740 *MENU2 750 GOSUB *DIR.LOAD 760 Y=1:YY=0:DY=Y:DYY=YY 770 GOSUB *DIR.PRINT:GOSUB *LINE.PRINT 780 GOSUB *DIR.XY 790 RETURN 800 '- 810 *MENU3 820 GOSUB *DIR.LOAD 830 FOR I=1 TO FIL.N 840 FIL.NO=I:GOSUB *PRG.PRINT 850 NEXT I 860 PRINT"ok=[return]";:YN$=INPUT$(1) 870 RETURN 880 RETURN 890 '- 900 *MENU4 910 CLS:PRINT "「Qpon DirInfo」を閉じますか y/n"; 920 YN$=INPUT$(1):IF INSTR("yY"+CHR$(13),YN$)>0 THEN CLS:SYSTEM 930 END 940 '====== 950 *MAIN.DIR 960 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル作成中"; 970 CLOSE #1:OPEN "dirinfo.bat" FOR OUTPUT AS #1 980 PRINT #1,"dir "+DR$+"*.* > dirinfo.txt" 990 'print #1,"dir "+dr$+"*.*" 1000 PRINT #1,"exit" 1010 CLOSE #1 1020 FOR I=1 TO 100:DM=1:NEXT I 1030 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル実行中"; 1040 CHILD "dirinfo.bat" 1050 FOR I=1 TO 100:DM=1:NEXT I 1060 KILL "dirinfo.bat" 1070 RETURN 1080 '-- 1090 *MAIN.LOAD 1100 PRINT:PY=CSRLIN 1110 FOR I=1 TO 100:DM=1:NEXT I 1120 FIL.N=0 1130 CLOSE #1:OPEN "dirinfo.txt" FOR INPUT AS #1 1140 IF EOF(1) THEN 1300 1150 LINE INPUT #1,A$ 1160 IF INSTR(A$,"<DIR>")>0 THEN 1220 1170 IF LEN(A$)<44 THEN 1140 1180 IF INSTR(A$,".htm")<=0 THEN 1140 1190 D$=LEFT$(A$,1) 1200 IF D$<"0" OR D$>"Z" THEN 1140 1210 IF D$>"9" AND D$<"A" THEN 1140 1220 B$=MID$(A$,45) 1230 IF LEFT$(B$,1)<"0" THEN 1140 1240 C$=B$ 1250 IF INSTR(A$,"<DIR>")>0 THEN C$=B$+"\" 1260 FIL.N=FIL.N+1 1270 FIL$(FIL.N)=C$ 1280 LOCATE 0,PY:PRINT USING "ファイル名読込み中######";FIL.N; 1290 GOTO 1140 1300 CLOSE #1 1310 KILL "dirinfo.txt" 1320 RETURN 1330 '===== 1340 *DIR.SAVE 1350 PRINT:PY=CSRLIN 1360 CLOSE #1:OPEN DR$+FIL.NAME$ FOR OUTPUT AS #1 1370 FOR I=1 TO FIL.N 1380 LOCATE 0,PY:PRINT USING "ファイル名保存中#####";I; 1390 A$=FIL$(I) 1400 IF RIGHT$(A$,4)=".lnk" THEN 1440 1410 IF LEFT$(A$,1)<"0" THEN 1440 1420 IF RIGHT$(A$,1)="\" THEN 1440 1430 PRINT #1,A$ 1440 NEXT I 1450 CLOSE #1 1460 RETURN 1470 '-- 1480 *SUB.DIR 1490 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル作成中"; 1500 SUB.N=0 1510 CLOSE #1:OPEN "dirinfo.bat" FOR OUTPUT AS #1 1520 FOR II=DT.S TO DT.N 1530 AA$=FIL$(II):'print dir$+aa$ 1540 IF RIGHT$(AA$,1)="\" THEN GOSUB *SUB.DIR.SUB 1550 NEXT II 1560 PRINT #1,"exit" 1570 CLOSE #1 1580 PRINT:PY=CSRLIN:LOCATE 0,PY:PRINT "MS−DOSバッチファイル実行中"; 1590 FOR I=1 TO 100:DM=1:NEXT I 1600 CHILD "dirinfo.bat" 1610 DM=0:FOR I=1 TO 1000:DM=DM+1:NEXT I 1620 KILL "dirinfo.bat" 1630 GOSUB *SUB.DIR.ADD 1640 CLOSE:RETURN 1650 '-- 1660 *SUB.DIR.SUB 1670 SUB.DR$=AA$:SUB.N=SUB.N+1:SUB.DR$(SUB.N)=SUB.DR$ 1680 PRINT #1,"dir "+DR$+SUB.DR$+"*.* > dirinf"+HEX$(SUB.N)+".txt" 1690 'print #1,"dir "+dr$+sub.dr$+"*.*" 1700 RETURN 1710 '-- 1720 *SUB.DIR.ADD 1730 PRINT:PY=CSRLIN 1740 FOR II=1 TO SUB.N 1750 CLOSE #1:OPEN "dirinf"+HEX$(II)+".txt" FOR INPUT AS #1 1760 SUB.DR$=SUB.DR$(II) 1770 IF EOF(1) THEN 1930 1780 LINE INPUT #1,A$ 1790 IF INSTR(A$,"<DIR>")>0 THEN 1850 1800 IF LEN(A$)<45 THEN 1770 1810 IF INSTR(A$,".htm")<=0 THEN 1770 1820 D$=LEFT$(A$,1) 1830 IF D$<"0" OR D$>"Z" THEN 1770 1840 IF D$>"9" AND D$<"A" THEN 1770 1850 B$=MID$(A$,45) 1860 IF LEFT$(B$,1)<"0" THEN 1770 1870 C$=SUB.DR$+B$ 1880 IF INSTR(A$,"<DIR>")>0 THEN C$=SUB.DR$+B$+"\" 1890 FIL.N=FIL.N+1 1900 FIL$(FIL.N)=C$ 1910 LOCATE 0,PY:PRINT USING"ファイル名読込み中#####";FIL.N; 1920 GOTO 1770 1930 CLOSE #1 1940 KILL "dirinf"+HEX$(II)+".txt" 1950 NEXT II 1960 RETURN 1970 '- 1980 *DIR.LOAD 1990 PRINT:PY=CSRLIN 2000 CLOSE #1:OPEN DR$+FIL.NAME$ FOR INPUT AS #1 2010 FIL.N=0 2020 IF EOF(1) THEN CLOSE #1:RETURN 2030 LOCATE 0,PY::PRINT USING"ファイル名読込中#####";FIL.N; 2040 LINE INPUT #1,A$:FIL.N=FIL.N+1:FIL$(FIL.N)=A$ 2050 GOTO 2020 2060 '- 2070 *DIR.PRINT 2080 CLS 2090 FOR I=1 TO 24 2100 LOCATE 0,I-1 2110 NO=YY+I 2120 IF NO>FIL.N THEN PRINT STRING$(79," ");:GOTO 2160 2130 COLOR 7-(FLG(NO)*3) 2140 PRINT USING "#####:& &";NO,FIL$(NO); 2150 COLOR 7 2160 NEXT I 2170 RETURN 2180 '-- 2190 *DIR.XY 2200 IF Y<1 THEN Y=1:YY=YY-1 2210 IF Y>FIL.N THEN Y=FIL.N:IF Y<1 THEN Y=1 2220 IF Y>25 THEN Y=25:YY=YY+1 2230 IF YY>FIL.N-24 THEN YY=FIL.N-24 2240 IF YY<0 THEN YY=0 2250 IF YY>DYY+1 OR YY<DYY-1 THEN GOSUB *DIR.PRINT:GOSUB *LINE.PRINT:GOTO 2280 2260 IF YY<>DYY THEN NO=YY+Y:GOSUB *DIR.PRINT:GOTO 2280 2270 IF Y<>DY THEN NO=YY+Y:GOSUB *LINE.PRINT 2280 DY=Y:DYY=YY 2290 XY$=INKEY$:IF XY$<>"" THEN 2290 2300 XY$=INKEY$:IF XY$="" THEN 2300 2310 IF XY$=CHR$(30) THEN Y=Y-1 2320 IF XY$=CHR$(31) THEN Y=Y+1 2330 IF XY$="+" THEN YY=YY+25 2340 IF XY$="-" THEN YY=YY-25 2350 IF XY$=CHR$(12) THEN YY=0 2360 IF XY$=CHR$(1) THEN YY=FIL.N-24 2370 IF XY$=CHR$(13) THEN GOSUB *FLG.SET 2380 IF XY$=CHR$(127) THEN GOSUB *FLG.RESET 2390 IF XY$=CHR$(27) THEN RETURN 2400 GOTO *DIR.XY 2410 '-- 2420 *FLG.SET 2430 NO=YY+Y:FLG(NO)=1:GOTO *DIR.PRINT.SUB 2440 '-- 2450 *FLG.RESET 2460 NO=YY+Y:FLG(NO)=0:GOTO *DIR.PRINT.SUB 2470 '-- 2480 *DIR.PRINT.SUB 2490 LINE(0,DY*16)-(80*8,DY*16),0 2500 R=YY-DYY:IF R<>0 THEN ROLL R*16 2510 COLOR 7-(FLG(NO)*3) 2520 LOCATE 0,Y-1 2530 PRINT USING "#####:& &";NO,FIL$(NO); 2540 COLOR 7 2550 LINE(0,Y*16)-(80*8,Y*16),2 2560 RETURN 2570 '- 2580 *LINE.PRINT 2590 LINE(0,DY*16)-(80*8,DY*16),0 2600 LINE(0,Y*16)-(80*8,Y*16),2 2610 RETURN 2620 '- 2630 *PRG.PRINT 2640 PR.N=0 2650 OPEN DR$+FIL$(FIL.NO) FOR INPUT AS #1 2660 IF EOF(1) THEN CLOSE #1:RETURN 2670 PR.N=PR.N+1 2680 INPUT #1,A$ 2690 IF INSTR(A$,PRG$)<=0 THEN 2660 2700 PRINT DR$+FIL$(I);":"; PR.N:PRINT A$ 2710 LPRINT DR$+FIL$(I);":"; PR.N:LPRINT A$ 2720 GOTO 2660