|
<![CDATA[
10 'save "urlcvt.bas",a
12 'qpon@mtd.biglove.ne.jp
14 'http://www2a.biglobe.ne.jp/~qpon
20 console 0,20:cls
30 gosub *setumei
40 '=======書き換えて下さい======================================
50 'url1$="meshnet.or.jp" '<---古いＵＲＬ
60 'url2$="biglobe.ne.jp" '<---新しいＵＲＬ
70 '=============================================================
80 dim dir.fil$(2000),htm.dt$(2000),fil$(1000),dr$(1000),sub.dr$(1000)
90 fil.name$="dirdt.txt" '<----ファイル名一覧表を出力するファイル
100 'dir.dt$=fil.name$
110 ' 保存先は対象としたしたフォルダー
120 '=============================================================
130 locate 0,8:line input "古 い ＵＲＬ:",url1$
140 locate 0,8:lprint "古 い ＵＲＬ[";url1$;
150 print "]確認 y/n ";:yn$=input$(1):if instr("yY"+chr$(13),yn$)<=0 then 140
160 locate 0,9:line input "新しいＵＲＬ:",url2$
170 locate 0,9:lprint "新しいＵＲＬ[";url2$;
180 print "]確認 y/n ";:yn$=input$(1):if instr("yY"+chr$(13),yn$)<=0 then 170
190 gosub *dir.info
200 'htm.dir$=dr$ '<---ｈｔｍファイルのあるフォルダー
210 fil.n=0
220 url1=len(url1$):url2=len(url2$)
230 gosub *fil.set
240 for i=1 to fil.n
250 flg=0:gosub *dt.load
260 if flg=1 then gosub *dt.save
270 next i
280 cls :locate 30,10:print "完了しました"
290 end
300 '===========================================
310 *fil.set
320 cls:print"ファイル名を調べています"
330 close:open dr$+fil.name$ for input as #1
340 if eof(1) then close #1:return
350 line input #1,a$
360 se$=".html":c=instr(a$,se$):if c>0 then *fil.set.sub
370 se$=".HTML":c=instr(a$,se$):if c>0 then *fil.set.sub
380 se$=".htm":c=instr(a$,se$):if c>0 then *fil.set.sub
390 se$=".HTM":c=instr(a$,se$):if c>0 then *fil.set.sub
400 goto 340
410 '--
420 *fil.set.sub
430 f$=left$(a$,c-1)+se$
440 fil.n=fil.n+1:dir.fil$(fil.n)=f$
450 goto 340
460 '===========
470 *dt.load
480 cls
490 dt.n=0
500 print i,dir.fil$(i)
510 close:open dr$+dir.fil$(i) for input as #1
520 if eof(1) then close #1:return
530 line input #1,a$:
540 dt.n=dt.n+1:htm.dt$(dt.n)=a$
550 gosub *dt.chg
560 c=instr(a$,"</HTML>"):if c>0 then close #1:return
570 c=instr(a$,"</html>"):if c>0 then close #1:return
580 goto 520
590 '--
600 *dt.chg
610 k=dt.n
620 q$=inkey$:if q$=chr$(27) then gosub *stp
630 q$=inkey$:if q$<>"" then 630
640 a$=htm.dt$(k)
650 c=instr(a$,url1$)
660 if c>0 then gosub *dt.chg.sub:goto 640
670 print a$:return
680 '--
690 *stp
700 print:beep:print "強制修了しますか？ y/n";:s$=input$(1)
710 if instr("yY",s$)=<0 then print :return
720 close
730 print:beep:peint "強制修了しました"
740 end
750 '--
760 *dt.chg.sub
770 e1$=left$(a$,c-1):e2$=mid$(a$,c+url1)
780 e$=e1$+url2$+e2$
790 color 4:print e1$;
800 color 2:print url2$;
810 color 4:print e2$:color 7
820 htm.dt$(k)=e$
830 flg=1
840 return
850 '============
860 *dt.save
870 print:y=CSRLIN
880 close:open dr$+dir.fil$(i) for output as #1
890 for h=1 to dt.n
900 print #1,htm.dt$(h)
910 locate 0,y:print using "書み込み中 ####";h;
920 next h
930 close #1:print
940 return
950 '=============================================================
960 'save "dirinfo.bas",a
970 '=============================================================
980 *dir.info
990 'cls:locate 30,6:print"Ｑｐｏｎ ＤｉｒＩｎｆｏ"
1000 locate 0,10:line input "保存フォルダ名",dr$
1010 locate 0,10:print "[";dr$;"] ";
1020 print "確認して下さい [y/n]";:yn$=input$(1)
1030 if instr("Yyﾝ"+chr$(13),yn$)=<0 then 990
1035 if dr$="" then dr$="."
1040 if right$(dr$,1)<>"\" then dr$=dr$+"\"
1050 locate 0,11:print "子、孫フォルダーを含めますか？ [y/n]";
1070 yn$=input$(1)
1080 if instr("Yyﾝ"+chr$(13),yn$)>0 then sub.dr=1:p$="y" else sub.dr=0:p$="n"
1090 locate 0,11:print using "子、孫フォルダーを含めますか？ [ &&]";p$
1100 gosub *main.dir
1110 cls
1120 gosub *main.load
1130 if sub.dr=0 then 1170
1140 dt.s=1:dt.n=fil.n:gosub *sub.dir
1150 dt.s=dt.n+1:dt.n=fil.n
1160 if dt.s<=dt.n then gosub *sub.dir:goto 1150
1170 gosub *dir.save
1180 print "「";fil.name$;"」に保存しました"
1190 return
1200 '--
1210 print "「Ｑｐｏｎ ＤｉｒＩｎｆｏ」を閉じますか y/n";
1220 yn$=input$(1):if instr("yY"+chr$(13),yn$)>0 then cls:system
1230 end
1240 '======
1250 *main.dir
1260 close #1:open "dirinfo.bat" for output as #1
1270 print #1,"dir "+dr$+"*.* > dirinfo.txt"
1280 print #1,"dir "+dr$+"*.*"
1290 print #1,"exit"
1300 close #1
1310 for i=1 to 100:dm=1:next i
1320 child "dirinfo.bat"
1330 for i=1 to 100:dm=1:next i
1340 kill "dirinfo.bat"
1350 return
1360 '--
1370 *main.load
1380 for i=1 to 100:dm=1:next i
1390 fil.n=0
1400 close #1:open "dirinfo.txt" for input as #1
1410 if eof(1) then 1510
1420 line input #1,a$
1430 b$=mid$(a$,45)
1440 if left$(b$,1)<"0" then 1410
1450 c$=b$
1460 if instr(a$,"<DIR>")>0 then c$=b$+"\"
1470 fil.n=fil.n+1
1480 fil$(fil.n)=c$
1490 print fil$(fil.n)
1500 goto 1410
1510 close #1
1520 kill "dirinfo.txt"
1530 return
1540 '=====
1550 *dir.save
1560 close #1:open dr$+fil.name$ for output as #1
1570 cls:print "保存中"
1580 for i=1 to fil.n
1590 a$=fil$(i)
1600 if right$(a$,4)=".lnk" then 1640
1610 if left$(a$,1)<"0" then 1640
1620 if right$(a$,1)="\" then 1640
1630 print #1,a$
1640 next i
1650 close #1
1660 return
1670 '--
1680 *sub.dir
1690 sub.n=0
1700 close #1:open "dirinfo.bat" for output as #1
1710 for ii=dt.s to dt.n
1720 aa$=fil$(ii):print dir$+aa$
1730 if right$(aa$,1)="\" then gosub *sub.dir.sub
1740 next ii
1750 print #1,"exit"
1760 close #1
1770 for i=1 to 100:dm=1:next i
1780 child "dirinfo.bat"
1790 dm=0:for i=1 to 1000:dm=dm+1:next i
1800 kill "dirinfo.bat"
1810 gosub *sub.dir.add
1820 close:return
1830 '--
1840 *sub.dir.sub
1850 sub.dr$=aa$:sub.n=sub.n+1:sub.dr$(sub.n)=sub.dr$
1860 print #1,"dir "+dr$+sub.dr$+"*.* > dirinf"+hex$(sub.n)+".txt"
1870 print #1,"dir "+dr$+sub.dr$+"*.*"
1880 return
1890 '--
1900 *sub.dir.add
1910 for ii=1 to sub.n
1920 close #1:open "dirinf"+hex$(ii)+".txt" for input as #1
1930 sub.dr$=sub.dr$(ii)
1940 if eof(1) then 2040
1950 line input #1,a$
1960 b$=mid$(a$,45)
1970 if left$(b$,1)<"0" then 1940
1980 c$=sub.dr$+b$
1990 if instr(a$,"<DIR>")>0 then c$=sub.dr$+b$+"\"
2000 fil.n=fil.n+1
2010 fil$(fil.n)=c$
2020 print fil$(fil.n)
2030 goto 1940
2040 close #1
2050 kill "dirinf"+hex$(ii)+".txt"
2060 next ii
2070 return
2080 '=======
2090 *setumei
2100 data "＜＜＜ ＵｒｌＣｖｔ．ｂａｓ ＞＞＞。"
2110 data "このプログラムは加入プロバイダーを変わった時やプロバイダーの名称変更があった時"
2120 data "などに、各種ホームページ用ＨＴＭＬファイルの中の記述されたＵＲＬを書き換えなけ"
2130 data "ればならないが、この作業はファイル数が多くなると大変な作業である。"
2140 data "そこで、この作業をＨＴＭＬファイルが保管してあるフォルダー名を入力するだけで、"
2150 data "子や孫フォルダーにあるファイルも含めて自動的に書き換えてしまうプログラムです。"
2160 data "＝Ｑｐｏｎ＝。"
2170 data "/"
2180 cls
2190 restore *setumei
2200 read s$:if s$="/" then 2230
2210 print s$;:if right$(s$,2)="。" then print " "
2220 goto 2200
2230 return
]]>
|