ฟังก์ชันการรวบรวมที่สมบูรณ์พร้อมการรวบรวมเนื้อหาบทความระยะไกล การบันทึกรูปภาพ การสร้างไฟล์ ฯลฯ

บทความนี้แสดงชุดฟังก์ชันการรวบรวม ASP ที่สมบูรณ์ รวมถึงฟังก์ชันต่างๆ เช่น การแยกอักขระดั้งเดิมของที่อยู่ การบันทึกไฟล์ระยะไกลไปยังการเข้าสู่ระบบจำลองในเครื่อง และการขอรับซอร์สโค้ดของเว็บเพจ

คัดลอกรหัสรหัสดังต่อไปนี้:

'=================================================' ==

'ชื่อฟังก์ชัน: GetHttpPage

'ฟังก์ชั่น: รับซอร์สโค้ดของหน้าเว็บ

'พารามิเตอร์: HttpUrl ------ ที่อยู่หน้าเว็บ

'=================================================' ==

ฟังก์ชั่น GetHttpPage(HttpUrl)

ถ้า IsNull(HttpUrl)=True หรือ Len(HttpUrl)<18 หรือ HttpUrl="$False$" แล้ว

GetHttpPage="$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

Dim Http

ตั้งค่า Http=server.createobject("MSX" & "ML2.XM" & "LHT" & "TP")

Http.open "GET",HttpUrl,False

Http ส่ง()

ถ้า Http.Readystate<>4 แล้ว

ตั้ง Http=Nothing

GetHttpPage="$False$"

ฟังก์ชั่นออก

จบถ้า

GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")

GetHTTPPage=แทนที่(แทนที่(GetHTTPPage , vbCr,""),vbLf,"")

ตั้ง Http=Nothing

ถ้า Err.number<>0 แล้ว

ผิดพลาด.เคลียร์

สิ้นสุดถ้า

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: BytesToBstr

'ฟังก์ชั่น: แปลงซอร์สโค้ดที่ได้รับเป็นภาษาจีน

'พารามิเตอร์: เนื้อความ ------ ตัวแปรที่จะแปลง

'พารามิเตอร์: Cset ------ ประเภทที่จะแปลง

'=================================================' ==

ฟังก์ชั่น BytesToBstr (เนื้อความ, Cset)

ดิม ออบสตรีม

ตั้ง Objstream = Server.CreateObject("ad" & "odb.str" & "eam")

objstream.Type = 1

objstream.Mode =3

objstream.เปิด

objstream เขียนเนื้อหา

objstream ตำแหน่ง = 0

objstream.Type = 2

objstream.Charset = Cset

BytesToBstr = objstream.ReadText

objstream.ปิด

ตั้งค่า objstream = ไม่มีเลย

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: PostHttpPage

'ฟังก์ชัน: เข้าสู่ระบบ'

'=================================================' ==

ฟังก์ชั่น PostHttpPage (RefererUrl, PostUrl, PostData)

DimxmlHttp

DimRetStr

ตั้งค่า xmlHttp = CreateObject("Msx" & "ml2.XM" & "LHT" & "TP")

xmlHttp.Open "POST", PostUrl, เท็จ

XmlHTTP.setRequestHeader "ความยาวเนื้อหา",Len (PostData)

xmlHttp.setRequestHeader "ประเภทเนื้อหา", "application/x-www-form-urlencoded"

xmlHttp.setRequestHeader "ผู้อ้างอิง", RefererUrl

xmlHttp ส่ง PostData

ถ้า Err.Number <> 0 แล้ว

ตั้งค่า xmlHttp=ไม่มีอะไร

PostHttpPage = "$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

PostHttpPage=bytesToBSTR(xmlHttp.responseBody,"GB2312")

ตั้งค่า xmlHttp = ไม่มีเลย

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: UrlEncoding

'ฟังก์ชัน: แปลงการเข้ารหัส'

'=================================================' ==

ฟังก์ชั่นการเข้ารหัส Url (DataStr)

Dim StrReturn, Si, ThisChr, InnerCode, Hight8, Low8

StrReturn = ""

สำหรับ Si = 1 ถึง Len(DataStr)

ThisChr = กลาง(DataStr,Si,1)

ถ้า Abs(Asc(ThisChr)) < &HFF จากนั้น

StrReturn = StrReturn & ThisChr

อื่น

InnerCode = Asc(ThisChr)

ถ้า InnerCode < 0 แล้ว

InnerCode = InnerCode + &H10000

สิ้นสุดถ้า

Hight8 = (InnerCode และ &HFF00)/ &HFF

Low8 = InnerCode และ &HFF

StrReturn = StrReturn & "%" & Hex (สูง 8) & "%" & Hex (ต่ำ 8)

สิ้นสุดถ้า

ต่อไป

UrlEncoding = StrReturn

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: GetBody

'ฟังก์ชัน: ตัดสตริง

'พารามิเตอร์: ConStr ------ สตริงที่จะดักจับ

'พารามิเตอร์: StartStr ------ สตริงเริ่มต้น

'พารามิเตอร์: OverStr ------ สตริงสิ้นสุด

'พารามิเตอร์: รวม ------ รวม StartStr หรือไม่

'พารามิเตอร์:IncluR ------จะรวม OverStr หรือไม่

'=================================================' ==

ฟังก์ชัน GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)

ถ้า ConStr="$False$" หรือ ConStr="" หรือ IsNull(ConStr)=True หรือ StartStr="" หรือ IsNull(StartStr)=True หรือ OverStr="" หรือ IsNull(OverStr)=True จากนั้น

GetBody="$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

DimConStrTemp

เริ่มสลัว จบ

ConStrTemp=Lcase(ConStr)

StartStr=Lcase(StartStr)

OverStr=Lcase(OverStr)

เริ่มต้น = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)

ถ้าเริ่ม<=0แล้ว

GetBody="$False$"

ออกจากฟังก์ชัน

อื่น

ถ้า IncluL=False แล้ว

เริ่มต้น=เริ่ม+LenB(StartStr)

สิ้นสุดถ้า

สิ้นสุดถ้า

เกิน = InStrB (เริ่ม, ConStrTemp, OverStr, vbBinary เปรียบเทียบ)

หากเกิน<=0 หรือมากกว่า<=เริ่มแล้ว

GetBody="$False$"

ออกจากฟังก์ชัน

อื่น

ถ้า InclR=True แล้ว

สูง=สูง+LenB(OverStr)

สิ้นสุดถ้า

สิ้นสุดถ้า

GetBody=MidB(ConStr,สตาร์ท,โอเวอร์สตาร์ท)

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: GetArray

'ฟังก์ชัน: แยกที่อยู่ลิงก์ คั่นด้วย $Array$

'พารามิเตอร์: ConStr ------ แยกอักขระดั้งเดิมของที่อยู่

'พารามิเตอร์: StartStr ------ สตริงเริ่มต้น

'พารามิเตอร์: OverStr ------ สตริงสิ้นสุด

'พารามิเตอร์: รวม ------ รวม StartStr หรือไม่

'พารามิเตอร์:IncluR ------จะรวม OverStr หรือไม่

'=================================================' ==

ฟังก์ชัน GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)

