รหัสโปรแกรม
-
-
'ชื่อชั้นเรียน:
'ชื่อ: ห้องสมุดทั่วไป
วันที่: 28/10/2551
'ผู้เขียน: โดย xilou
เว็บไซต์: http://www.chinacms.org
'คำอธิบาย: ห้องสมุดทั่วไป
'ลิขสิทธิ์: โปรดระบุแหล่งที่มาและผู้แต่งเมื่อพิมพ์ซ้ำ
-
'แก้ไขล่าสุด: 20090108
'จำนวนการแก้ไข: 2
'คำอธิบายการแก้ไข:
'20090108 เพิ่มฟังก์ชันต่อไปนี้:
' A2U(),U2A(),UrlEncode(),UrlDecode(),GBToUTF8(),Bytes2Str(),Str2Bytes()
'20090108 เพิ่มฟังก์ชันต่อไปนี้:
'AryToVbsString(arr)
'เวอร์ชันปัจจุบัน:
'******************************/
'เอาต์พุต
ย่อยเอคโค่(str)
การตอบสนองเขียน str
สิ้นสุดย่อย
'เบรกพอยต์
หยุดย่อย()
การตอบสนองสิ้นสุด()
สิ้นสุด Sub
'Output และ wrap
ย่อย(str)
เสียงสะท้อน str & "<br />" & vbcrlf
สิ้นสุดย่อย
'ลดความซับซ้อนของคำขอแบบฟอร์ม ()
'f : ชื่อแบบฟอร์ม
ฟังก์ชัน P(ฉ)
P = แทนที่ (คำขอแบบฟอร์ม (f), Chr (0), "")
ฟังก์ชันสิ้นสุด
'รับแบบฟอร์มและแทนที่เครื่องหมายคำพูดเดี่ยว
ฟังก์ชั่น Pr(f)
Pr = แทนที่ (คำขอแบบฟอร์ม (f), Chr (0), "")
Pr = แทนที่(Pr, "'", "''")
ฟังก์ชันสิ้นสุด
'ลดความซับซ้อนของ Request.Querystring()
'f : ชื่อแบบฟอร์ม
ฟังก์ชั่นG(f)
G = แทนที่ (Request.QueryString(f), Chr(0), "")
ฟังก์ชันสิ้นสุด
'รับพารามิเตอร์ URL และแทนที่เครื่องหมายคำพูดเดี่ยว
ฟังก์ชั่นGr(f)
Gr = แทนที่ (คำขอ QueryString (f), Chr (0), "")
Gr = แทนที่ (Gr, "'", "''")
End Function
'//Construction()?:การดำเนินการแบบไตรภาคโดย xilou www.chinacms.org
'ifThen คืนค่า s1 เป็น true และ s2 เป็น false
ฟังก์ชัน IfThen(ifTrue, s1, s2)
ดิมที
ถ้าถ้าจริงแล้ว
เสื้อ = s1
อื่น
เสื้อ = s2
สิ้นสุดถ้า
ถ้าแล้ว = t
ฟังก์ชันสิ้นสุด
'แสดงใช่และไม่ใช่ในสีที่ต่างกัน
ฟังก์ชัน IfThenFont(ifTrue, s1, s2)
ดิมสต
ถ้าถ้าจริงแล้ว
str = "<font color=""#006600"">" & s1 & "</font>"
อื่น
str = "<font color=""#FF0000"">" & s2 & "</font>"
สิ้นสุดถ้า
IfThenFont = STR
สิ้นสุดฟังก์ชัน
'สร้างวัตถุพจนานุกรม
ฟังก์ชัน NewHashTable()
ตั้งค่า NewHashTable = Server.CreateObj("Scripting.Dictionary")
NewHashTable.CompareMode = 1 'ค่าคีย์ไม่คำนึงถึงขนาดตัวพิมพ์
สิ้นสุดฟังก์ชัน
'สร้าง XmlHttp
ฟังก์ชั่น NewXmlHttp()
ตั้งค่า NewXmlHttp = Server.createobject("MSXML2.XMLHTTP")
สิ้นสุดฟังก์ชัน
'สร้าง XmlDom
ฟังก์ชัน NewXmlDom()
สิ้นสุดฟังก์ชัน
'สร้าง AdoStream
ฟังก์ชั่น NewAdoStream()
ตั้งค่า NewAdoStream = Server.CreateObject("Adodb.Stream")
ฟังก์ชั่นสิ้นสุด
'สร้างอาร์เรย์ 1 มิติ
'ส่งคืนอาร์เรย์ว่างของ n องค์ประกอบ
'n: จำนวนองค์ประกอบ
ฟังก์ชั่นNewArray(n)
Dim ary : ary = array()
เรดิม อารี(n-1)
NewArray = อารีย์
สิ้นสุดฟังก์ชัน
'ลองสร้าง..จับ.
ลองย่อย()
เมื่อเกิดข้อผิดพลาด ดำเนินการต่อต่อไป
สิ้นสุดย่อย
'ลองสร้าง..จับ.
'msg: ข้อความแสดงข้อผิดพลาดถูกส่งออกไป ถ้าว่างเปล่า แสดงว่า Err.Description ถูกส่งออกไป
จับย่อย(ผงชูรส)
หรี่ HTML
html = "<ul><li>$1</li></ul>"
หากผิดพลาดแล้ว
ถ้า msg <> "" แล้ว
echo แทนที่(html, "$1", ผงชูรส)
หยุด
อื่น
echo แทนที่ (html, "$1", Err.Description)
หยุด
สิ้นสุดถ้า
ผิดพลาด.เคลียร์
การตอบสนองสิ้นสุด()
สิ้นสุดถ้า
สิ้นสุด Sub
'-------------------------------- การดำเนินการอาร์เรย์เริ่มต้นขึ้น
'ตรวจสอบว่ามีค่าบางอย่างอยู่ในอาร์เรย์หรือไม่
ฟังก์ชั่น InArray(arr, s)
ถ้าไม่ใช่ IsArray(arr) ดังนั้น InArray = False : ออกจากฟังก์ชัน
ดิม ไอ
สำหรับ i = LBound(arr) ถึง UBound(arr)
ถ้า s = arr(i) ดังนั้น InArray = True : ออกจากฟังก์ชัน
ต่อไป
ในอาร์เรย์ = เท็จ
ฟังก์ชั่นสิ้นสุด
'แทนที่ตัวยึดตำแหน่งใน str ด้วยค่าในอาร์เรย์ ary
'ส่งคืนสตริงที่ถูกแทนที่
'str: สตริงที่จะแทนที่ ตัวยึดตำแหน่งคือ $0, $1, $2...
'ary: อาร์เรย์ที่ใช้สำหรับการแทนที่ แต่ละค่าจะสอดคล้องกับ $0, $1, $2... ในตัวยึดตำแหน่ง
'ตัวอย่าง: RefplaceByAry("$0-$1-$2 $3:$4:$5",Array(y,m,d,h,i,s))
ฟังก์ชันแทนที่ByAry(str,ary)
หรี่ i, j, L1, L2 : j = 0
ถ้า IsArray(ary) แล้ว
L1 = LBound(ary) : L2 = UBound(ary)
สำหรับ i = L1 ถึง L2
str = แทนที่ (str, "$"&j, ary(i))
เจ = เจ+1
ต่อไป
สิ้นสุดถ้า
แทนที่ByAry = str
ฟังก์ชันสิ้นสุด
'--------------------------------- การดำเนินการอาร์เรย์สิ้นสุด
'------------- --- --------------- การดำเนินการเลขสุ่มเริ่มต้นขึ้น
'รับตัวเลขสุ่ม
'ตัวเลขสุ่ม'
ฟังก์ชัน RndNumber(m,n)
สุ่ม
RndNumber = Int((n - m + 1) * Rnd + m)
สิ้นสุดฟังก์ชัน
'รับสตริงสุ่ม'
'n : ความยาวที่สร้างขึ้น
ฟังก์ชัน RndText(n)
หรี่ str1, str2, i, x, L
str1 = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
L = เลน(str1)
สุ่ม
สำหรับฉัน = 1 ถึง n
x = Int((L - 1 + 1) * Rnd + 1)
str2 = str2 และกลาง(str1,x,1)
ต่อไป
RndText = str2
ฟังก์ชันสิ้นสุด
'สร้างสตริงสุ่มจาก m ถึง n จากสตริง str
'หาก str ว่างเปล่า สตริงสุ่มจะถูกสร้างขึ้นจากตัวเลขและตัวอักษรตามค่าเริ่มต้น
'str : เพื่อสร้างสตริงสุ่มจากสตริงนี้
'm,n: สร้างบิต n ถึง m
ฟังก์ชัน RndByText(str, m, n)
หรี่ i, k, str2, L, x
ถ้า str = "" ดังนั้น str = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
L = เลน(str)
ถ้า n = m แล้ว
เค = น
อื่น
สุ่ม
k = Int((n - m + 1) * Rnd + m)
สิ้นสุดถ้า
สุ่ม
สำหรับฉัน = 1 ถึง k
x = Int((L - 1 + 1) * Rnd + 1)
str2 = str2 และกลาง(str, x, 1)
ต่อไป
RndByText = str2
ฟังก์ชันสิ้นสุด
'วันที่และเวลาในรูปแบบตัวเลขสุ่ม
'ส่งคืนชุดตัวเลขของเวลาปัจจุบัน
ฟังก์ชัน RndByDateTime()
ติ่ม dt : dt = ตอนนี้()
RndByDateTime = ปี (dt) & เดือน (dt) & วัน (dt) & ชั่วโมง (dt) & นาที (dt) & วินาที (dt)
ฟังก์ชันสิ้นสุด
'--------------------------------- การดำเนินการเลขสุ่มสิ้นสุด
' ----- ------ -------------------- การดำเนินการสตริงเริ่มต้นขึ้น
'กำหนดจำนวนครั้งที่สตริง str2 ปรากฏในสตริงอื่น str1
'ส่งคืนจำนวนครั้ง ถ้าไม่ใช่ ให้คืนค่า 0'
'str1: นิพจน์สตริงที่ยอมรับการค้นหา
'str2: นิพจน์สตริงที่จะค้นหา
'start: ตำแหน่งเริ่มต้นที่จะค้นหา ถ้าว่าง หมายความว่าเริ่มต้นจาก 1 โดยค่าเริ่มต้น
ฟังก์ชัน InStrTimes (str1, str2, เริ่มต้น)
ดิม เอ,ซี
ถ้า start = "" ดังนั้น start = 1
ค = 0
a = InStr (สตาร์ท, str1, str2)
ทำในขณะที่ > 0
ค = ค + 1
ก = InStr(a+1, str1, str2)
วนซ้ำ
InStrTimes = ค
ฟังก์ชันสิ้นสุด
'การต่อสตริง
'ไม่กลับ
'strResult: ตัวละครถูกบันทึกหลังการเชื่อมต่อ'
'str : อักขระที่จะต่อกัน
'พาร์ติชัน: สัญลักษณ์การแยกระหว่างอักขระที่เชื่อมต่อ
ย่อย JoinStr (byref strResult, str, พาร์ติชัน)
ถ้า strResult <> "" แล้ว
strResult = strResult & พาร์ติชัน & str
อื่น
strResult = str
สิ้นสุดถ้า
End Sub
'คำนวณความยาวไบต์ของสตริง หนึ่งอักขระจีน = 2 ไบต์
ฟังก์ชั่นStrLen(str)
ถ้า isNull(str) หรือ Str = "" ดังนั้น
สเตรเลน = 0
ออกจากฟังก์ชัน
สิ้นสุดถ้า
WINNT_CHINESE จางๆ
WINNT_CHINESE = (len("ตัวอย่าง")=2)
ถ้า WINNT_CHINESE แล้ว
สลัว l,t,c
ดิม ไอ
ล. = เลน(str)
เสื้อ = ล
สำหรับฉัน = 1 ถึงล
c = asc(กลาง(str,i,1))
ถ้าค<0 แล้ว c = c + 65536
ถ้า c>255 แล้ว t = t + 1
ต่อไป
สเตรเลน = ที
อื่น
StrLen = เลน(str)
สิ้นสุดถ้า
สิ้นสุดฟังก์ชัน
'ตัดสตริง
'str: สตริงที่จะดักจับ
'strlen: ความยาวที่จะสกัดกั้น
' addStr: ใช้สิ่งนี้แทนถ้ามันเกินความยาว เช่น:...
ฟังก์ชั่น CutStr(str, strlen, addStr)
หรี่ i,l,t,c
ถ้า Is_Empty(str) ดังนั้น CutStr = "" : ออกจากฟังก์ชัน
l = เลน(str) : t = 0
สำหรับฉัน = 1 ถึงล
c = Abs(Asc(กลาง(str,i,1)))
ถ้า c > 255 แล้ว
เสื้อ=t+2
อื่น
เสื้อ=t+1
สิ้นสุดถ้า
ถ้า t > strlen แล้ว
CutStr = ซ้าย (str, i) & addStr
ออกเพื่อ
อื่น
CutStr = STR
สิ้นสุดถ้า
ต่อไป
ฟังก์ชันสิ้นสุด
'แปลงความกว้างเต็มเป็นครึ่งความกว้าง
ฟังก์ชัน SBCcaseConvert(str)
ดิม บี, ซี, ไอ
ข = "1,2,3,4,5,6,7,8,9,0," _
&"A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X, Ｙ,Ｚ"
ค = "1,2,3,4,5,6,7,8,9,0," _
&"A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X, วาย ซี"
ข = แยก(ข,",")
ค = แยก(ค,",")
สำหรับ i = 0 ถึง Ubound(b)
ถ้า instr(str,b(i)) > 0 แล้ว
str = แทนที่ (str, b(i), c(i))
สิ้นสุดถ้า
ต่อไป
SBCcaseConvert = STR
ฟังก์ชั่นสิ้นสุด
'เทียบเท่ากับ Escape() ในจาวาสคริปต์
ฟังก์ชัน VbsEscape(str)
ดิมิ,เอส,ซี,เอ
ส = ""
สำหรับ i=1 ถึง Len(str)
c = กลาง(str,i,1)
ก = ASCW(ค)
ถ้า (a>=48 และ a<=57) หรือ (a>=65 และ a<=90) หรือ (a>=97 และ a<=122) แล้ว
s = เอสแอนด์ซี
ElseIf InStr("@*_+-./",c) > 0 จากนั้น
s = เอสแอนด์ซี
ElseIf a>0 และ a<16 จากนั้น
s = s & "%0" & เลขฐานสิบหก (a)
ElseIf a>=16 และ a<256 จากนั้น
s = s & "%" & เลขฐานสิบหก (a)
อื่น
s = s & "%u" & เลขฐานสิบหก(a)
สิ้นสุดถ้า
ต่อไป
VbsEscape=s
ฟังก์ชันสิ้นสุด
'ถอดรหัสข้อมูลที่เข้ารหัสโดยใช้ Escape() ในจาวาสคริปต์ ซึ่งใช้เมื่อเรียก Ajax
ฟังก์ชั่น VbsUnEscape(str)
ดิมเอ็กซ์
x = InStr(str,"%")
ทำในขณะที่ x > 0
VbsUnEscape = VbsUnEscape & กลาง(str,1,x-1)
ถ้า LCase(Mid(str,x+1,1)) = "u" แล้ว
VbsUnEscape = VbsUnEscape & ChrW(CLng("&H"&Mid(str,x+2,4)))
STR = กลาง(str,x+6)
อื่น
VbsUnEscape = VbsUnEscape & Chr(CLng("&H"&Mid(str,x+1,2)))
STR = กลาง(str,x+3)
สิ้นสุดถ้า
x = InStr(str,"%")
วนซ้ำ
VbsUnEscape = VbsUnEscape & str
ฟังก์ชันสิ้นสุด
'แปลงอักขระ ASCII เป็นรูปแบบการเข้ารหัส Unicode
ฟังก์ชัน A2U(str)
หรี่ i,L,uText
L = เลน(str)
สำหรับฉัน = 1 ถึง L
uText = uText & "&#" & AscW(กลาง(str,i,1)) & ";"
ต่อไป
A2U = ยูเท็กซ์
ฟังก์ชันสิ้นสุด
'แปลงการเข้ารหัส Unicode เป็น ASCII
'str: สตริงที่จะแปลงรหัสต้องเป็นอักขระ Unicode ทั้งหมด มิฉะนั้นจะเกิดข้อผิดพลาดขึ้น
ฟังก์ชัน U2A(str)
Dim ary,i,L,newStr
ary = แยก(str,";")
L = UBound(อารี)
สำหรับ i = 0 ถึง L - 1
newStr = newStr & ChrW(แทนที่(ary(i),"&#",""))
ต่อไป
U2A = newStr
ฟังก์ชันสิ้นสุด
'การเข้ารหัส URL'
ฟังก์ชัน UrlEncode(str)
UrlEncode = เซิร์ฟเวอร์ UrlEncode(str)
สิ้นสุดฟังก์ชัน
'การถอดรหัส URL
FunctionUrlDecode(str)
หรี่ newstr, havechar, Lastchar, i, char_c, next_1_c, next_1_Num
ข่าว = ""
ฮาเวชาร์ = เท็จ
สุดท้ายชาร์ = ""
สำหรับ i = 1 ถึง Len(str)
char_c = กลาง(str,i,1)
ถ้า char_c = "+" แล้ว
newstr = newstr & " "
ElseIf char_c = "%" จากนั้น
next_1_c = กลาง(str, i+1, 2)
next_1_num = Cint("&H" & next_1_c)
ถ้า havechar แล้ว
ฮาเวชาร์ = เท็จ
newstr = newstr & Chr(CInt("&H" & Lastchar & next_1_c))
อื่น
ถ้า Abs(next_1_num) <= 127 แล้ว
newstr = newstr & Chr(next_1_num)
อื่น
ฮาเวชาร์ = จริง
Lastchar = ถัดไป_1_c
สิ้นสุดถ้า
สิ้นสุดถ้า
ฉัน = ฉัน + 2
อื่น
newstr = newstr & char_c
สิ้นสุดถ้า
ต่อไป
UrlDecode = newstr
ฟังก์ชันสิ้นสุด
'GB เป็น UTF8 - แปลงข้อความที่เข้ารหัส GB เป็นข้อความที่เข้ารหัส UTF8
ฟังก์ชัน GBToUTF8(gbStr)
หรี่ wch, uch, szRet, szInput
ดิมเอ็กซ์
หรี่ nAsc, nAsc2, nAsc3
szInput = gbStr
'หากพารามิเตอร์อินพุตว่างเปล่า ให้ออกจากฟังก์ชัน
ถ้า szInput = "" แล้ว
toUTF8 = szInput
ออกจากฟังก์ชัน
สิ้นสุดถ้า
'เริ่มต้นการแปลง
สำหรับ x = 1 ถึง Len (szInput)
'ใช้ฟังก์ชันกลางเพื่อแยกข้อความที่เข้ารหัส GB
wch = กลาง(szInput, x, 1)
'ใช้ฟังก์ชัน ascW เพื่อส่งคืนโค้ดอักขระ Unicode ของข้อความที่เข้ารหัสแต่ละ GB
'หมายเหตุ: ฟังก์ชัน asc จะส่งคืนโค้ดอักขระ ANSI โปรดใส่ใจกับความแตกต่าง
nAsc = AscW(wch)
ถ้า nAsc < 0 ดังนั้น nAsc = nAsc + 65536
ถ้า (nAsc และ &HFF80) = 0 จากนั้น
szRet = szRet & wch
อื่น
ถ้า (nAsc และ &HF000) = 0 ดังนั้น
uch = "%" & Hex(((nAsc 2 ^ 6)) หรือ &HC0) & Hex(nAsc และ &H3F หรือ &H80)
szRet = szRet&uch
อื่น
'รหัสอักขระ Unicode ของข้อความที่เข้ารหัส GB ใช้เทมเพลตสามไบต์ระหว่าง 0800 - FFFF
uch = "%" & Hex((nAsc 2 ^ 12) หรือ &HE0) & "%" & _
Hex((nAsc 2 ^ 6) และ &H3F หรือ &H80) & "%" & _
เลขฐานสิบหก (nAsc และ &H3F หรือ &H80)
szRet = szRet&uch
สิ้นสุดถ้า
สิ้นสุดถ้า
ต่อไป
GBToUTF8 = szRet
ฟังก์ชันสิ้นสุด
'การแปลงจาก Byte stream เป็น Char stream
ฟังก์ชั่น Bytes2Str (vin, ชุดอักขระ)
หรี่ ms, strRet
Set ms = Server.CreateObject("ADODB.Stream") 'สร้างวัตถุสตรีม
ms.Type = 1 'ไบนารี่
นางสาว.เปิด
ms.Write vin 'เขียน vin ลงในวัตถุสตรีม
ms.Position = 0 'ตั้งค่าตำแหน่งเริ่มต้นของวัตถุสตรีมเป็น 0 เพื่อตั้งค่าคุณสมบัติ Charset
ms.Type = 2 'ข้อความ
ms.Charset = charset 'ตั้งค่าโหมดการเข้ารหัสของวัตถุสตรีมเป็นชุดอักขระ
strRet = ms.ReadText 'รับสตรีมอักขระ
ms.close 'ปิดวัตถุสตรีม
ตั้งค่า ms = ไม่มีเลย
Bytes2Str = strRet
ฟังก์ชันสิ้นสุด
'การแปลงสตรีม Char เป็นสตรีมไบต์
ฟังก์ชัน Str2Bytes(str,ชุดอักขระ)
หรี่ ms, strRet
ตั้งค่า ms = CreateObject("ADODB.Stream") 'สร้างวัตถุสตรีม
ms.Type = 2 'ข้อความ
ms.Charset = ชุดอักขระ 'ตั้งค่าโหมดการเข้ารหัสของวัตถุสตรีมเป็นชุดอักขระ
นางสาว.เปิด
ms.WriteText str 'เขียน str ลงในวัตถุสตรีม
ms.Position = 0 'ตั้งค่าตำแหน่งเริ่มต้นของวัตถุสตรีมเป็น 0 เพื่อตั้งค่าคุณสมบัติ Charset
ms.Type = 1 'Binary
vout = ms.Read(ms.Size) 'รับสตรีมอักขระ
ms.close 'ปิดวัตถุสตรีม
ตั้งค่า ms = ไม่มีเลย
Str2Bytes = vout
ฟังก์ชันสิ้นสุด
'-------------------------------- การดำเนินการสตริงสิ้นสุด
'----------------- -------- -------------------- เวลาและวันที่เริ่มดำเนินการ
'รับจำนวนวันที่สอดคล้องกันในเดือนนั้นโดยพิจารณาจากปีและเดือน
'คืนจำนวนวัน
'y: ปี เช่น: 2008
'm: เดือน เช่น: 3
ฟังก์ชัน GetDayCount(y,m)
ดิม ค
เลือกกรณี ม
กรณีที่ 1, 3, 5, 7, 8, 10, 12
ค=31
กรณีที่ 2
ถ้า IsDate(y&"-"&m&"-"&"29") แล้ว
ค=29
อื่น
ค=28
สิ้นสุดถ้า
กรณีอื่น
ค=30
สิ้นสุดการเลือก
GetDayCount = ค
ฟังก์ชันสิ้นสุด
'กำหนดว่าวันที่และเวลาอยู่ระหว่างช่วงระยะเวลาหนึ่ง รวมถึงเวลาที่ปลายทั้งสองของการเปรียบเทียบหรือไม่
ฟังก์ชัน IsBetweenTime (fromTime, toTime, strTime)
ถ้า DateDiff("s",fromTime,strTime) >= 0 และ DateDiff("s",toTime,strTime) <= 0 จากนั้น
อยู่ระหว่างเวลา = จริง
อื่น
IsBetweenTime = เท็จ
สิ้นสุดถ้า
ฟังก์ชันสิ้นสุด
'-------------------------------- สิ้นสุดการดำเนินการเวลาและวันที่
' ----------- ---------- -------------------- การดำเนินการที่เกี่ยวข้องกับการเข้ารหัสความปลอดภัยเริ่มต้นขึ้น
'--------------------------------- การดำเนินการที่เกี่ยวข้องกับการเข้ารหัสความปลอดภัยสิ้นสุด
' ---------- ---- ----------------- การดำเนินการตรวจสอบความถูกต้องตามกฎหมายของข้อมูลเริ่มต้นขึ้น
'ตรวจสอบสตริงผ่านนิพจน์ทั่วไปและส่งคืนค่าจริง|เท็จ
ฟังก์ชัน RegExpTest(strPatrn,strText)
Dim objRegExp ตรงกัน
ตั้งค่า objRegExp = RegExp ใหม่
objRegExp.Pattern = strPatrn
objRegExp.IgnoreCase = เท็จ
objRegExp.Global = จริง
RegExpTest = objRegExp.Test(strText)
'ตั้งค่าการจับคู่ = objRegExp.Execute (strText)
ตั้งค่า objRegExp = ไม่มีเลย
ฟังก์ชันสิ้นสุด
'เป็นจำนวนเต็มบวกหรือไม่?
FunctionIsPint(str)
IsPint = RegExpTest("^[1-9]{1}d*$", str)
ฟังก์ชันสิ้นสุด
'ไม่ว่าจะเป็น 0 หรือจำนวนเต็มบวก'
FunctionIsInt(str)
IsInt = RegExpTest("^0|([1-9]{1}d*)$", str)
ฟังก์ชันสิ้นสุด
'อีเมล
FunctionIsEmail(str)
รูปแบบติ่มซำ
รูปแบบ = "^w+((-w+)|(.w+))*@[A-Za-z0-9]+((.|-)[A-Za-z0-9]+ )*.[A-Za-z0-9]+$"
IsEmail = RegExpTest(รูปแบบ,str)
ฟังก์ชันสิ้นสุด
'โทรศัพท์มือถือ
FunctionIsMobile(str)
รูปแบบติ่มซำ
รูปแบบ = "^(130|131|132|133|153|134|135|136|137|138|139|158|159){1}d{8}$"
IsMobile = RegExpTest(รูปแบบ,str)
ฟังก์ชันสิ้นสุด
'คิวคิว
ฟังก์ชั่นIsQQ(str)
รูปแบบติ่มซำ
รูปแบบ = "^[1-9]d{4,8}$"
IsQQ = RegExpTest(รูปแบบ,str)
ฟังก์ชันสิ้นสุด
'บัตรประจำตัวประชาชน
FunctionIsIdCard(e)
Dim arrVerifyCode, Wi, ตัวตรวจสอบ
arrVerifyCode = แยก("1,0,x,9,8,7,6,5,4,3,2", ",")
Wi = แยก("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",")
ตัวตรวจสอบ = แยก("1,9,8,7,6,5,4,3,2,1,1", ",")
ถ้า Len(e) < 15 หรือ Len(e) = 16 หรือ Len(e) = 17 หรือ Len(e) > 18 แล้ว
IsIdCard = เท็จ
ออกจากฟังก์ชัน
สิ้นสุดถ้า
ดิม เอ
ถ้า Len(e) = 18 แล้ว
Ai = กลาง(จ, 1, 17)
อย่างอื่นถ้า Len(e) = 15 แล้ว
ไอ=อี
Ai = ซ้าย(Ai, 6) & "19" & กลาง(Ai, 7, 9)
สิ้นสุดถ้า
ถ้าไม่ใช่เป็นตัวเลข (Ai) แล้ว
IsIdCard= เท็จ
ออกจากฟังก์ชัน
สิ้นสุดถ้า
Dim strYear, strMonth, strDay, วันเกิด
strYear = CInt(กลาง(Ai, 7, 4))
strMonth = CInt(กลาง(Ai, 11, 2))
strDay = CInt(กลาง(Ai, 13, 2))
วันเกิด = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)
ถ้า IsDate (วันเกิด) แล้ว
ถ้า DateDiff("yyyy",Now,BirthDay)<-140 หรือ cdate(BirthDay)>date() จากนั้น
IsIdCard= เท็จ
ออกจากฟังก์ชัน
สิ้นสุดถ้า
ถ้า strMonth > 12 หรือ strDay > 31 แล้ว
IsIdCard= เท็จ
ออกจากฟังก์ชัน
สิ้นสุดถ้า
อื่น
IsIdCard= เท็จ
ออกจากฟังก์ชัน
สิ้นสุดถ้า
ดิม ไอ,โททัลมุลไอวี
สำหรับฉัน = 0 ถึง 16
TotalmulAiWi = TotalmulAiWi + CInt(กลาง(Ai, i + 1, 1)) * Wi(i)
ต่อไป
Dim modValue
modValue = TotalmulAiWi Mod 11
หรี่ strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
IsIdCard = ไอ
ถ้า Len(e) = 18 และ e <> Ai แล้ว
IsIdCard= เท็จ
ออกจากฟังก์ชัน
สิ้นสุดถ้า
IsIdCard=จริง
ฟังก์ชันสิ้นสุด
'รหัสไปรษณีย์
ฟังก์ชัน IsZipCode(str)
รูปแบบติ่มซำ
รูปแบบ = "^[1-9]d{2,5}$"
IsZipCode = RegExpTest(รูปแบบ,str)
ฟังก์ชันสิ้นสุด
'จะว่างเปล่าหรือไม่ รวมถึงฟังก์ชันของ IsEmpty(), IsNull(), ""
ฟังก์ชัน Is_Empty(str)
ถ้า IsNull(str) หรือ IsEmpty(str) หรือ str="" จากนั้น
Is_Empty=จริง
อื่น
Is_Empty=เท็จ
สิ้นสุดถ้า
ฟังก์ชันสิ้นสุด
'-------------------------------- การดำเนินการยืนยันความถูกต้องของข้อมูลสิ้นสุดลง
'--------- -- --------------------- การดำเนินการไฟล์เริ่มต้นขึ้น
'รับส่วนต่อท้ายไฟล์เช่น jpg'
ฟังก์ชัน GetFileExt(f)
GetFileExt = Lcase(กลาง(f,InStrRev(f,".") + 1))
ฟังก์ชันสิ้นสุด
'สร้างโฟลเดอร์
'เส้นทาง: เส้นทางไปยังโฟลเดอร์ที่จะสร้าง ให้ใช้เส้นทางสัมพัทธ์
SubCFolder(เส้นทาง)
ติ่มซำ
ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")
ถ้าไม่ใช่ fso.FolderExists(path) แล้ว
fso.CreateFolder (เส้นทาง)
สิ้นสุดถ้า
ตั้งค่า fso = ไม่มีเลย
สิ้นสุดย่อย
'ลบโฟลเดอร์
'เส้นทาง: เส้นทางโฟลเดอร์ ใช้เส้นทางสัมพัทธ์'
โฟลเดอร์ย่อย (เส้นทาง)
ติ่มซำ
ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")
ถ้า fso.FolderExists(path) แล้ว
fso.DeleteFolder เส้นทาง จริง
อื่น
echo "ไม่มีเส้นทาง:" & เส้นทาง
สิ้นสุดถ้า
ตั้งค่า fso = ไม่มีเลย
สิ้นสุดย่อย
'สร้างไฟล์
'เส้นทาง: สร้างเส้นทางไฟล์รวมทั้งชื่อ'
'strText: เนื้อหาไฟล์
CFile ย่อย (เส้นทาง strText)
หรี่ f, fso
ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")
ตั้งค่า f = fso.CreateTextFile (เส้นทาง)
ฉ เขียน strText
เซต f = ไม่มีเลย
ตั้งค่า fso = ไม่มีเลย
สิ้นสุดย่อย
'ลบไฟล์
'path: เส้นทางของไฟล์รวมถึงชื่อ'
SubDFile(เส้นทาง)
ติ่มซำ
ตั้งค่า fso = Server.CreateObject("Scripting.FileSystemObject")
ถ้า fso.FileExists(path) แล้ว
Fso.DeleteFile (เส้นทาง)
สิ้นสุดถ้า
ตั้งค่า fso = ไม่มีเลย
จบย่อย
'รวบรวม
ฟังก์ชั่น GetHTTPPage(url)
'Http.setTimeouts 10,000,10000,10000,10000
'เมื่อเกิดข้อผิดพลาด ดำเนินการต่อต่อไป'
Dim Http
ตั้งค่า Http = Server.createobject("MSXML2.XMLHTTP")
Http.open "GET",url,false
Http.ส่ง()
ถ้า Http.Status <> 200 แล้ว
ออกจากฟังก์ชัน
สิ้นสุดถ้า
'ถ้าเกิดข้อผิดพลาด ให้ Response.Write url : Response.End()
GetHTTPPage = bytesToBSTR(Http.ResponseBody,"GB2312")
'Http.Close()
'ถ้า err.number<>0 แสดงว่า err.Clear
ฟังก์ชั่นสิ้นสุด
'การแปลงการเข้ารหัส
ฟังก์ชั่น BytesToBstr (เนื้อหา, Cset)
DimStreamObj
ตั้งค่า StreamObj = Server.CreateObject("Adodb.Stream")
StreamObj.Type = 1
StreamObj.Mode = 3
StreamObj.เปิด
StreamObj.เขียนเนื้อหา
StreamObj ตำแหน่ง = 0
StreamObj.Type = 2
StreamObj.Charset = Cset
BytesToBstr = StreamObj.ReadText
StreamObj.ปิด
ฟังก์ชันสิ้นสุด
'-------------------------------- การดำเนินการไฟล์สิ้นสุด
'----------------- ------------------ การดำเนินการอื่นๆ เริ่มต้นขึ้น
'แสดงข้อมูล
'message: ข้อความที่จะแสดง
'url: URL ที่จะข้ามไป
'typeNum: โหมดการแสดงผล 1 แสดงข้อมูลและกลับไปยังหน้าก่อนหน้า; 2 แสดงข้อมูลและไปที่ URL
ShowMsg ย่อย (ข้อความ, url, typeNum)
ข้อความ = แทนที่ (ข้อความ,"',',''")
เลือกชนิดกรณีและปัญหาNum
กรณีที่ 1
echo ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
กรณีที่ 2
echo ("<script language=javascript>alert('" & message & "');location='" & Url &"'</script>")
สิ้นสุดการเลือก
สิ้นสุด
รายการตัวเลือกและตำแหน่งย่อยย่อยโดย xilou www.chinacms.org
'textArr: อาร์เรย์ข้อความ
'valueArr: อาร์เรย์ค่า
'curValue: ค่าที่เลือกในปัจจุบัน
ฟังก์ชัน ShowOpList (textArr, valueArr, curValue)
Dim str, สไตล์, i
style = "style=""พื้นหลังสี:#FFCCCC"""
STR = ""
ถ้า IsNull(curValue) ดังนั้น curValue = ""
สำหรับ I = LBound(textArr) ถึง UBound(valueArr)
ถ้า Cstr(valueArr(I)) = Cstr(curValue) แล้ว
str = str&"<option value="""&valueArr(I)&""" Selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
อื่น
str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
สิ้นสุดถ้า
ต่อไป
ShowOpList = STR
สิ้นสุดฟังก์ชัน
'รายการตัวเลือกหลายรายการ
'หมายเหตุ: คุณต้องใช้ฟังก์ชัน InArray()
'textArr: อาร์เรย์ข้อความ
'valueArr: อาร์เรย์ค่า
'curValue: อาร์เรย์ค่าที่เลือกในปัจจุบัน
ฟังก์ชั่น ShowMultiOpList (textArr, valueArr, curValueArr)
สไตล์ติ่มซำ, str, isCurr, I
style = "style=""พื้นหลังสี:#FFCCCC"""
str = "" : isCurr = เท็จ
ถ้า IsNull(curValue) ดังนั้น curValue = ""
สำหรับ I = LBound(textArr) ถึง UBound(valueArr)
ถ้า InArray(curValueArr, valueArr(I)) แล้ว
str = str&"<option value="""&valueArr(I)&""" Selected=""selected"" "&style&" >"&textArr(I)&"</option>"&vbcrlf
อื่น
str = str&"<option value="""&valueArr(I)&""" >"&textArr(I)&"</option>"&vbcrlf
สิ้นสุดถ้า
ต่อไป
ShowMultiOpList = str
ฟังก์ชันสิ้นสุด
ฟังก์ชัน GetIP()
หรี่ strIPAddr,actforip
ถ้า Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" หรือ InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 จากนั้น
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 จากนั้น
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 จากนั้น
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
อื่น
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
สิ้นสุดถ้า
GetIP = strIPAddr
ฟังก์ชันสิ้นสุด
'แปลงอาร์เรย์เป็นที่เก็บอ็อบเจ็กต์พจนานุกรม
'hashObj: วัตถุพจนานุกรม
'ary: Array รูปแบบจะต้องเป็นหนึ่งในสองรูปแบบต่อไปนี้ รูปแบบแรกสามารถเก็บได้เฉพาะค่าสตริงเท่านั้น
' : array("Id:12","UserName:xilou","Sex:1") นั่นคือ รูปแบบ array("key:value",...)
' : array(array("Id", "12"),array("ชื่อผู้ใช้", "xilou"),array("เพศ", "1"))
'ส่งคืนวัตถุพจนานุกรม
'www.chinacms.org'
ย่อย AryAddToHashTable (ByRef hashObj, ary)
Dim str,ht,i,k,v,pos
สำหรับ i = 0 ถึง UBound(ary)
ถ้า IsArray(ary(i)) แล้ว
ถ้า IsObject(ary(i)(0)) แล้ว
Response.Write "ข้อผิดพลาด: AryToHashTable (ary) ค่าคีย์ไม่สามารถเป็นประเภทวัตถุได้"
Response.Write "ประเภทค่า ary("& i &")(0) ปัจจุบันคือ:" & TypeName(ary(i)(0))
การตอบสนองสิ้นสุด()
สิ้นสุดถ้า
ถ้า IsObject(ary(i)(1)) ดังนั้น 'ถ้าค่าเป็นวัตถุ
ตั้งค่า hashObj(ary(i)(0)) = ary(i)(1)
อื่น
hashObj(ary(i)(0)) = ary(i)(1)
สิ้นสุดถ้า
อื่น
STR = ary(i) & ""
pos = InStr(str,::)
'www.chinacms.org
ถ้า POS < 1 แล้ว
การตอบสนองเขียน "ข้อผิดพลาด: AryToHashTable (ary)," ": " ไม่มีอยู่ "
Response.Write ", เกิดขึ้นที่:" & ary(i)
การตอบสนองสิ้นสุด()
สิ้นสุดถ้า
ถ้า pos = 1 แล้ว
การตอบสนองเขียน "ข้อผิดพลาด: AryToHashTable (ary) ไม่มีค่าคีย์"
Response.Write ", เกิดขึ้นที่:" & ary(i)
การตอบสนองสิ้นสุด()
สิ้นสุดถ้า
k = ซ้าย(str,pos-1)
v = กลาง(str,pos+1)
hashObj(k) = โวลต์
สิ้นสุดถ้า
ต่อไป
End Sub
'แปลงอาร์เรย์เป็นที่เก็บอ็อบเจ็กต์พจนานุกรม
'ary: Array รูปแบบจะต้องเป็นหนึ่งในสองรูปแบบต่อไปนี้ รูปแบบแรกสามารถเก็บได้เฉพาะค่าสตริงเท่านั้น
' : array("Id:12","UserName:xilou","Sex:1") นั่นคือ รูปแบบ array("key:value",...)
' : array(array("Id","12"),array("ชื่อผู้ใช้","xilou"),array("เพศ", "1"))
'ส่งคืนวัตถุพจนานุกรม
ฟังก์ชัน AryToHashTable(ary)
Dim str,ht,i,k,v,pos
ตั้ง ht = Server.CreateObject("Scripting.Dictionary")
ht.CompareMode = 1
AryAddToHashTable ht , ary
ตั้งค่า AryToHashTable = ht
ฟังก์ชันสิ้นสุด
'แปลงอาร์เรย์เป็นสตริง ซึ่งเทียบเท่ากับการจัดลำดับอาร์เรย์ รูปแบบเดียวที่อนุญาตคือ:
'array("p1:v1","p2:v2",array("p3",true))
'ส่งคืนสตริง
ฟังก์ชัน AryToVbsString(arr)
Dim str,i,c
ถ้าไม่ใช่ IsArray(arr) ดังนั้น Response.Write "ข้อผิดพลาด: ข้อผิดพลาด AryToString (arr) พารามิเตอร์ arr ไม่ใช่อาร์เรย์"
c = UBound(arr)
สำหรับฉัน = 0 ถึงค
ถ้า IsArray(arr(i)) แล้ว
เลือกกรณี LCase(TypeName(arr(i)(1)))
กรณี "วันที่", "สตริง", "ว่างเปล่า"
str = str & ”,อาร์เรย์(""" & arr(i)(0) & ""","""& arr(i)(1) &""")"
กรณี "จำนวนเต็ม", "ยาว", "เดี่ยว", "สองเท่า", "สกุลเงิน", "ทศนิยม", "บูลีน"
str = str & ”,อาร์เรย์(""" & arr(i)(0) & ""","& arr(i)(1) &")"
กรณี "โมฆะ"
str = str & ",อาร์เรย์(""" & arr(i)(0) & """,null)"
กรณีอื่น
Response.Write "ข้อผิดพลาด: AryToVbsString(arr) พารามิเตอร์ประกอบด้วยข้อมูลที่ผิดกฎหมาย ดัชนี i="&i&" ค่าคีย์คือ: "&arr(i)(0)
การตอบสนองสิ้นสุด()
สิ้นสุดการเลือก
อื่น
str = str & ",""" & arr(i) & """"
สิ้นสุดถ้า
ต่อไป
ถ้า str <> "" ดังนั้น str = Mid(str, 2, Len(str) - 1)
str = "อาร์เรย์ (" & str & ")"
AryToVbsString = str
ฟังก์ชันสิ้นสุด
'-------------------------------- การดำเนินการอื่นๆ สิ้นสุดลง
-