クローラーを宝物だと思っている人もいますが、これまでのところ、TND をお金で売っている人もいます。もしかしたら、以下の内容は少しダメかもしれません。
以下の機能はライブラリに書き込む機能がありません。必要に応じて、ライブラリに入力する機能を自分で完成させてください。コードをコピーして直接実行して効果を確認します
Dim URL,List_PageCode,Array_ArticleID,i,ArticleID
Dim Content_PageCode、Content_TempCode
Dim Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName
Dim 記事タイトル、記事著者、記事差出人、記事コンテンツ
URL = http://www.webasp.net/article/class/1.htm
List_PageCode = getHTTPPage(URL)
List_PageCode = RegExpText(List_PageCode, print</th></tr>,</table><table border=0 cellpadding=5,0)
List_PageCode = RegExpText(List_PageCode,<td align=left><a href='../,'><img border=0 src='../images/authortype0.gif',1)'現在の記事を取得しますで区切られたリストページのリンク
Array_ArticleID = Split(List_PageCode,,)'記事IDを格納する配列を作成します
i=0 から Ubound(Array_ArticleID)-1 の場合
ArticleID = Array_ArticleID(i)'記事ID
Content_PageCode = getHTTPPage(http://www.webasp.net/article/&ArticleID) '記事ページのコンテンツを取得します
'==========開始する記事カテゴリと関連する ID パラメーターを取得します========================
Content_TempCode = RegExpText(Content_PageCode,<a href=/article/>テクニカル チュートリアル</a> >> ,>> コンテンツ</td>,0)
Content_CategoryID = RegExpText(Content_PageCode,<a href='../class,/'>,1)
BorderID = Split(Content_CategoryID,,)(0)' カテゴリ ID
ClassID = Split(Content_CategoryID,,)(1)'サブクラス ID
'==========大カテゴリが存在するかどうかを確認する開始================
'存在しない場合はデータベースに保存します
'==========大カテゴリが存在するか確認終了================
'Response.Write(BorderID & , & ClassID & <br />)
Content_CategoryName = RegExpText(Content_PageCode,/'>,</a>,1)
BorderName = Split(Content_CategoryName,,)(0)'カテゴリ名
ClassName = Split(Content_CategoryName,,)(1)'サブクラス名
'==========サブクラスが存在するかどうかを確認開始================
'存在しない場合はデータベースに保存します
'==========サブクラスが存在するかどうかを確認してください end================
'==========記事分類と関連する ID パラメータの取得が終了========================
'==========記事のタイトルと内容を取得して開始============================= =
ArticleTitle = RegExpText(Content_PageCode,<tr><td align=center bgcolor=#DEE2F5><strong>,</strong></td></tr>,0)
ArticleAuthor = RegExpText(Content_PageCode,<tr><td><span class=blue>著者:</span>,</td></tr>,0)
ArticleFrom = RegExpText(Content_PageCode,<tr><td><span class=blue>ソース:</span>,</td></tr>,0)
ArticleContent = RegExpText(Content_PageCode,<tr><td class=content style=WORD-WRAP:break-word id=zoom>,</td></tr>&VBCrlf& </table>&VBCrlf& </td></tr> </テーブル>,0)
'==========記事のタイトルと内容を取得end==============================
Response.Write(記事タイトル& <br /><br />)
Response.Flush()
次
いくつかの関数が添付されています。
関数 getHTTPPage(url)
IF(IsObjInstalled(Microsoft.XMLHTTP) = False)THEN
Response.Write <br><br>サーバーは Microsoft.XMLHTTP コンポーネントをサポートしていません
エラークリア
応答.終了
終了 IF
エラー時は次へ再開
薄暗い http
SET http=Server.CreateObject(Msxml2.XMLHTTP)
Http.open GET,url,False
Http.send()
IF(Http.readystate<>4)THEN
終了関数
終了 IF
getHTTPPage=BytesToBSTR(Http.responseBody,GB2312)
http=何も設定しない
IF(エラー番号<>0)THEN
Response.Write <br><br>ファイル コンテンツの取得エラー
'応答.終了
エラークリア
終了 IF
終了機能
関数 BytesToBstr(CodeBody,CodeSet)
薄暗いobjStream
SET objStream = Server.CreateObject(adodb.stream)
objStream.Type = 1
objStream.Mode =3
objStream.Open
objStream.Write CodeBody
objStream.Position = 0
objStream.Type = 2
objStream.Charset = コードセット
BytesToBstr = objStream.ReadText
objStream.Close
SET objStream = NOTHING
終了機能
'===============================================
'機能: コンポーネントがインストールされているかどうかを確認します
'戻り値: True ---- すでにインストールされています
' False ---- インストールされていません
'===============================================
関数 IsObjInstalled(objName)
エラー時は次へ再開
IsObjInstalled = False
エラー = 0
薄暗いテストオブジェクト
SET testObj = Server.CreateObject(objName)
IF(0 = エラー)THEN IsObjInstalled = True
SET testObj = NOTHING
エラー = 0
終了機能
関数 RegExpText(strng,strStart,strEnd,n)
Dim regEx、Match、Matches、RetStr
SET regEx = 新しい正規表現
regEx.Pattern = strStart&([/s/S]*?)&strEnd
regEx.IgnoreCase = True
regEx.Global = True
SET 一致 = regEx.Execute(strng)
試合中の各試合について
IF(n=1)THEN
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
それ以外
RetStr = RetStr & regEx.Replace(Match.Value,$1)
終了 IF
次
RegExpText = RetStr
SET regEx=NOTHING
終了機能