ถ้า ConStr="$False$" หรือ ConStr="" หรือ IsNull(ConStr)=True หรือ StartStr="" หรือ OverStr="" หรือ IsNull(StartStr)=True หรือ IsNull(OverStr)=True แล้ว

GetArray="$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

Dim TempStr, TempStr2, objRegExp, แมตช์, แมตช์

TempStr=""

ตั้งค่า objRegExp = Regexp ใหม่

objRegExp.IgnoreCase = จริง

objRegExp.Global = จริง

objRegExp.Pattern = "("&StartStr&").+?("&OverStr&")"

ตั้งค่าการจับคู่ =objRegExp.Execute(ConStr)

สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน

TempStr=TempStr & "$Array$" & Match.Value

ต่อไป

ตั้งค่าการจับคู่ = ไม่มีอะไรเลย

ถ้า TempStr="" แล้ว

GetArray="$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

TempStr=ขวา(TempStr,เลน(TempStr)-7)

ถ้า IncluL=False แล้ว

objRegExp.Pattern =StartStr

TempStr=objRegExp.แทนที่(TempStr,"")

จบถ้า

ถ้า InclR=False แล้ว

objRegExp.Pattern =OverStr

TempStr=objRegExp.แทนที่(TempStr,"")

จบถ้า

ตั้งค่า objRegExp=nothing

ตั้งค่าการจับคู่ = ไม่มีอะไรเลย

TempStr=แทนที่(TempStr,"""","")

TempStr=แทนที่(TempStr,"'","")

TempStr=แทนที่(TempStr," ","")

TempStr=แทนที่(TempStr,"(", "")

TempStr=แทนที่(TempStr,")","")

ถ้า TempStr="" แล้ว

GetArray="$False$"

อื่น

GetArray=TempStr

จบถ้า

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: DefiniteUrl

'ฟังก์ชั่น: แปลงที่อยู่สัมพัทธ์ให้เป็นที่อยู่ที่แน่นอน

'พารามิเตอร์: PrimitiveUrl ------ ที่อยู่ที่เกี่ยวข้องที่จะแปลง

'พารามิเตอร์: ConsultUrl ------ ที่อยู่หน้าเว็บปัจจุบัน

'=================================================' ==

ฟังก์ชั่น DefiniteUrl (Byval PrimitiveUrl, Byval ConsultUrl)

หรี่ ConTemp, PriTemp, Pi, Ci, PriArray, ConArray

ถ้า PrimitiveUrl="" หรือ ConsultUrl="" หรือ PrimitiveUrl="$False$" หรือ ConsultUrl="$False$" แล้ว

Url แน่นอน = "$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

ถ้าซ้าย(Lcase(ConsultUrl),7)<>"http://" จากนั้น

ConsultUrl= "http://" & ConsultUrl

สิ้นสุดถ้า

ConsultUrl=แทนที่(ConsultUrl,"/","/")

ConsultUrl=แทนที่(ConsultUrl,"://","://")

PrimitiveUrl=แทนที่(PrimitiveUrl,"/","/")

ถ้าใช่(ConsultUrl,1)<>"/" จากนั้น

ถ้า Instr(ConsultUrl,"/")>0 แล้ว

ถ้า Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 แล้ว

อื่น

ConsultUrl=ConsultUrl & "/"

สิ้นสุดถ้า

อื่น

ConsultUrl=ConsultUrl & "/"

สิ้นสุดถ้า

สิ้นสุดถ้า

ConArray=Split(ConsultUrl,"/")

ถ้า Left(LCase(PrimitiveUrl),7) = "http://" แล้ว

DefiniteUrl=แทนที่(PrimitiveUrl,"://", "://")

ElseIf Left(PrimitiveUrl,1) = "/" จากนั้น

DefiniteUrl=ConArray(0) & PrimitiveUrl

ElseIf ซ้าย(PrimitiveUrl,2)="./" จากนั้น

PrimitiveUrl=ขวา(PrimitiveUrl,Len(PrimitiveUrl)-2)

ถ้าใช่(ConsultUrl,1)="/" จากนั้น

DefiniteUrl=ConsultUrl & PrimitiveUrl

อื่น

DefiniteUrl=ซ้าย(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl

สิ้นสุดถ้า

ElseIf Left(PrimitiveUrl,3)="../" แล้ว

ทำในขณะที่ซ้าย(PrimitiveUrl,3)="../"

PrimitiveUrl=ขวา(PrimitiveUrl,Len(PrimitiveUrl)-3)

ปี่=ปี่+1

วนซ้ำ

สำหรับ Ci=0 ถึง (Ubound(ConArray)-1-Pi)

ถ้า DefiniteUrl<>"" จากนั้น

DefiniteUrl=DefiniteUrl & "/" & ConArray(Ci)

อื่น

DefiniteUrl=ConArray(Ci)

สิ้นสุดถ้า

ต่อไป

DefiniteUrl=DefiniteUrl & "/" & PrimitiveUrl

อื่น

ถ้า Instr(PrimitiveUrl,"/")>0 แล้ว

PriArray=Split(PrimitiveUrl,"/")

ถ้า Instr(PriArray(0),".")>0 แล้ว

ถ้าใช่(PrimitiveUrl,1)="/" จากนั้น

DefiniteUrl="http://" & PrimitiveUrl

อื่น

ถ้า Instr(PriArray(Ubound(PriArray)-1),".")>0 จากนั้น

DefiniteUrl="http://" & PrimitiveUrl

อื่น

DefiniteUrl="http://" & PrimitiveUrl & "/"

สิ้นสุดถ้า

สิ้นสุดถ้า

อื่น

ถ้าใช่(ConsultUrl,1)="/" จากนั้น

DefiniteUrl=ConsultUrl & PrimitiveUrl

อื่น

DefiniteUrl=ซ้าย(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl

สิ้นสุดถ้า

สิ้นสุดถ้า

อื่น

ถ้า Instr(PrimitiveUrl,".")>0 แล้ว

ถ้าใช่(ConsultUrl,1)="/" จากนั้น

ถ้า right(LCase(PrimitiveUrl),3)=".cn" หรือ right(LCase(PrimitiveUrl),3)="com" หรือ right(LCase(PrimitiveUrl),3)="net" หรือ right(LCase(PrimitiveUrl) ,3)="org" จากนั้น

DefiniteUrl="http://" & PrimitiveUrl & "/"

อื่น

DefiniteUrl=ConsultUrl & PrimitiveUrl

สิ้นสุดถ้า

อื่น

ถ้า right(LCase(PrimitiveUrl),3)=".cn" หรือ right(LCase(PrimitiveUrl),3)="com" หรือ right(LCase(PrimitiveUrl),3)="net" หรือ right(LCase(PrimitiveUrl) ,3)="org" จากนั้น

DefiniteUrl="http://" & PrimitiveUrl & "/"

อื่น

DefiniteUrl=ซ้าย(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl

สิ้นสุดถ้า

สิ้นสุดถ้า

อื่น

ถ้าใช่(ConsultUrl,1)="/" จากนั้น

DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"

อื่น

DefiniteUrl=ซ้าย(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"

สิ้นสุดถ้า

สิ้นสุดถ้า

สิ้นสุดถ้า

สิ้นสุดถ้า

ถ้า Left(DefiniteUrl,1)="/" แล้ว

DefiniteUrl=ขวา(DefiniteUrl,Len(DefiniteUrl)-1)

จบถ้า

ถ้า DefiniteUrl<>"" จากนั้น

DefiniteUrl=แทนที่(DefiniteUrl,"//","/")

DefiniteUrl=แทนที่(DefiniteUrl,"://","://")

อื่น

Url แน่นอน = "$False$"

สิ้นสุดถ้า

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน:แทนที่SaveRemoteFile

'ฟังก์ชั่น: แทนที่และบันทึกรูปภาพระยะไกล

'พารามิเตอร์: ConStr ------ สตริงที่จะถูกแทนที่

'พารามิเตอร์: SaveTf ------ ไม่ว่าจะบันทึกไฟล์, False ไม่บันทึก, True บันทึก

'พารามิเตอร์: TistUrl------ ที่อยู่หน้าเว็บปัจจุบัน

'=================================================' ==

ฟังก์ชันแทนที่SaveRemoteFile (ConStr, InstallPath, strChannelDir, SaveTf, TistUrl)

ถ้า ConStr="$False$" หรือ ConStr="" หรือ InstallPath="" หรือ strChannelDir="" จากนั้น

แทนที่SaveRemoteFile=ConStr

ออกจากฟังก์ชัน

สิ้นสุดถ้า

Dim TempStr, TempStr2, TempStr3, Re, แมตช์, แมตช์, Tempi, TempArray, TempArray2

ตั้ง Re = Regexp ใหม่

Re.IgnoreCase = จริง

Re.Global = จริง

Re.Pattern ="<img.+?>"

ตั้งค่าการจับคู่ = Re.Execute (ConStr)

สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน

ถ้า TempStr<>"" แล้ว

TempStr=TempStr & "$Array$" & Match.Value

อื่น

TempStr=Match.Value

จบถ้า

ต่อไป

ถ้า TempStr<>"" จากนั้น

TempArray=Split(TempStr,"$Array$")

TempStr=""

สำหรับ Tempi=0 ถึง Ubound(TempArray)

Re.Pattern ="src/s*=/s*.+?/.(gifjpgbmpjpegpsdpngsvgdxfwmftiff)" อีกครั้ง

ตั้งค่าการจับคู่ = Re.Execute (TempArray (Tempi))

สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน

ถ้า TempStr<>"" แล้ว

TempStr=TempStr & "$Array$" & Match.Value

อื่น

TempStr=Match.Value

จบถ้า

ต่อไป

ต่อไป

จบถ้า

ถ้า TempStr<>"" จากนั้น

Re.Pattern="src/s*=/s*"

TempStr=Re.Replace(TempStr,"")

สิ้นสุดถ้า

ตั้งค่าการจับคู่ = ไม่มีอะไรเลย

ตั้งค่า Re=nothing

ถ้า TempStr="" หรือ IsNull(TempStr)=True จากนั้น

แทนที่SaveRemoteFile=ConStr

ฟังก์ชั่นออก

จบถ้า

TempStr=แทนที่(TempStr,"""","")

TempStr=แทนที่(TempStr,"'","")

TempStr=แทนที่(TempStr," ","")

หรี่ RemoteFileurl, SavePath, PathTemp, DtNow, strFileName, strFileType, ArrSaveFileName, RanNum, Arr_Path

DtNow=ตอนนี้()

-

ถ้า SaveTf=True แล้ว

SavePath=InstallPath&strChannelDir

ถ้า CheckDir(InstallPath & strChannelDir)=False แล้ว

หากไม่ใช่ CreateMultiFolder (InstallPath & strChannelDir) จากนั้น

การตอบสนอง เขียน InstallPath & strChannelDir & "การสร้างไดเรกทอรีล้มเหลว"

SaveTf=เท็จ

สิ้นสุดถ้า

สิ้นสุดถ้า

สิ้นสุดถ้า

'เริ่มต้นด้วยการลบภาพที่ซ้ำกัน

TempArray=Split(TempStr,"$Array$")

TempStr=""

สำหรับ Tempi=0 ถึง Ubound(TempArray)

ถ้า Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 จากนั้น

TempStr=TempStr & "$Array$" & TempArray(เทมปี)

สิ้นสุดถ้า

ต่อไป

TempStr=ขวา(TempStr,เลน(TempStr)-7)

TempArray=Split(TempStr,"$Array$")

'ลบภาพที่ซ้ำกันและสิ้นสุด

ตอบกลับ เขียน "<br>พบรูปภาพ:<br>"&Replace(TempStr,"$Array$","<br>")

'เริ่มการแปลงที่อยู่รูปภาพแบบสัมพันธ์

TempStr=""

สำหรับ Tempi=0 ถึง Ubound(TempArray)

TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)

