رمز البرنامج
<%
'*********************************
'اسم الفئة:
'الاسم: المكتبة العامة
التاريخ: 2008/10/28
'المؤلف: بواسطة xilou
"الموقع الإلكتروني: http://www.chinacms.org
'الوصف: المكتبة العامة
حقوق الطبع والنشر: يرجى الإشارة إلى المصدر والمؤلف عند إعادة الطبع
'*********************************
'آخر تعديل: 20090108
"عدد التعديلات: 2
'وصف التعديل:
'20090108 أضف الوظائف التالية:
' A2U(),U2A(),UrlEncode(),UrlDecode(),GBToUTF8(),Bytes2Str(),Str2Bytes()
'20090108 أضف الوظائف التالية:
'AryToVbsString(arr)
'الإصدار الحالي:
'*********************************/
'الإخراج
صدى فرعي (شارع)
الاستجابة.اكتب شارع
نهاية الفرعية
"نقطة التوقف".
توقف فرعي()
الاستجابة.النهاية ()
نهاية Sub
'الإخراج والالتفاف
SubBr(شارع)
صدى str & "<br />" & vbcrlf
النهاية الفرعية
"تبسيط نموذج الطلب ()"
'f: اسم النموذج
الدالة P(و)
P = استبدال (Request.Form(f)، Chr(0)، "")
وظيفة النهاية
"استلام النموذج واستبدال علامات الاقتباس المفردة".
وظيفة العلاقات العامة (و)
العلاقات العامة = استبدال (Request.Form(f)، مركز حقوق الإنسان (0)، "")
العلاقات العامة = استبدال (العلاقات العامة، "'"، "''")
وظيفة النهاية
'تبسيط الطلب.Querystring()
'f: اسم النموذج
الوظيفة ز (و)
G = استبدال (Request.QueryString(f)، Chr(0)، "")
وظيفة النهاية
"تلقي معلمات عنوان URL واستبدال علامات الاقتباس المفردة".
وظيفة غرام (و)
Gr = استبدال(Request.QueryString(f)، Chr(0)، "")
غرام = استبدال (غرام، "'"، "''")
وظيفة النهاية
'//Construction()?: عملية ثلاثية بواسطة xilou www.chinacms.org
'ifThen يُرجع s1 للصحيح وs2 للخطأ
الدالة IfThen(ifTrue, s1, s2)
خافت ر
إذا كان صحيحا ثم
ر = ق1
آخر
ر = ق2
نهاية إذا
إذا ثم = ر
وظيفة النهاية
"عرض نعم ولا بألوان مختلفة".
الدالة 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")
وظيفة النهاية
"إنشاء مصفوفة أحادية البعد".
'إرجاع مصفوفة فارغة من العناصر n
'ن: عدد العناصر
الوظيفةNewArray(n)
خافت آري : آري = صفيف ()
إعادة ديم آري(ن-1)
NewArray = ary
وظيفة النهاية
"إنشاء محاولة .. التقاط".
محاولة فرعية()
على خطأ استئناف التالي
End Sub
'إنشاء حاول..التقط
'msg: تم طرح رسالة الخطأ، إذا كانت فارغة، فسيتم طرح Err.Description
الصيد الفرعي (رسالة)
أتش تي أم أل خافت
html = "<ul><li>$1</li></ul>"
إذا أخطأت ثم
إذا كانت الرسالة <> "" ثم
استبدال الصدى (html، "$1"، msg)
وقف
آخر
استبدال الصدى (html، "$1"، Err.Description)
وقف
نهاية إذا
خطأ.واضح
الاستجابة.النهاية ()
نهاية إذا
End Sub
'--------------------------------تبدأ عملية المصفوفة
"تحديد ما إذا كانت هناك قيمة معينة موجودة في المصفوفة."
الدالة InArray(arr,s)
إذا لم يكن IsArray(arr) فإن InArray = False: اخرج من الوظيفة
خافت ط
لأني = LBound(arr) إلى UBound(arr)
إذا كان s = arr(i) فإن InArray = True: اخرج من الوظيفة
التالي
إنأراي = خطأ
وظيفة النهاية
"استبدل العناصر النائبة في str بالقيم الموجودة في المصفوفة ary."
'إرجاع السلسلة المستبدلة
'str: السلسلة المراد استبدالها، والعناصر النائبة هي $0، $1، $2...
'ary: المصفوفة المستخدمة للاستبدال، كل قيمة تقابل $0، $1، $2... في العنصر النائب.
'على سبيل المثال: ReplaceByAry("$0-$1-$2 $3:$4:$5",Array(y,m,d,h,i,s))
الدالة ReplaceByAry(str,ary)
ديم ط، ي، L1، L2 : ي = 0
إذا IsArray(ary) ثم
L1 = LBound(ary) : L2 = UBound(ary)
لأني = L1 إلى L2
str = Replace(str, "$"&j, ary(i))
ي = ي+1
التالي
نهاية إذا
ReplaceByAry = str
وظيفة النهاية
'----------------------------- تنتهي عملية المصفوفة
'------------ --- --------------- تبدأ عملية الرقم العشوائي
"احصل على أرقام عشوائية."
رقم عشوائي
الدالة RndNumber(m,n)
عشوائية
RndNumber = Int((n - m + 1) * Rnd + m)
وظيفة النهاية
"احصل على سلسلة عشوائية".
'n : الطول المولد
الدالة RndText(n)
خافت str1، str2، i، x، L
str1 = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
ل = لين (str1)
عشوائية
لأني = 1 إلى ن
س = كثافة العمليات((ل - 1 + 1) * د + 1)
str2 = str2 & منتصف (str1،x،1)
التالي
RndText = str2
وظيفة النهاية
'إنشاء سلاسل عشوائية من m إلى n من السلسلة النصية
'إذا كانت السلسلة فارغة، فسيتم إنشاء سلسلة عشوائية من الأرقام والحروف بشكل افتراضي
'str : لإنشاء سلسلة عشوائية من هذه السلسلة
'm,n: توليد n إلى m بتات
الدالة RndByText(str, m, n)
ديم ط، ك، str2، ل، س
إذا كانت str = "" ثم str = "NOPQRSTUVWXYZ012ABCDEFGHIJKLM3456abcdefghijklm789nopqrstuvwxyz"
ل = لين (شارع)
إذا ن = م ثم
ك = ن
آخر
عشوائية
ك = كثافة العمليات ((ن - م + 1) * د + م)
نهاية إذا
عشوائية
لأني = 1 إلى ك
س = كثافة العمليات((ل - 1 + 1) * د + 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)
خافت أ، ج
إذا كانت البداية = "" فابدأ = 1
ج = 0
أ = InStr(بداية، str1، str2)
افعل بينما > 0
ج = ج + 1
أ = InStr(a+1, str1, str2)
حلقة
InStrTimes = ج
وظيفة النهاية
"تسلسل السلسلة".
لا عودة
'strResult: الأحرف المحفوظة بعد الاتصال
'str : الحرف المراد ربطه
'القسم: رمز الفصل بين الأحرف المتصلة
Sub JoinStr (byref strResult، str، قسم)
إذا كانت strResult <> "" إذن
strResult = strResult & Partition & str
آخر
strResult = str
نهاية إذا
End Sub
'احسب طول البايت للسلسلة، حرف صيني واحد = 2 بايت
وظيفةStrLen(شارع)
إذا كان isNull(str) أو Str = "" إذن
سترلين = 0
وظيفة الخروج
نهاية إذا
خافت WINNT_CHINESE
WINNT_CHINESE = (لين("مثال")=2)
إذا WINNT_CHINESE ثم
خافت ل، ر، ج
خافت ط
ل = لين (شارع)
ر = ل
لأني = 1 إلى ل
ج = تصاعدي (منتصف (شارع، ط، 1))
إذا ج<0 ثم ج = ج + 65536
إذا ج> 255 ثم ر = ر + 1
التالي
سترلين = ر
آخر
StrLen = لين (شارع)
نهاية إذا
وظيفة النهاية
"سلسلة الاعتراض".
'str: السلسلة التي سيتم اعتراضها
'strlen: الطول الذي سيتم اعتراضه
'addStr: استخدم هذا بدلاً من ذلك إذا تجاوز الطول، مثل:...
الدالة CutStr(str، strlen، addStr)
خافت ط، ل، ر، ج
إذا كان Is_Empty(str) ثم CutStr = "" : اخرج من الوظيفة
ل = لين (شارع) : ر = 0
لأني = 1 إلى ل
ج = القيمة المطلقة (تصاعدي (منتصف (شارع، ط، 1)))
إذا ج > 255 ثم
ر=ر+2
آخر
ر=ر+1
نهاية إذا
إذا ر> سترلين ثم
CutStr = left(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, ص، ض"
ب = انقسام (ب،"، ")
ج = تقسيم (ج،"،"،)
لأني = 0 إلى Ubound(b)
إذا instr(str,b(i)) > 0 ثم
str = استبدال (str، b(i)، c(i))
نهاية إذا
التالي
SBCcaseConvert = str
وظيفة النهاية
"تعادل الهروب () في جافا سكريبت
الدالة VbsEscape(str)
ديمي، ق، ج، أ
ق = ""
بالنسبة إلى i=1 إلى Len(str)
ج = منتصف (شارع، ط، 1)
أ = أسكو (ج)
إذا كانت (a>=48 وa<=57) أو (a>=65 وa<=90) أو (a>=97 وa<=122) إذن
ق = ق&ج
ElseIf InStr("@*_+-./"،c) > 0 ثم
ق = ق&ج
ElseIf a>0 وa<16 ثم
s = s & "%0" & Hex(a)
ElseIf a>=16 وa<256 ثم
ق = ق & "٪" & سداسي عشري (أ)
آخر
s = s & "%u" & Hex(a)
نهاية إذا
التالي
VbsEscape=s
وظيفة النهاية
"فك تشفير البيانات المشفرة باستخدام escape() في جافا سكريبت، المستخدمة عند الاتصال بـ ajax
الدالة VbsUnEscape(str)
خافت س
س = إنستر(ستر،"٪")
افعل بينما x > 0
VbsUnEscape = VbsUnEscape & Mid(str,1,x-1)
إذا كان LCase(Mid(str,x+1,1)) = "u" إذن
VbsUnEscape = VbsUnEscape & ChrW(CLng("&H"&Mid(str,x+2,4)))
شارع = منتصف (شارع، س+6)
آخر
VbsUnEscape = VbsUnEscape & Chr(CLng("&H"&Mid(str,x+1,2)))
شارع = منتصف (شارع، س + 3)
نهاية إذا
س = إنستر(ستر،"٪")
حلقة
VbsUnEscape = VbsUnEscape & str
وظيفة النهاية
'تحويل أحرف ascii إلى نموذج ترميز Unicode
وظيفة A2U(شارع)
خافت أنا، L، uText
ل = لين (شارع)
لأني = 1 إلى L
uText = uText & "&#" & AscW(Mid(str,i,1)) & ";"
التالي
A2U = uText
وظيفة النهاية
"تحويل ترميز Unicode إلى ascii
'str: يجب أن تكون السلسلة المراد تحويل ترميزها عبارة عن أحرف Unicode، وإلا سيحدث خطأ
الدالة U2A(شارع)
خافت آري، ط، L، نيوستر
آري = سبليت (شارع، "؛")
L = UBound(ary)
لأني = 0 إلى L - 1
newStr = newStr & ChrW(Replace(ary(i),"&#``"))
التالي
U2A = newStr
وظيفة النهاية
"ترميز URL."
وظيفة UrlEncode(str)
UrlEncode = Server.UrlEncode(str)
فك تشفير عنوان url
للوظيفة النهائية
وظيفةUrlDecode(شارع)
خافت newstr، haschar، lastchar، i، char_c، next_1_c، next_1_Num
نيوستر = ""
haschar = false
الحرف الأخير = ""
لأني = 1 إلى لين (شارع)
char_c = منتصف (شارع، ط، 1)
إذا char_c = "+" ثم
نيوستر = نيوستر & " "
ElseIf char_c = "%" إذن
next_1_c = منتصف (شارع، i+1، 2)
next_1_num = Cint("&H" & next_1_c)
إذا كان haschar ثم
haschar = false
newstr = newstr & Chr(CInt("&H" & lastchar & next_1_c))
آخر
إذا كانت القيمة Abs(next_1_num) <= 127 إذن
newstr = newstr & مركز حقوق الإنسان (next_1_num)
آخر
haschar = true
lastchar = next_1_c
نهاية إذا
نهاية إذا
ط = ط + 2
آخر
newstr = newstr & char_c
نهاية إذا
التالي
UrlDecode = newstr
وظيفة النهاية
'GB إلى UTF8--تحويل النص المشفر بالجيجابايت إلى نص مشفر بـ UTF8
الدالة GBToUTF8(gbStr)
Dim wch,uch,szRet,szInput
خافت س
خافت NASC، nAsc2، nAsc3
szInput = gbStr
'إذا كانت معلمة الإدخال فارغة، فاخرج من الوظيفة
إذا كان szInput = "" إذن
toUTF8 = szInput
وظيفة الخروج
نهاية إذا
'ابدأ التحويل
لـ x = 1 إلى Len(szInput)
'استخدم الوظيفة المتوسطة لتقسيم النص المشفر بالجيجابايت
wch = منتصف (szInput، x، 1)
'استخدم الدالة ascW لإرجاع رمز حرف Unicode لكل نص مشفر بالجيجابايت
'ملاحظة: تقوم الدالة asc بإرجاع رمز حرف ANSI، وانتبه إلى الفرق
تصاعدي = تصاعدي (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 للنص المشفر بالجيجابايت قالبًا ثلاثي البايت بين 0800 - FFFF
uch = "%" & Hex((nAsc 2 ^ 12) أو &HE0) & "%" & _
سداسي عشري ((nAsc 2 ^ 6) و &H3F أو &H80) & "%" & _
سداسي عشري (nAsc و&H3F أو &H80)
szRet = szRet&uch
نهاية إذا
نهاية إذا
التالي
GBToUTF8 = szRet
وظيفة النهاية
"التحويل من دفق البايت إلى دفق Char."
الدالة Bytes2Str(vin,charset)
خافت مللي،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 "أغلق كائن الدفق."
تعيين مللي = لا شيء
Bytes2Str = strRet
وظيفة النهاية
"تحويل دفق Char إلى دفق بايت."
الدالة Str2Bytes(str,charset)
خافت مللي،strRet
Set ms = CreateObject("ADODB.Stream") 'إنشاء كائن دفق
ms.Type = 2 'نص
ms.Charset = charset 'اضبط وضع التشفير لكائن الدفق على مجموعة الأحرف
مللي.فتح
ms.WriteText str 'اكتب str في كائن الدفق
ms.Position = 0 'قم بتعيين موضع البداية لكائن الدفق على 0 لتعيين خاصية Charset
ms.Type = 1 'Binary
vout = ms.Read(ms.Size)' الحصول على دفق الأحرف
ms.Close "أغلق كائن الدفق."
تعيين مللي = لا شيء
Str2Bytes = vout
وظيفة النهاية
'-------------------------------- تنتهي عملية السلسلة
'------------- -------- -------------------- الوقت والتاريخ يبدأ التشغيل
'احصل على عدد الأيام المقابلة في الشهر بناءً على السنة والشهر
'إرجاع عدد الأيام
'y: سنة، مثل: 2008
م: شهر، مثل: 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 = صحيح
آخر
IsBetweenTime = خطأ
نهاية إذا
وظيفة النهاية
'-------------------------------- تنتهي عملية الوقت والتاريخ
'----------- ---------- -------------------- تبدأ العمليات المتعلقة بالتشفير الأمني
'----------------------------- تنتهي العمليات المتعلقة بالتشفير الأمني
'---------- ---- -----------------تبدأ عملية التحقق من شرعية البيانات
'اكتشف السلسلة من خلال التعبير العادي وأرجعها صحيح|خطأ
الدالة RegExpTest(strPatrn,strText)
ديم objRegExp، التطابقات
تعيين objRegExp = New RegExp
objRegExp.Pattern = strPatrn
objRegExp.IgnoreCase = خطأ
objRegExp.Global = صحيح
RegExpTest = objRegExp.Test(strText)
'تعيين التطابقات = objRegExp.Execute(strText)
تعيين objRegExp = لا شيء
الدالة النهائية
"هل هو عدد صحيح موجب؟"
وظيفةIsPint(شارع)
IsPint = RegExpTest("^[1-9]{1}d*$"، str)
وظيفة النهاية
"سواء كانت 0 أو عددًا صحيحًا موجبًا".
FunctionIsInt(شارع)
IsInt = RegExpTest("^0|([1-9]{1}d*)$"، str)
وظيفة النهاية
'بريد إلكتروني
وظيفةIsEmail(شارع)
نمط خافت
patrn = "^w+((-w+)|(.w+))*@[A-Za-z0-9]+((.|-)[A-Za-z0-9]+ )*.[A-Za-z0-9]+$"
IsEmail = RegExpTest(patrn,str)
وظيفة النهاية
'الهاتف الخلوي
FunctionIsMobile(شارع)
نمط خافت
نمط = "^(130|131|132|133|153|134|135|136|137|138|139|158|159){1}d{8}$"
IsMobile = RegExpTest(patrn,str)
وظيفة النهاية
'QQ
وظيفةIsQQ(شارع)
نمط خافت
النمط = "^[1-9]d{4,8}$"
IsQQ = RegExpTest(patrn,str)
وظيفة النهاية
'بطاقة الهوية
وظيفةIsIdCard(e)
تعتيم arrVerifyCode، Wi، Checker
arrVerifyCode = سبليت("1,0,x,9,8,7,6,5,4,3,2"، ""،")
واي = سبليت("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 = خطأ
وظيفة الخروج
نهاية إذا
ديم أ
إذا كان لين (ه) = 18 ثم
منظمة العفو الدولية = منتصف (ه، 1، 17)
ElseIf لين (ه) = 15 ثم
منظمة العفو الدولية = ه
منظمة العفو الدولية = اليسار (منظمة العفو الدولية، 6) و"19" ومنتصف (منظمة العفو الدولية، 7، 9)
نهاية إذا
إذا لم يكن رقميًا (Ai) إذن
IsIdCard = خطأ
وظيفة الخروج
نهاية إذا
خافت strYear، strMonth، strDay، BirthDay
strYear = CInt(Mid(Ai, 7, 4))
strMonth = CInt(Mid(Ai, 11, 2))
strDay = CInt(Mid(Ai, 13, 2))
BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)
إذا كان IsDate(BirthDay) إذن
إذا كان DateDiff("yyyy",Now,BirthDay)<-140 أو cdate(BirthDay)>date() ثم
IsIdCard = خطأ
وظيفة الخروج
نهاية إذا
إذا كان strMonth > 12 أو strDay > 31، إذن
IsIdCard = خطأ
وظيفة الخروج
نهاية إذا
آخر
IsIdCard = خطأ
وظيفة الخروج
نهاية إذا
خافت أنا، TotalmulAiWi
لأني = 0 إلى 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
التالي
خافت modValue
modValue = TotalmulAiWi Mod 11
رمز التحقق الخافت
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
IsIdCard = Ai
إذا لين(ه) = 18 وه <> عاي ثم
IsIdCard = خطأ
وظيفة الخروج
نهاية إذا
IsIdCard=صحيح
وظيفة النهاية
'رمز بريدي
الدالة IsZipCode(str)
نمط خافت
النمط = "^[1-9]d{2,5}$"
IsZipCode = RegExpTest(patrn,str)
وظيفة النهاية
'سواء كان فارغًا، بما في ذلك وظائف IsEmpty()، IsNull()، ""
الدالة Is_Empty(str)
إذا كان IsNull(str) أو IsEmpty(str) أو str = "" إذن
Is_Empty=صحيح
آخر
Is_Empty=خطأ
نهاية إذا
وظيفة النهاية
'-------------------------------- تنتهي عملية التحقق من صحة البيانات
'--------- -- --------------------- يبدأ تشغيل الملف
'احصل على لاحقة الملف، مثل jpg
الدالة GetFileExt(f)
GetFileExt = Lcase(Mid(f,InStrRev(f,".") + 1))
وظيفة النهاية
"إنشاء مجلد."
'المسار: المسار إلى المجلد الذي سيتم إنشاؤه، استخدم مسارًا نسبيًا
المجلد الفرعي (المسار)
خافت FSO
تعيين fso = Server.CreateObject("Scripting.FileSystemObject")
إذا لم يكن fso.FolderExists(path) إذن
fso.CreateFolder(المسار)
نهاية إذا
تعيين fso = لا شيء
النهاية الفرعية
"حذف المجلد".
'المسار: مسار المجلد، استخدم المسار النسبي
المجلد الفرعي (المسار)
خافت FSO
تعيين fso = Server.CreateObject("Scripting.FileSystemObject")
إذا كان fso.FolderExists(path) إذن
مسار fso.DeleteFolder، صحيح
آخر
صدى "المسار غير موجود:" & المسار
نهاية إذا
تعيين fso = لا شيء
النهاية الفرعية
"إنشاء ملف".
'المسار: إنشاء مسار الملف، بما في ذلك الاسم
'strText: محتوى الملف
ملف C فرعي (المسار، نص str)
خافت و، fso
تعيين fso = Server.CreateObject("Scripting.FileSystemObject")
تعيين f = fso.CreateTextFile (المسار)
f.اكتب strText
تعيين و = لا شيء
تعيين fso = لا شيء
النهاية الفرعية
"حذف الملف".
'المسار: مسار الملف، بما في ذلك الاسم
الملف الفرعي (المسار)
خافت FSO
تعيين fso = Server.CreateObject("Scripting.FileSystemObject")
إذا كان fso.FileExists(path) إذن
Fso.DeleteFile (المسار)
نهاية إذا
تعيين fso = لا شيء
نهاية فرعية
"جمع".
الدالة GetHTTPPage(url)
'Http.setTimeouts 10000,10000,10000,10000
"عند حدوث خطأ في الاستئناف التالي."
خافت المتشعب
تعيين Http = Server.createobject("MSXML2.XMLHTTP")
Http.open "GET"، URL، خطأ
المتشعب.إرسال ()
إذا Http.Status <> 200 ثم
وظيفة الخروج
نهاية إذا
"إذا أخطأت، فاكتب عنوان url: Response.End()
GetHTTPPage = bytesToBSTR(Http.ResponseBody,"GB2312")
'المتشعب.إغلاق ()
'إذا كان err.number<>0 ثم err.Clear
وظيفة النهاية
"تحويل الترميز".
الدالة BytesToBstr(body,Cset)
DimStreamObj
تعيين StreamObj = Server.CreateObject("Adodb.Stream")
StreamObj.Type = 1
StreamObj.Mode = 3
StreamObj.Open
StreamObj.Write النص
StreamObj.Position = 0
StreamObj.Type = 2
StreamObj.Charset = Cset
BytesToBstr = StreamObj.ReadText
StreamObj.Close
وظيفة النهاية
'--------------------------------ينتهي تشغيل الملف
'------------- ------------------تبدأ العمليات الأخرى
'عرض المعلومات
'الرسالة: الرسالة التي سيتم عرضها
'url: عنوان URL للانتقال إليه
'typeNum: وضع العرض، 1 ينبثق المعلومات ويعود إلى الصفحة السابقة؛ 2 ينبثق المعلومات وينتقل إلى عنوان url
Sub ShowMsg(message,url,typeNum)
الرسالة = استبدال (رسالة، "'"، "'")
حدد نوع الحالة
الحالة 1
صدى ("<script language=javascript>alert('" & message & "');history.go(-1)</script>")
الحالة 2
صدى ("<script language=javascript>alert('" & message & "');location='" & Url &"'</script>")
إنهاء التحديد
End Sub
'عرض قائمة الخيارات والموضع، بواسطة xilou www.chinacms.org
'textArr: مصفوفة النص
'valueArr: مصفوفة القيمة
'curValue: القيمة المحددة حاليًا
الدالة ShowOpList(textArr, valueArr, curValue)
شارع خافت، أسلوب، أنا
النمط = "النمط =""لون الخلفية:#FFCCCC"""
شارع = ""
إذا IsNull(curValue) ثم curValue = ""
لأني = 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)
نمط خافت، شارع، isCurr، I
النمط = "النمط =""لون الخلفية:#FFCCCC"""
str = "" : isCurr = خطأ
إذا IsNull(curValue) ثم curValue = ""
لأني = 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"), "غير معروف") > 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، يجب أن يكون التنسيق واحدًا من التنسيقين التاليين، حيث يمكن للأول تخزين قيم السلسلة فقط
' : صفيف ("المعرف: 12"، "اسم المستخدم: xilou"، "الجنس: 1")، أي تنسيق الصفيف ("مفتاح: قيمة"،...)
' : المصفوفة (المصفوفة ("المعرف"، "12")، المصفوفة ("اسم المستخدم"، "xilou")، المصفوفة ("الجنس"، "1"))
"إرجاع كائن القاموس."
"www.chinacms.org."
Sub AryAddToHashTable(ByRef hashObj,ary)
خافت str،ht،i،k،v،pos
لأني = 0 إلى UBound(ary)
إذا كان IsArray(ary(i)) إذن
إذا كان IsObject(ary(i)(0)) إذن
Response.Write "خطأ: AryToHashTable(ary)، لا يمكن أن تكون قيمة المفتاح نوع كائن،"
Response.اكتب "نوع قيمة 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)
نهاية إذا
آخر
شارع = آري (ط) & ""
نقاط البيع = InStr(str،":")
"www.chinacms.org."
إذا نقاط البيع <1 ثم
Response.Write "خطأ: AryToHashTable(ary)،"":""غير موجود"
الاستجابة.اكتب "،يحدث في:" & ary(i)
الاستجابة.النهاية ()
نهاية إذا
إذا نقاط البيع = 1 ثم
Response.Write "خطأ: AryToHashTable(ary)، قيمة المفتاح غير موجودة"
الاستجابة.اكتب "،يحدث في:" & ary(i)
الاستجابة.النهاية ()
نهاية إذا
ك = اليسار (شارع، بوس-1)
الخامس = منتصف (شارع، بوس + 1)
hashObj(k) = v
نهاية إذا
التالي
End Sub
'تحويل المصفوفة إلى مخزن كائنات القاموس
'ary: Array، يجب أن يكون التنسيق واحدًا من التنسيقين التاليين، الأول يمكنه تخزين قيم السلسلة فقط
' : صفيف ("المعرف: 12"، "اسم المستخدم: xilou"، "الجنس: 1")، أي تنسيق الصفيف ("مفتاح: قيمة"،...)
' : المصفوفة (المصفوفة ("المعرف"، "12")، المصفوفة ("اسم المستخدم"، "xilou")، المصفوفة ("الجنس"، "1"))
"إرجاع كائن القاموس."
الدالة AryToHashTable(ary)
خافت str،ht،i،k،v،pos
تعيين ht = Server.CreateObject("Scripting.Dictionary")
ht.CompareMode = 1
AryAddToHashTable ht , ary
قم بتعيين AryToHashTable = ht
وظيفة النهاية
"تحويل المصفوفة إلى سلسلة، وهو ما يعادل تسلسل المصفوفة. التنسيقات الوحيدة المسموح بها هي:
'مصفوفة ("p1:v1"، "p2: v2"، مصفوفة ("p3"، صحيح))
"سلسلة العودة."
الدالة AryToVbsString(arr)
شارع خافت، ط، ج
إذا لم يكن IsArray(arr) ثم Response.اكتب "خطأ: خطأ AryToString(arr)، المعلمة arr ليست مصفوفة"
ج = UBound(arr)
لأني = 0 إلى ج
إذا كان IsArray(arr(i)) إذن
حدد حالة LCase(TypeName(arr(i)(1)))
حالة "التاريخ"، "السلسلة"، "فارغة"
str = str & ",array(""" & arr(i)(0) & """،""& arr(i)(1) &""")"
الحالة "عدد صحيح"، و"طويل"، و"مفرد"، و"مزدوج"، و"عملة"، و"عشري"، و"منطقي"
str = str & ",array(""" & arr(i)(0) & """،& arr(i)(1) &")"
الحالة "خالية"
str = str & ",array(""" & 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
وظيفة النهاية
'--------------------------------تنتهي العمليات الأخرى
%>