บางคนถือว่าซอฟต์แวร์รวบรวมข้อมูลเป็นสมบัติ จนถึงขณะนี้ บางคนขาย TND เพื่อเงิน ฉันขอยกย่องคนเหล่านี้ในสิ่งที่พวกเขาเป็น! บางทีของข้างล่างอาจจะงี่เง่าไปหน่อย
ด้านล่างนี้ไม่มีฟังก์ชันการเขียนลงในห้องสมุด เรามาถึงขั้นตอนนี้แล้ว ฟังก์ชันการเข้าห้องสมุดนั้นง่ายมาก โปรดดำเนินการด้วยตนเองหากจำเป็น คัดลอกโค้ดและรันโดยตรงเพื่อดูเอฟเฟกต์
Dim Url,List_PageCode,Array_ArticleID,i,ArticleID
Dim Content_PageCode, Content_TempCode
Dim Content_CategoryID,Content_CategoryName,BorderID,ClassID,BorderName,ClassName
Dim ArticleTitle,ArticleAuthor,ArticleFrom,ArticleContent
URL = http://www.webasp.net/article/class/1.htm
List_PageCode = getHTTPPage(Url)
List_PageCode = RegExpText(List_PageCode, พิมพ์</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,,)'สร้างอาร์เรย์เพื่อจัดเก็บรหัสบทความ
สำหรับ i=0 ถึง Ubound(Array_ArticleID)-1
ArticleID = Array_ArticleID(i)'รหัสบทความ
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)' รหัสหมวดหมู่
ClassID = แยก (Content_CategoryID,,)(1) 'รหัสคลาสย่อย
'==========ตรวจสอบว่ามีหมวดหมู่หลักอยู่เริ่มต้นหรือไม่================
'หากไม่มีอยู่ให้เก็บไว้ในฐานข้อมูล'
'==========ตรวจสอบว่ามีหมวดหมู่หลักอยู่หรือไม่สิ้นสุด================
'Response.Write(BorderID & , & ClassID & <br />)
Content_CategoryName = RegExpText(Content_PageCode,/'>,</a>,1)
BorderName = Split(Content_CategoryName,,)(0)'ชื่อหมวดหมู่
ClassName = Split(Content_CategoryName,,)(1)'ชื่อคลาสย่อย
'==========ตรวจสอบว่ามีคลาสย่อยอยู่เริ่มต้นหรือไม่================
'หากไม่มีอยู่ให้เก็บไว้ในฐานข้อมูล'
'==========ตรวจสอบว่ามีคลาสย่อยอยู่หรือไม่================
'==========สิ้นสุดการจำแนกประเภทบทความและพารามิเตอร์ 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)
'==========รับชื่อบทความและท้ายเนื้อหา==============================
Response.Write(ชื่อบทความ& <br /><br />)
การตอบสนองฟลัช()
ต่อไป
สิ่งที่แนบมาด้วยคือฟังก์ชันบางอย่าง:
ฟังก์ชั่น getHTTPPage(url)
IF(IsObjInstalled(Microsoft.XMLHTTP) = False)แล้ว
Response.Write <br><br>เซิร์ฟเวอร์ไม่สนับสนุนคอมโพเนนต์ Microsoft.XMLHTTP
ผิดพลาด.เคลียร์
การตอบสนองสิ้นสุด
สิ้นสุด ถ้า
เมื่อเกิดข้อผิดพลาด ดำเนินการต่อต่อไป
http.ติ่มซำ
SET http=Server.CreateObject(Msxml2.XMLHTTP)
Http.open GET, url, เท็จ
Http.ส่ง()
ถ้า(Http.readystate<>4)แล้ว
ออกจากฟังก์ชัน
สิ้นสุด ถ้า
getHTTPPage=BytesToBSTR(Http.responseBody,GB2312)
ตั้งค่า http=ไม่มีอะไร
ถ้า(Err.number<>0)แล้ว
Response.Write <br><br>เกิดข้อผิดพลาดในการรับเนื้อหาไฟล์
'การตอบสนองสิ้นสุด
ผิดพลาด.เคลียร์
สิ้นสุด ถ้า
ฟังก์ชันสิ้นสุด
ฟังก์ชั่น BytesToBstr (CodeBody, CodeSet)
ติ่ม objStream
SET objStream = Server.CreateObject (adodb.stream)
objStream.Type = 1
objStream.Mode =3
objStream.เปิด
objStream.เขียน CodeBody
objStream.ตำแหน่ง = 0
objStream.Type = 2
objStream.Charset = ชุดรหัส
BytesToBstr = objStream.ReadText
objStream ปิด
SET objStream = ไม่มีอะไร
ฟังก์ชันสิ้นสุด
-
'ฟังก์ชั่น: ตรวจสอบว่าได้ติดตั้งส่วนประกอบแล้วหรือไม่
'ค่าส่งคืน: จริง ---- ติดตั้งแล้ว'
' เท็จ ---- ไม่ได้ติดตั้ง
-
ฟังก์ชัน IsObjInstalled (objName)
เมื่อเกิดข้อผิดพลาด ดำเนินการต่อต่อไป
IsObjInstalled = เท็จ
ผิดพลาด = 0
การทดสอบ DimObj
SET testObj = Server.CreateObject (objName)
ถ้า (0 = ผิดพลาด) แล้วติดตั้ง Obj = True
SET testObj = ไม่มีอะไร
ผิดพลาด = 0
ฟังก์ชันสิ้นสุด
ฟังก์ชัน RegExpText(strng,strStart,strEnd,n)
Dim regEx, แมตช์, แมตช์, RetStr
SET regEx = RegExp ใหม่
regEx.Pattern = strStart&([/s/S]*?)&strEnd
regEx.IgnoreCase = จริง
regEx.Global = จริง
SET Matches = regEx.Execute(strng)
สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน
ถ้า(n=1)แล้ว
RetStr = RetStr & regEx.Replace(Match.Value,$1) & ,
อื่น
RetStr = RetStr & regEx.Replace(Match.Value,$1)
สิ้นสุด ถ้า
ต่อไป
RegExpText = RetStr
SET regEx=ไม่มีอะไร
ฟังก์ชันสิ้นสุด