ต่อไป

TempStr=ขวา(TempStr,เลน(TempStr)-7)

TempStr=แทนที่(TempStr,Chr(0),"")

TempArray2=แยก(TempStr,"$Array$")

TempStr=""

'สิ้นสุดการแปลงที่อยู่รูปภาพแบบสัมพันธ์

'เปลี่ยน/บันทึกรูปภาพ'

ตั้ง Re = Regexp ใหม่

Re.IgnoreCase = จริง

Re.Global = จริง

สำหรับ Tempi=0 ถึง Ubound(TempArray2)

-

RemoteFileUrl=TempArray2(เทมปี)

ถ้า RemoteFileUrl<>"$False$" และ SaveTf=True จากนั้นให้บันทึกรูปภาพ

ArrSaveFileName = แยก (RemoteFileurl,".")

strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'ประเภทไฟล์

ถ้า strFileType="asp" หรือ strFileType="asa" หรือ strFileType="aspx" หรือ strFileType="cer" หรือ strFileType="cdx" หรือ strFileType="exe" หรือ strFileType="rar" หรือ strFileType="zip" แล้ว

อัพโหลดไฟล์ = ""

แทนที่SaveRemoteFile=ConStr

ออกจากฟังก์ชัน

สิ้นสุดถ้า

สุ่ม

RanNum=Int(900*Rnd)+100

strFileName = ปี (DtNow) & ขวา ("0" & ​​​​เดือน (DtNow),2) & ขวา ("0" & ​​​​วัน (DtNow),2) & ขวา ("0" & ​​​​ชั่วโมง (DtNow ),2) & ขวา ("0" & ​​​​นาที(DtNow),2) & ขวา ("0" & ​​​​วินาที (DtNow),2) & ranNum & "." & strFileType

Re.Pattern =TempArray(เทมปี)

response.Write "<br>บันทึกไปยังที่อยู่ในเครื่อง:"&InstallPath & strChannelDir & strFileName

ถ้า SaveRemoteFile(InstallPath & strChannelDir & strFileName,RemoteFileUrl,RemoteFileUrl)=True แล้ว

response.เขียน "<font color=blue>Success</font><br>"

PathTemp=InstallPath & strChannelDir & strFileName

ConStr=Re.Replace(ConStr,PathTemp)

Re.Pattern=InstallPath&strChannelDir

UploadFiles=UploadFiles & "" & InstallPath & strChannelDir & strFileName

อื่น

PathTemp=RemoteFileUrl

ConStr=Re.Replace(ConStr,PathTemp)

สิ้นสุดถ้า

ElseIf RemoteFileurl<>"$False$" และ SaveTf=False จากนั้นอย่าบันทึกรูปภาพ

