HTMLソースからURLだけを抜き出す方法を教えてください！

質問

どなたかお知恵をお貸しください。
HTMLのソースファイルからURLを取得するツールを
作ろうと思うのですが、そのURLだけを抜き出すと
いうところがよく分かりません。

ソーステキストを
open "source.txt" for input as #1
do until eof(1)
line input #1,aa
で一行ずつ読み込んでいき、
その中から
InStr関数で「http://」の文字列を検索すると
いうことぐらいは想像がつくのですが、URLは
文字数も決められているわけではないので、検索で
見つかった位置から最後までを抜き出すという方法が
どうしても分かりません。

あるいは、タグの <A href= という文字列を検索して
見つかった位置から次に > という文字列が見つかった
場所までの間を抜き出すという方法になるかと思いますが、
最初に検索で見つかった位置から次に見つかった位置まで
をどのように検索すればいいのかが分かりません。

何かいい手がございましたら、ぜひ教えてください。
よろしくお願いします！

回答No.7

hershe · ベストアンサー

こんにちわ。#4のhersheです。

補足の回答をいたします。

改行なしの場合もInStr関数の使い方を少し工夫するだけでタグの抽出を行うことができます。

>途中で改行されても続けて検索する方法、
この方法は少し複雑なコードになってしまいますので

>改行がなく全文で一行の場合でも続けてURLを取得していきリストボックスに
>追加していくような方法はないのでしょうか？
こちらの方法で記述しますね。

fujiyama2002さんのコードを少しお借りします。

'--------+---------+---------+---------+---------+---------+
　　Open na For Input As #fileno

　　Do Until EOF(fileno)
　　　　Line Input #fileno, aa

　　　　GetATag = ""

　　　　lngPosSt = InStr(StrConv(aa, vbLowerCase), "<a href=")

　　　　'"<a href="が見つかったらループ
　　　　Do While lngPosSt > 0
　　　　　　GetATag = ""

'　　　　　　If lngPosSt > 0 Then
　　　　　　　　lngPosEnd = InStr(Mid(aa, lngPosSt), ">")

　　　　　　　　If lngPosEnd > 0 Then
　　　　　　　　　　strATag = Mid(aa, lngPosSt, lngPosEnd)
　　　　　　　　　　GetATag = strATag
　　　　　　　　End If
'　　　　　　End If
　　　　　　if GetATag <> ""
　　　　　　　　List1.AddItem GetATag
　　　　　　End If

　　　　　　'検索開始位置を次の位置へ
　　　　　　lngPosSt = lngPosSt + lngPosEnd

　　　　　　'次の"<a href="を検索
　　　　　　lngPosSt = InStr(lngPosSt, StrConv(aa, vbLowerCase), "<a href=")
　　　　Loop
　　Loop

　　Close #fileno
'--------+---------+---------+---------+---------+---------+

このように検索開始位置をずらしつつ検索を繰り返すことによって、全文で１行の場合でも抽出できるようになります。

また、"<a href="の部分を"<a "に変更することで、"TARGET="などが"<a"と"href"の間に入っている場合のものも抽出できるようになります。

あとはＵＲＬを抜き出すだけですね。
もうひと踏ん張りです。がんばりましょう。(^-^)

お礼

こんにちは。
詳細な回答をまたまたありがとうございます！

コードをそのままコピーさせていただいて、部分的に変更しながら
いろんなパターンを試してみました。
"<a"を"<a href"とか"http"に変えて試してみました。
結局下のコードできれいに抽出できました。

Open na For Input As #fileno
Do Until EOF(fileno)
Line Input #fileno, a
getatag = ""
lngposst = InStr(StrConv(aa, vbLowerCase), "<a")
Do While lngposst > 0
getatag = ""
'　　　　　　If lngPosSt > 0 Then
lngposend = InStr(Mid(aa, lngposst), ">")
If lngposend > 0 Then
stratag = Mid(aa, lngposst, lngposend)
getatag = stratag
End If
'　　　　　　End If
If getatag <> "" Then
yyyyy = StrConv(getatag, vbLowerCase)
ooo = Replace(yyyyy, "<a href=", "")
www = Replace(ooo, ">", "")
saigo = Replace(www, """", "")
List1.AddItem saigo
End If
lngposst = lngposst + lngposend
lngposst = InStr(lngposst, StrConv(aa, vbLowerCase), "<a")
Loop
Loop
Close #fileno

これでどうやらきれいにリストボックスに追加されました。
途中に改行が入っているソースでも試しましたが、URLの途中に
改行が入っているものは案外とないようで、ちゃんと出力されて
いましたので、ここのところはとりあえず無視してしまうことにしました。
あと、間に「target」が入っているものもたまたま見つからなかったので
とりあえずReplaceには入れていませんが、これは教えていただいた
方法で位置を割り出してtargetからhttpの前までを削除してしまうことで
解決するかと思います。

次はgifなどの画像も取り込んでしまおうと思います。
これは、上の例で言うと、aaの中に.gifの文字列があったらその位置までを
抽出するという方法でどうにかなりそうだと、自分で勝手に思っています。
ほぼ100%が教えていただいた方法でどうにかなりそうな気がします。

ほんとにありがとうございました！