Re.Pattern =TempArray(เทมปี)

ConStr=Re.Replace(ConStr,RemoteFileUrl)

สิ้นสุดถ้า

-

ต่อไป

ตั้งค่า Re=nothing

แทนที่SaveRemoteFile=ConStr

สิ้นสุดฟังก์ชัน

'=================================================' ==

'ชื่อฟังก์ชัน:แทนที่SwfFile

'ฟังก์ชัน: แยกวิเคราะห์เส้นทางภาพเคลื่อนไหว'

'พารามิเตอร์: ConStr ------ สตริงที่จะถูกแทนที่

'พารามิเตอร์: TistUrl------ ที่อยู่หน้าเว็บปัจจุบัน

'=================================================' ==

ฟังก์ชันแทนที่SwfFile(ConStr,TistUrl)

ถ้า ConStr="$False$" หรือ ConStr="" หรือ TistUrl="" หรือ TistUrl="$False$" แล้ว

แทนที่SwfFile=ConStr

ออกจากฟังก์ชัน

สิ้นสุดถ้า

Dim TempStr, TempStr2, TempStr3, Re, แมตช์, แมตช์, Tempi, TempArray, TempArray2

ตั้ง Re = Regexp ใหม่

Re.IgnoreCase = จริง

Re.Global = จริง

Re.Pattern ="<object.+?[^/>]>"

ตั้งค่าการจับคู่ = Re.Execute (ConStr)

สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน

ถ้า TempStr<>"" แล้ว

TempStr=TempStr & "$Array$" & Match.Value

อื่น

TempStr=Match.Value

จบถ้า

ต่อไป

ถ้า TempStr<>"" จากนั้น

TempArray=Split(TempStr,"$Array$")

TempStr=""

สำหรับ Tempi=0 ถึง Ubound(TempArray)

Re.Pattern ="value/s*=/s*.+?/.swf"

ตั้งค่าการจับคู่ =Re.Execute(TempArray(Tempi))

สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน

ถ้า TempStr<>"" แล้ว

TempStr=TempStr & "$Array$" & Match.Value

อื่น

TempStr=Match.Value

จบถ้า

ต่อไป

ต่อไป

จบถ้า

ถ้า TempStr<>"" จากนั้น

Re.Pattern ="value/s*=/s*"

TempStr=Re.Replace(TempStr,"")

สิ้นสุดถ้า

ถ้า TempStr="" หรือ IsNull(TempStr)=True จากนั้น

แทนที่SwfFile=ConStr

ฟังก์ชั่นออก

จบถ้า

TempStr=แทนที่(TempStr,"""","")

TempStr=แทนที่(TempStr,"'","")

TempStr=แทนที่(TempStr," ","")

ตั้งค่าการจับคู่ = ไม่มีอะไรเลย

ตั้งค่า Re=nothing

'เริ่มต้นด้วยการลบไฟล์ที่ซ้ำกัน

TempArray=Split(TempStr,"$Array$")

TempStr=""

สำหรับ Tempi=0 ถึง Ubound(TempArray)

ถ้า Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 จากนั้น

TempStr=TempStr & "$Array$" & TempArray(เทมปี)

สิ้นสุดถ้า

ต่อไป

TempStr=ขวา(TempStr,เลน(TempStr)-7)

TempArray=Split(TempStr,"$Array$")

'ลบไฟล์ที่ซ้ำกันและสิ้นสุด

'เริ่มการแปลงที่อยู่ที่เกี่ยวข้อง

TempStr=""

สำหรับ Tempi=0 ถึง Ubound(TempArray)

TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)

ต่อไป

TempStr=ขวา(TempStr,เลน(TempStr)-7)

TempStr=แทนที่(TempStr,Chr(0),"")

TempArray2=แยก(TempStr,"$Array$")

TempStr=""

'สิ้นสุดการแปลงที่อยู่แบบสัมพันธ์

'แทนที่

ตั้ง Re = Regexp ใหม่

Re.IgnoreCase = จริง

Re.Global = จริง

สำหรับ Tempi=0 ถึง Ubound(TempArray2)

RemoteFileUrl=TempArray2(เทมปี)

Re.Pattern =TempArray(เทมปี)

ConStr=Re.Replace(ConStr,RemoteFileUrl)

ต่อไป

ตั้งค่า Re=nothing

แทนที่SwfFile=ConStr

สิ้นสุดฟังก์ชัน

'=================================================' ==

'ชื่อกระบวนการ: SaveRemoteFile

'ฟังก์ชัน: บันทึกไฟล์ระยะไกลลงในเครื่อง'

'พารามิเตอร์: LocalFileName ------ ชื่อไฟล์ในเครื่อง

'พารามิเตอร์: RemoteFileUrl ------ URL ไฟล์ระยะไกล

'พารามิเตอร์: ผู้อ้างอิง ------ ไฟล์การโทรระยะไกล (สำหรับการป้องกันการรวบรวม ให้ใช้ที่อยู่หน้าเนื้อหา ปล่อยว่างไว้หากไม่มีการป้องกันการรวบรวม)

'=================================================' ==

ฟังก์ชั่น SaveRemoteFile (LocalFileName, RemoteFileUrl, Referer)

SaveRemoteFile=จริง

โฆษณาสลัว, การดึงข้อมูล, GetRemoteData

ตั้งค่าการเรียกข้อมูล = Server.CreateObject("Microsoft.XMLHTTP")

ด้วยการเรียกค้น

. เปิด "รับ", RemoteFileUrl, เท็จ, "", ""

ถ้าผู้อ้างอิง<>"" ดังนั้น .setRequestHeader "ผู้อ้างอิง",ผู้อ้างอิง

.ส่ง

ถ้า .Readystate<>4 แล้ว

SaveRemoteFile=เท็จ

ออกจากฟังก์ชัน

สิ้นสุดถ้า

GetRemoteData = .ResponseBody

จบด้วย

ตั้งค่าการดึงข้อมูล = ไม่มีเลย

ตั้งค่าโฆษณา = Server.CreateObject("Adodb.Stream")

ด้วยโฆษณา

.ประเภท = 1

.เปิด

.เขียน GetRemoteData

.เซิร์ฟเวอร์ SaveToFile.MapPath(LocalFileName),2

.ยกเลิก()

.ปิด()

จบด้วย

ตั้งโฆษณา=ไม่มีอะไร

สิ้นสุดฟังก์ชัน

'=================================================' ==

'ชื่อฟังก์ชัน: GetPaing

'ฟังก์ชัน: รับการแบ่งหน้า'

'=================================================' ==

ฟังก์ชั่น GetPaing (Byval ConStr, StartStr, OverStr, IncluL, IncluR)

ถ้า ConStr="$False$" หรือ ConStr="" หรือ StartStr="" หรือ OverStr="" หรือ IsNull(ConStr)=True หรือ IsNull(StartStr)=True หรือ IsNull(OverStr)=True แล้ว

GetPaing="$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

เริ่มต้นติ่มซำ, เกิน, ConTemp, TempStr

TempStr=LCase(ConStr)

StartStr=LCase(StartStr)

OverStr=Lกรณี(OverStr)

เกิน=Instr(1,TempStr,OverStr)

ถ้าเกิน<=0 แล้ว

GetPaing="$False$"

ออกจากฟังก์ชัน

อื่น

ถ้า InclR=True แล้ว

สูง=โอเวอร์+เลน(OverStr)

สิ้นสุดถ้า

สิ้นสุดถ้า

TempStr=กลาง(TempStr,1,สูงกว่า)

เริ่มต้น=InstrRev(TempStr,StartStr)

ถ้า IncluL=False แล้ว

เริ่มต้น=เริ่ม+เลน(StartStr)

สิ้นสุดถ้า

ถ้าเริ่ม<=0หรือเริ่ม>=มากกว่านั้น

GetPaing="$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

ConTemp=กลาง(ConStr,สตาร์ท,โอเวอร์สตาร์ท)

ConTemp=ตัดแต่ง(ConTemp)

'ConTemp=แทนที่(ConTemp," ","")

ConTemp=แทนที่(ConTemp,",","")

ConTemp=แทนที่(ConTemp,"'","")

ConTemp=แทนที่(ConTemp,"""","")

ConTemp=แทนที่(ConTemp,">","")

ConTemp=แทนที่(ConTemp,"<", "")

ConTemp=แทนที่(ConTemp," ;","")

GetPaing=ConTemp

ฟังก์ชันสิ้นสุด

-

'ชื่อฟังก์ชัน: gotTopic

'ฟังก์ชัน: ตัดทอนสตริง ตัวอักษรจีนแต่ละตัวนับเป็นอักขระสองตัว และอักขระภาษาอังกฤษนับเป็นอักขระหนึ่งตัว

'พารามิเตอร์: str ---- สตริงเดิม

' strlen ---- ตัดความยาว

'ค่าที่ส่งคืน: สตริงที่ถูกดักจับ'

-

ฟังก์ชั่น gotTopic (str, strlen)

ถ้า str="" แล้ว

ได้หัวข้อ = ""

ฟังก์ชั่นทางออก

สิ้นสุดถ้า

สลัว l,t,c, i

str=แทนที่(แทนที่(แทนที่(แทนที่(str," "," "),""",chr(34)),">",">"),"<", "<")

l=เลน(str)

เสื้อ=0

สำหรับ i=1 ถึง l

c=Abs(Asc(กลาง(str,i,1)))

ถ้า c>255 แล้ว

เสื้อ=t+2

อื่น

เสื้อ=t+1

สิ้นสุดถ้า

ถ้า t>=strlen แล้ว

gotTopic=left(str,i) & "…"

ออกเพื่อ

อื่น

gotTopic=str

สิ้นสุดถ้า

ต่อไป

gotTopic=replace(แทนที่(แทนที่(แทนที่(gotTopic," "," "),chr(34),"""),">",">"),"<", "<;")

ฟังก์ชั่นสิ้นสุด

-

'ชื่อฟังก์ชั่น: JoinChar

'ฟังก์ชั่น: เพิ่ม ? หรือ & ไปยังที่อยู่

'พารามิเตอร์: strUrl ---- URL'

'ค่าส่งคืน: URL ที่มี ? หรือ & เพิ่ม'

-

ฟังก์ชั่น JoinChar (strUrl)

ถ้า strUrl="" แล้ว

เข้าร่วมชาร์ = ""

ฟังก์ชั่นทางออก

สิ้นสุดถ้า

ถ้า InStr(strUrl,"?")<len(strUrl) แล้ว

ถ้า InStr(strUrl,"?")>1 แล้ว

ถ้า InStr(strUrl,"&")<len(strUrl) แล้ว

JoinChar=strUrl & "&"

อื่น

JoinChar=strUrl

สิ้นสุดถ้า

อื่น

JoinChar=strUrl & "?"

สิ้นสุดถ้า

อื่น

JoinChar=strUrl

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

'************************************************ *

'ชื่อฟังก์ชัน: CreateKeyWord

'ฟังก์ชั่น: สร้างคำสำคัญจากสตริงที่กำหนด

'พารามิเตอร์: Constr---สตริงเดิมเพื่อสร้างคำหลัก

'ค่าส่งคืน: คำหลักที่สร้างขึ้น

'************************************************ *

ฟังก์ชั่น CreateKeyWord (byval Constr, Num)

ถ้า Constr="" หรือ IsNull(Constr)=True หรือ Constr="$False$" แล้ว

CreateKeyWord="$False$"

ออกจากฟังก์ชัน

สิ้นสุดถ้า

ถ้า Num="" หรือ IsNumeric(Num)=False แล้ว

หมายเลข=2

สิ้นสุดถ้า

Constr=แทนที่(Constr,CHR(32),"")

Constr=แทนที่(Constr,CHR(9),"")

Constr=แทนที่(Constr," ","")

Constr=แทนที่(Constr," ","")

Constr=แทนที่(Constr,"("")

Constr=แทนที่(Constr,")","")

Constr=แทนที่(Constr,"<"")

Constr=แทนที่(Constr,">,"")

Constr=แทนที่(Constr,"""","")

Constr=แทนที่(Constr,"?","")

Constr=แทนที่(Constr,"*,"")

Constr=แทนที่(Constr,","")

Constr=แทนที่(Constr,",","")

Constr=แทนที่(Constr,".","")

Constr=แทนที่(Constr,"/","")

Constr=แทนที่(Constr,"/","")

Constr=แทนที่(Constr,"-", "")

Constr=แทนที่(Constr,"@","")

Constr=แทนที่(Constr,"#","")

Constr=แทนที่(Constr,"$","")

Constr=แทนที่(Constr,"%", "")

Constr=แทนที่(Constr,"&","")

Constr=แทนที่(Constr,"+","")

Constr=แทนที่(Constr,::,"")

Constr=แทนที่(Constr,"：","")

Constr=แทนที่(Constr,"'","")

Constr=แทนที่(Constr,"","")

Constr=แทนที่(Constr,"","")

หรี่ฉัน, ConstrTemp

สำหรับ i=1 ถึง Len(Constr)

ConstrTemp=ConstrTemp & "" & Mid(Constr,i,Num)

ต่อไป

ถ้า Len(ConstrTemp)<254 แล้ว

ConstrTemp=ConstrTemp & ""

อื่น

ConstrTemp=ซ้าย(ConstrTemp,254) & ""

สิ้นสุดถ้า

CreateKeyWord=ConstrTemp

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: CheckUrl

'ฟังก์ชัน: ตรวจสอบ URL'

'พารามิเตอร์: strUrl ------ เพื่อตรวจสอบ URL

'=================================================' ==

ฟังก์ชั่น CheckUrl(strUrl)

ดิม เร

ตั้งค่า Re=new RegExp

Re.IgnoreCase=จริง

Re.Global=จริง

Re.Pattern="http://([/w-]+/.)+[/w-]+(/[/w-./?%&=]*)?"

ถ้า Re.test(strUrl)=True แล้ว

CheckUrl=strUrl

อื่น

CheckUrl="$False$"

สิ้นสุดถ้า

ตั้งค่า Rs=ไม่มีอะไร

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: ScriptHtml

'ฟังก์ชัน: กรองแท็ก html'

'พารามิเตอร์: ConStr ------ สตริงที่จะกรอง

'=================================================' ==

ฟังก์ชั่น ScriptHtml (Byval ConStr, TagName, FType)

ดิม เร

ตั้งค่า Re=new RegExp

Re.IgnoreCase=จริง

Re.Global=จริง

เลือก ชนิด FType

กรณีที่ 1

Re.Pattern="<" & TagName & "([^>])*>"

ConStr=Re.Replace(ConStr,"")

กรณีที่ 2

Re.Pattern="<" & TagName & "([^>])*>.*?</" & TagName & "([^>])*>"

ConStr=Re.Replace(ConStr,"")

กรณีที่ 3

Re.Pattern="<" & TagName & "([^>])*>"

ConStr=Re.Replace(ConStr,"")

Re.Pattern="</" & TagName & "([^>])*>"

ConStr=Re.Replace(ConStr,"")

สิ้นสุดการเลือก

ScriptHtml=ConStr

ตั้งค่า Re=Nothing

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: RemoveHTML

'ฟังก์ชัน: ลบแท็ก html ออกโดยสมบูรณ์

'พารามิเตอร์: strHTML ------ สตริงที่ต้องการกรอง

'=================================================' ==

ฟังก์ชั่น RemoveHTML(strHTML)

Dim objRegExp, แมตช์, แมตช์

ตั้งค่า objRegExp = Regexp ใหม่

objRegExp.IgnoreCase = จริง

objRegExp.Global = จริง

'ปิดเทอมแล้ว <>

objRegExp.Pattern = "<.+?>"

'จับคู่

ตั้งค่าการจับคู่ = objRegExp.Execute(strHTML)

' สำรวจชุดที่ตรงกันและแทนที่รายการที่ตรงกัน

สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน

strHtml=แทนที่(strHTML,Match.Value,"")

ต่อไป

RemoveHTML=strHTML

ตั้งค่า objRegExp = ไม่มีเลย

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: CheckDir

'ฟังก์ชั่น: ตรวจสอบว่ามีโฟลเดอร์อยู่หรือไม่

'พารามิเตอร์: FolderPath ------ เส้นทางโฟลเดอร์

'=================================================' ==

ฟังก์ชั่น CheckDir (byval FolderPath)

สลัว fso

ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")

ถ้า fso.FolderExists(Server.MapPath(folderpath)) แล้ว

'มีอยู่

CheckDir = จริง

อื่น

'ไม่มีอยู่จริง

CheckDir = เท็จ

จบถ้า

ตั้งค่า fso = ไม่มีเลย

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: MakeNewsDir'

'ฟังก์ชัน: สร้างโฟลเดอร์'

'พารามิเตอร์: ชื่อโฟลเดอร์ ------ ชื่อโฟลเดอร์

'=================================================' ==

ฟังก์ชั่น MakeNewsDir (ชื่อโฟลเดอร์ byval)

สลัว fso

ตั้งค่า fso = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")

fso.CreateFolder (Server.MapPath (ชื่อโฟลเดอร์))

ถ้า fso.FolderExists(Server.MapPath(ชื่อโฟลเดอร์)) จากนั้น

MakeNewsDir = จริง

อื่น

MakeNewsDir = เท็จ

สิ้นสุดถ้า

ตั้งค่า fso = ไม่มีเลย

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชัน: DelDir

'ฟังก์ชัน: สร้างโฟลเดอร์'

'พารามิเตอร์: ชื่อโฟลเดอร์ ------ ชื่อโฟลเดอร์

'=================================================' ==

ฟังก์ชั่น DelDir (ชื่อโฟลเดอร์ byval)

สลัว fso

ตั้งค่า fso = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")

ถ้า fso.FolderExists(Server.MapPath(ชื่อโฟลเดอร์)) จากนั้น 'ตรวจสอบว่ามีโฟลเดอร์อยู่หรือไม่

fso.DeleteFolder (Server.MapPath (ชื่อโฟลเดอร์)) 'ลบโฟลเดอร์

สิ้นสุดถ้า

ตั้งค่า fso = ไม่มีเลย

ฟังก์ชันสิ้นสุด

'************************************************ *

'ชื่อฟังก์ชัน: IsObjInstalled'

'ฟังก์ชั่น: ตรวจสอบว่าได้ติดตั้งส่วนประกอบแล้วหรือไม่

'พารามิเตอร์: strClassString ---- ชื่อส่วนประกอบ

'ค่าส่งคืน: จริง ---- ติดตั้งแล้ว'

' เท็จ ---- ไม่ได้ติดตั้ง

'************************************************ *

ฟังก์ชัน IsObjInstalled (strClassString)

IsObjInstalled = เท็จ

ผิดพลาด = 0

DimxTestObj

ตั้งค่า xTestObj = Server.CreateObject(strClassString)

ถ้า 0 = ผิดพลาด ดังนั้น IsObjInstalled = True

ตั้งค่า xTestObj = ไม่มีเลย

ผิดพลาด = 0

ฟังก์ชันสิ้นสุด

'************************************************ *

'ชื่อฟังก์ชั่น: strLength

'ฟังก์ชัน: ค้นหาความยาวของสตริง' ตัวอักษรจีนนับเป็นสองตัวอักษร และตัวอักษรภาษาอังกฤษนับเป็นหนึ่งตัวอักษร

'พารามิเตอร์: str ----สตริงที่มีความยาวที่ต้องการ

'ค่าที่ส่งคืน: ความยาวสตริง'

'************************************************ *

ฟังก์ชั่น strLength (str)

เมื่อเกิดข้อผิดพลาด ดำเนินการต่อต่อไป

สลัว WINNT_CHINESE

WINNT_CHINESE = (len("จีน")=2)

ถ้า WINNT_CHINESE แล้ว

สลัว l,t,c

สลัวฉัน

l=เลน(str)

เสื้อ=ล

สำหรับ i=1 ถึง l

c=asc(กลาง(str,i,1))

ถ้า c<0 แล้ว c=c+65536

ถ้า c>255 แล้ว

เสื้อ=t+1

สิ้นสุดถ้า

ต่อไป

strLength=t

อื่น

strLength=เลน(str)

สิ้นสุดถ้า

ถ้า err.number<>0 แสดงว่า err.clear

ฟังก์ชั่นสิ้นสุด

'************************************************ * **

'ชื่อฟังก์ชัน: CreateMultiFolder

'ฟังก์ชัน: สร้างไดเร็กทอรีหลายระดับ คุณสามารถสร้างไดเร็กทอรีรากที่ไม่มีอยู่จริงได้

'พารามิเตอร์: ชื่อของไดเร็กทอรีที่จะสร้างซึ่งสามารถมีได้หลายระดับ

'ส่งคืนค่าตรรกะ: จริงเมื่อสำเร็จ เท็จเมื่อล้มเหลว

'สร้างไดเร็กทอรีรากของไดเร็กทอรีโดยเริ่มจากไดเร็กทอรีปัจจุบัน

'************************************************ * **

ฟังก์ชั่น CreateMultiFolder (ByVal CFolder)

หรี่ objFSO, PhCreateFolder, CreateFolderArray, CreateFolder

หรี่ i, ii, CreateFolderSub, PhCreateFolderSub, BlInfo

BlInfo=เท็จ

CreateFolder = CFolder

เมื่อเกิดข้อผิดพลาด ดำเนินการต่อต่อไป

ตั้ง objFSO = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")

หากผิดพลาดแล้ว

ผิดพลาด.เคลียร์()

ออกจากฟังก์ชัน

สิ้นสุดถ้า

CreateFolder = แทนที่(CreateFolder,"/","/")

ถ้าซ้าย(CreateFolder,1)="/" จากนั้น

'CreateFolder = ขวา(CreateFolder,Len(CreateFolder)-1)

สิ้นสุดถ้า

ถ้าใช่(CreateFolder,1)="/" จากนั้น

CreateFolder = ซ้าย(CreateFolder,Len(CreateFolder)-1)

สิ้นสุดถ้า

CreateFolderArray = แยก (CreateFolder,"/")

สำหรับ i = 0 ถึง UBound (CreateFolderArray)

CreateFolderSub = ""

สำหรับ ii = 0 ถึง i

CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/"

ต่อไป

PhCreateFolderSub = Server.MapPath (CreateFolderSub)

'response.เขียน PhCreateFolderSub&"<br>"

ถ้าไม่ใช่ objFSO.FolderExists(PhCreateFolderSub) จากนั้น

objFSO.CreateFolder (PhCreateFolderSub)

สิ้นสุดถ้า

ต่อไป

หากผิดพลาดแล้ว

ผิดพลาด.เคลียร์()

อื่น

BlInfo=จริง

สิ้นสุดถ้า

ตั้งค่า objFSO=nothing

CreateMultiFolder = BlInfo

ฟังก์ชันสิ้นสุด

'************************************************ *

'ชื่อฟังก์ชัน: FSOFileRead

'ฟังก์ชัน: ใช้ FSO เพื่ออ่านฟังก์ชันเนื้อหาไฟล์'

'พารามิเตอร์: ชื่อไฟล์ ---- ชื่อไฟล์'

'ค่าส่งคืน: เนื้อหาไฟล์

'************************************************ *

ฟังก์ชั่น FSOFileRead (ชื่อไฟล์)

หรี่ objFSO, objCountFile, FiletempData

ตั้ง objFSO = Server.CreateObject("Scripting.FileSystemObject")

ตั้งค่า objCountFile = objFSO.OpenTextFile(Server.MapPath(ชื่อไฟล์),1,True)

FSOFileRead = objCountFile.ReadAll

objCountFile ปิด

ตั้งค่า objCountFile=ไม่มีอะไร

ตั้ง objFSO = ไม่มีเลย

ฟังก์ชันสิ้นสุด

'************************************************ *

'ชื่อฟังก์ชัน: FSOlineedit

'ฟังก์ชัน: ใช้ FSO เพื่ออ่านบรรทัดหนึ่งของฟังก์ชันไฟล์'

'พารามิเตอร์: ชื่อไฟล์ ---- ชื่อไฟล์'

' lineNum ---- หมายเลขบรรทัด

'ค่าที่ส่งคืน: เนื้อหาของบรรทัดในไฟล์'

'************************************************ *

ฟังก์ชั่น FSOlineedit (ชื่อไฟล์, lineNum)

ถ้า linenum < 1 ให้ออกจากฟังก์ชัน

fso,f,temparray,tempcnt สลัว

ตั้ง fso = server.CreateObject("scripting.filesystemobject")

ถ้าไม่ใช่ fso.fileExists(server.mappath(filename)) ให้ออกจากฟังก์ชัน

ตั้งค่า f = fso.opentextfile (server.mappath (ชื่อไฟล์), 1)

ถ้าไม่ใช่ f.AtEndofStream แล้ว

tempcnt = f.readall

ฉ.ปิด

เซต f = ไม่มีอะไร

temparray = แยก(tempcnt,chr(13)&chr(10))

ถ้า lineNum>ubound(temparray)+1 แล้ว

ฟังก์ชั่นทางออก

อื่น

FSOlineedit = ชั่วคราว (lineNum-1)

สิ้นสุดถ้า

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

'************************************************ *

'ชื่อฟังก์ชัน: FSOlinewrite

'ฟังก์ชัน: ใช้ FSO เพื่อเขียนบรรทัดหนึ่งของฟังก์ชันไฟล์'

'พารามิเตอร์: ชื่อไฟล์ ---- ชื่อไฟล์'

' lineNum ---- หมายเลขบรรทัด

' เนื้อหาไลน์ ---- เนื้อหา

'มูลค่าที่ส่งคืน: ไม่มี'

'************************************************ *

ฟังก์ชั่น FSOlinewrite (ชื่อไฟล์, lineNum, Linecontent)

ถ้า linenum < 1 ให้ออกจากฟังก์ชัน

หรี่ fso, f, ชั่วคราว, tempCnt

ตั้ง fso = server.CreateObject("scripting.filesystemobject")

ถ้าไม่ใช่ fso.fileExists(server.mappath(filename)) ให้ออกจากฟังก์ชัน

ตั้งค่า f = fso.opentextfile (server.mappath (ชื่อไฟล์), 1)

ถ้าไม่ใช่ f.AtEndofStream แล้ว

tempcnt = f.readall

ฉ.ปิด

temparray = แยก(tempcnt,chr(13)&chr(10))

ถ้า lineNum>ubound(temparray)+1 แล้ว

ฟังก์ชั่นทางออก

อื่น

temparray(lineNum-1) = lineContent

สิ้นสุดถ้า

tempcnt = เข้าร่วม (temparray,chr(13)&chr(10))

ตั้งค่า f = fso.createtextfile (server.mappath (ชื่อไฟล์), จริง)

f.writetempcnt

สิ้นสุดถ้า

ฉ.ปิด

เซต f = ไม่มีอะไร

ฟังก์ชั่นสิ้นสุด

'************************************************ *

'ชื่อฟังก์ชัน: Htmlmake

'ฟังก์ชัน: ใช้ FSO เพื่อสร้างไฟล์'

'พารามิเตอร์: HtmlFolder ---- เส้นทาง

' HtmlFilename ---- ชื่อไฟล์

'เนื้อหา Html ---- เนื้อหา

'************************************************ *

ฟังก์ชั่น Htmlmake (HtmlFolder, HtmlFilename, HtmlContent)

เมื่อเกิดข้อผิดพลาด ดำเนินการต่อต่อไป

เส้นทางไฟล์สลัว fso fout

filepath = HtmlFolder&"/"&HtmlFilename

ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")

ถ้า fso.FolderExists(HtmlFolder) แล้ว

อื่น

CreateMultiFolder(HtmlFolder)

&, ;nbs, p; สิ้นสุดถ้า

ตั้งค่า fout = fso.Createtextfile(server.mappath(filepath),true)

fout.writeline HtmlContent

fout.ปิด

ตั้งค่า fso=nothing

ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")

ถ้า fso.fileexists(Server.MapPath(filepath)) แล้ว

Response.Write "สร้างไฟล์<font color=red>"&HtmlFilename&"</font> แล้ว!<br>"

อื่น

'Response.Write Server.MapPath (เส้นทางไฟล์)

Response.Write "ไฟล์<font color=red>"&HtmlFilename&"</font> ไม่ได้ถูกสร้างขึ้น!<br>"

สิ้นสุดถ้า

ตั้งค่า fso = ไม่มีเลย

สิ้นสุดฟังก์ชัน

'************************************************ *

'ชื่อฟังก์ชัน: Htmldel

'ฟังก์ชัน: ใช้ FSO เพื่อลบไฟล์'

'พารามิเตอร์: HtmlFolder ---- เส้นทาง

' HtmlFilename ---- ชื่อไฟล์

'************************************************ *

Htmldel ย่อย (HtmlFolder, HtmlFilename)

เส้นทางไฟล์สลัว fso

filepath = HtmlFolder&"/"&HtmlFilename

ตั้งค่า fso = CreateObject("Scripting.FileSystemObject")

fso.DeleteFile (เซิร์ฟเวอร์ mappath (เส้นทางไฟล์))

ตั้งค่า fso = ไม่มีเลย

ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")

ถ้า fso.fileexists(Server.MapPath(filepath)) แล้ว

Response.Write "ไฟล์<font color=red>"&HtmlFilename&"</font> ไม่ถูกลบ!<br>"

อื่น

'Response.Write Server.MapPath (เส้นทางไฟล์)

Response.Write "ไฟล์<font color=red>"&HtmlFilename&"</font> ถูกลบแล้ว!<br>"

สิ้นสุดถ้า

ตั้งค่า fso = ไม่มีเลย

จบหมวดย่อย

-

'ชื่อกระบวนการ: HTMLEncode'

'ฟังก์ชั่น: กรองรูปแบบ HTML'

'พารามิเตอร์: fString ---- เนื้อหาการแปลง

-

ฟังก์ชั่น HTMLEncode (ByVal fString)

ถ้า IsNull(fString)=False หรือ fString<>"" หรือ fString<>"$False$" จากนั้น

fString = แทนที่(fString, ">", ">")

fString = แทนที่(fString, "<", "<")

fString = แทนที่ (fString, Chr (32), " ")

fString = แทนที่ (fString, Chr(9), " ")

fString = แทนที่(fString, Chr(34), """)

fString = แทนที่(fString, Chr(39), "'")

fString = แทนที่(fString, Chr(13), "")

fString = แทนที่ (fString, " ", " ")

fString = แทนที่(fString, CHR(10) & CHR(10), "</P><P>")

fString = แทนที่(fString, Chr(10), "<br /> ")

HTMLEncode = fString

อื่น

HTMLEncode = "$False$"

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

-

'ชื่อกระบวนการ: unHTMLEncode'

'ฟังก์ชั่น: กู้คืนรูปแบบ HTML'

'พารามิเตอร์: fString ---- เนื้อหาการแปลง

-

ฟังก์ชั่น unHTMLEncode (ByVal fString)

ถ้า IsNull(fString)=False หรือ fString<>"" หรือ fString<>"$False$" จากนั้น

fString = แทนที่(fString, ">", ">")

fString = แทนที่(fString, "<", "<")

fString = แทนที่ (fString, " ", Chr(32))

fString = แทนที่ (fString, """, Chr(34))

fString = แทนที่ (fString, "'", Chr(39))

fString = แทนที่ (fString, "", Chr(13))

fString = แทนที่ (fString, " ", " ")

fString = แทนที่(fString, "</P><P>" , CHR(10) & CHR(10))

fString = แทนที่(fString, "<br> ", Chr(10))

unHTMLEncode = fString

อื่น

unHTMLEncode = "$False$"

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

ฟังก์ชั่น unhtmllist (เนื้อหา)

unhtmllist=content

ถ้าเนื้อหา <> "" แล้ว

unhtmllist=replace(unhtmllist,"'","";")

unhtmllist=replace(unhtmllist,chr(10),"")

unHtmllist=แทนที่(unHtmllist,chr(13),"<br>")

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

ฟังก์ชั่น unhtmllists (เนื้อหา)

unhtmllists=content

ถ้าเนื้อหา <> "" แล้ว

unhtmllists=replace(unhtmlรายการ"""","")

unhtmllists=replace(unhtmlรายการ"""")

unhtmllists=replace(unhtmllists,chr(10),"")

unHtmllists=แทนที่(unHtmllists,chr(13),"<br>")

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

ฟังก์ชั่น htmllists (เนื้อหา)

htmllists=เนื้อหา

ถ้าเนื้อหา <> "" แล้ว

htmllists=replace(htmlรายการ"''"""")

htmllists=replace(htmlรายการ,"", "'")

htmllists=replace(htmlรายการ,"<br>",chr(13)&chr(10))

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

ฟังก์ชั่น uhtmllists (เนื้อหา)

uhtmllists=content

ถ้าเนื้อหา <> "" แล้ว

uhtlists=replace(uhtlists,"""","''")

uhtlists=replace(uhtlists,"'","";")

uhtlists=แทนที่(uhtlists,chr(10),"")

uHtmllists=แทนที่(uHtmllists,chr(13),"<br>")

สิ้นสุดถ้า

ฟังก์ชั่นสิ้นสุด

-

'กระบวนการ: นอนหลับ'

'ฟังก์ชัน: โปรแกรมหยุดอยู่ที่นี่สักครู่'

'พารามิเตอร์: iSeconds จำนวนวินาทีที่จะหยุดชั่วคราว

-

การนอนหลับย่อย(iSeconds)

การตอบสนองเขียน "<font color=blue>เริ่มหยุดชั่วคราวเป็นเวลา "&iSeconds&" วินาที</font><br>"

หรี่ t:t=ตัวจับเวลา()

ในขณะที่(จับเวลา()<t+iSeconds)

'ไม่ทำอะไรเลย

เวนด์

การตอบสนองเขียน "<font color=blue>Pause"&iSeconds&" สิ้นสุดวินาที</font><br>"

จบหมวดย่อย

'=================================================' ==

'ชื่อฟังก์ชัน: MyArray

'ฟังก์ชัน: แยกแท็กเพื่อแยกออกจากกัน'

'พารามิเตอร์: ConStr ------ แยกอักขระดั้งเดิมของที่อยู่

'=================================================' ==

ฟังก์ชั่น MyArray(ByvalConStr)

ตั้งค่า objRegExp = Regexp ใหม่

objRegExp.IgnoreCase = จริง

objRegExp.Global = จริง

objRegExp.Pattern = "({).+?(})"

ตั้งค่าการจับคู่ =objRegExp.Execute(ConStr)

สำหรับการแข่งขันแต่ละครั้งในการแข่งขัน

TempStr=TempStr & "" & Match.Value

ต่อไป

ตั้งค่าการจับคู่ = ไม่มีอะไรเลย

TempStr=ขวา(TempStr,เลน(TempStr)-1)

objRegExp.Pattern = "{"

TempStr=objRegExp.แทนที่(TempStr,"")

objRegExp.Pattern = "}"

TempStr=objRegExp.แทนที่(TempStr,"")

ตั้งค่า objRegExp=nothing

ตั้งค่าการจับคู่ = ไม่มีอะไรเลย

TempStr=แทนที่(TempStr,"$","")

ถ้า TempStr="" แล้ว

MyArray="ไม่มีอะไรที่จะแยกเป็นโค้ด"

อื่น

MyArray=TempStr

จบถ้า

ฟังก์ชันสิ้นสุด

'=================================================' ==

'ชื่อฟังก์ชั่น: randm

'ฟังก์ชัน: สร้างตัวเลขสุ่ม 6 หลัก'

'=================================================' ==

ฟังก์ชันแบบสุ่ม

สุ่ม

randm=Int((900000*รอบ)+100000)

ฟังก์ชันสิ้นสุด

-