توفر هذه المقالة مجموعة كاملة من وظائف مجموعة ASP، بما في ذلك وظائف مثل استخراج الأحرف الأصلية للعنوان، وحفظ الملفات البعيدة لتسجيل الدخول المحاكي المحلي، والحصول على التعليمات البرمجية المصدر لصفحة الويب.
انسخ رمز الكود كما يلي:
'======================================================================== = =
'اسم الوظيفة: GetHttpPage
'الوظيفة: الحصول على الكود المصدري لصفحة الويب
'المعلمة: HttpUrl ------ عنوان صفحة الويب
'======================================================================== = =
الدالة GetHttpPage(HttpUrl)
إذا كان IsNull(HttpUrl)=True أو Len(HttpUrl)<18 أو HttpUrl="$False$" إذن
GetHttpPage = "$False$"
وظيفة الخروج
نهاية إذا
خافت المتشعب
قم بتعيين Http=server.createobject("MSX" و"ML2.XM" و"LHT" و"TP")
Http.open "GET"،HttpUrl،False
المتشعب.إرسال ()
إذا Http.Readystate<>4 ثم
تعيين المتشعب = لا شيء
GetHttpPage = "$False$"
وظيفة الخروج
انتهي إذا
GetHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
GetHTTPPage=replace(replace(GetHTTPPage , vbCr,""),vbLf,"")
تعيين المتشعب = لا شيء
إذا Err.number<>0 ثم
خطأ.واضح
نهاية إذا
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: BytesToBstr
'الوظيفة: تحويل كود المصدر الذي تم الحصول عليه إلى اللغة الصينية
'المعلمة: الجسم ------ المتغير المطلوب تحويله
'المعلمة: Cset ------ النوع المطلوب تحويله
'======================================================================== = =
الدالة BytesToBstr(Body,Cset)
خافت Objstream
تعيين Objstream = Server.CreateObject("ad" و"odb.str" و"eam")
objstream.Type = 1
objstream.Mode =3
objstream.Open
objstream.اكتب النص
objstream.Position = 0
objstream.Type = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Close
تعيين objstream = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: PostHttpPage
'الوظيفة: تسجيل الدخول
'======================================================================== = =
وظيفة PostHttpPage(RefererUrl،PostUrl،PostData)
DimxmlHttp
ديمريتستر
تعيين xmlHttp = CreateObject("Msx" و"ml2.XM" و"LHT" و"TP")
xmlHttp.Open "POST"، PostUrl، False
XmlHTTP.setRequestHeader "طول المحتوى"، لين (PostData)
xmlHttp.setRequestHeader "نوع المحتوى"، "application/x-www-form-urlencoded"
xmlHttp.setRequestHeader "المُحيل"، RefererUrl
xmlHttp.إرسال بيانات البريد
إذا Err.Number <> 0 ثم
تعيين xmlHttp=لا شيء
بوستHttpPage = "$False$"
وظيفة الخروج
نهاية إذا
PostHttpPage=bytesToBSTR(xmlHttp.responseBody,"GB2312")
اضبط xmlHttp = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: UrlEncoding
'الوظيفة: تحويل الترميز
'======================================================================== = =
ترميز URL للوظيفة (DataStr)
Dim StrReturn,Si,ThisChr,InnerCode,Hight8,Low8
StrReturn = ""
لـ Si = 1 إلى Len(DataStr)
ThisChr = Mid(DataStr,Si,1)
إذا كان Abs(Asc(ThisChr)) <&HFF إذن
StrReturn = StrReturn & ThisChr
آخر
InnerCode = تصاعدي (ThisChr)
إذا كان رمز InnerCode <0 ثم
InnerCode = InnerCode + &H10000
نهاية إذا
Hight8 = (InnerCode و&HFF00)/ &HFF
Low8 = InnerCode و&HFF
StrReturn = StrReturn & "%" & Hex(Hight8) & "%" & Hex(Low8)
نهاية إذا
التالي
UrlEncoding = StrReturn
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: GetBody
'الوظيفة: سلسلة الاعتراض
'المعلمة: ConStr ------ السلسلة التي سيتم اعتراضها
'المعلمة: StartStr ------سلسلة البداية
'المعلمة: OverStr ------سلسلة النهاية
'المعلمة: IncluL ------ما إذا كان StartStr متضمنًا أم لا
'المعلمة: IncluR ------ ما إذا كان سيتم تضمين OverStr
'======================================================================== = =
الدالة GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
إذا كان ConStr = "$False$" أو ConStr = "" أو IsNull (ConStr) = True أو StartStr = "" أو IsNull (StartStr) = True Or OverStr = "" أو IsNull (OverStr) = True إذن
GetBody = "$خطأ $"
وظيفة الخروج
نهاية إذا
DimConStrTemp
بداية خافتة، أكثر
ConStrTemp=Lcase(ConStr)
StartStr=Lcase(StartStr)
OverStr=Lcase(OverStr)
ابدأ = InStrB(1، ConStrTemp، StartStr، vbBinaryCompare)
إذا ابدأ<=0 ثم
GetBody = "$خطأ $"
وظيفة الخروج
آخر
إذا كان IncluL=خطأ إذن
ابدأ=ابدأ+LenB(StartStr)
نهاية إذا
نهاية إذا
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
إذا كان أكثر من <= 0 أو أكثر من <= ابدأ بعد ذلك
GetBody = "$خطأ $"
وظيفة الخروج
آخر
إذا InclR = صحيح ثم
أكثر=أكثر+LenB(OverStr)
نهاية إذا
نهاية إذا
GetBody=MidB(ConStr,Start,Over-Start)
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: GetArray
'الوظيفة: استخراج عنوان الارتباط، مفصولاً بـ $Array$
'المعلمة: ConStr ------استخرج الأحرف الأصلية للعنوان
'المعلمة: StartStr ------سلسلة البداية
'المعلمة: OverStr ------سلسلة النهاية
'المعلمة: IncluL ------ما إذا كان 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 = "$خطأ$"
وظيفة الخروج
نهاية إذا
Dim TempStr، TempStr2، objRegExp، Matches، Match
TempStr = ""
تعيين objRegExp = New Regexp
objRegExp.IgnoreCase = صحيح
objRegExp.Global = صحيح
objRegExp.Pattern = "("&StartStr&").+?("&OverStr&")"
تعيين التطابقات =objRegExp.Execute(ConStr)
لكل مباراة في المباريات
TempStr=TempStr & "$Array$" & Match.Value
التالي
تعيين التطابقات = لا شيء
إذا TempStr = "" ثم
GetArray = "$خطأ$"
وظيفة الخروج
نهاية إذا
TempStr=Right(TempStr,Len(TempStr)-7)
إذا IncluL=False إذن
objRegExp.Pattern =StartStr
TempStr=objRegExp.Replace(TempStr،"")
انتهي إذا
إذا InclR = خطأ إذن
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr،"")
انتهي إذا
اضبط objRegExp = لا شيء
تعيين التطابقات = لا شيء
TempStr=Replace(TempStr،""""،")
TempStr=Replace(TempStr،"'"،")
TempStr=Replace(TempStr،" ""،")
TempStr=Replace(TempStr،"("،"،")
TempStr=Replace(TempStr,")")"
إذا TempStr = "" ثم
GetArray = "$خطأ$"
آخر
GetArray=TempStr
انتهي إذا
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: DefiniteUrl
'الوظيفة: تحويل العنوان النسبي إلى العنوان المطلق
'المعلمة: PrimitiveUrl ------ العنوان النسبي المطلوب تحويله
'المعلمة: ConsultUrl ------ عنوان صفحة الويب الحالية
'======================================================================== = =
الدالة DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Dim ConTemp،PriTemp،Pi،Ci،PriArray،ConArray
إذا كان PrimitiveUrl = "" أو ConsultUrl = "" أو PrimitiveUrl = "$False$" أو ConsultUrl = "$False$" إذن
محددUrl="$False$"
وظيفة الخروج
نهاية إذا
إذا Left(Lcase(ConsultUrl),7)<>"http://" ثم
ConsultUrl= "http://" & ConsultUrl
نهاية إذا
ConsultUrl=Replace(ConsultUrl,"/"،/")
ConsultUrl=Replace(ConsultUrl,"://"،://")
PrimitiveUrl=Replace(PrimitiveUrl,"/"،/")
إذا كان Right(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=Replace(PrimitiveUrl,"://"،":://")
ElseIf Left(PrimitiveUrl,1) = "/" إذن
DefiniteUrl=ConArray(0) & PrimitiveUrl
ElseIf Left(PrimitiveUrl,2)="./" ثم
PrimitiveUrl=يمين(PrimitiveUrl,Len(PrimitiveUrl)-2)
إذا كان Right(ConsultUrl,1)="/" إذن
DefiniteUrl=ConsultUrl & PrimitiveUrl
آخر
DefiniteUrl=Left(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 إذن
إذا كان Right(PrimitiveUrl,1)="/" إذن
DefiniteUrl = "http://" & PrimitiveUrl
آخر
إذا Instr(PriArray(Ubound(PriArray)-1),".")>0 إذن
DefiniteUrl = "http://" & PrimitiveUrl
آخر
DefiniteUrl = "http://" & PrimitiveUrl & "/"
نهاية إذا
نهاية إذا
آخر
إذا كان Right(ConsultUrl,1)="/" إذن
DefiniteUrl=ConsultUrl & PrimitiveUrl
آخر
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
نهاية إذا
نهاية إذا
آخر
إذا Instr(PrimitiveUrl,".")>0 إذن
إذا كان Right(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=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
نهاية إذا
نهاية إذا
آخر
إذا كان Right(ConsultUrl,1)="/" إذن
DefiniteUrl=ConsultUrl & PrimitiveUrl & "/"
آخر
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
نهاية إذا
نهاية إذا
نهاية إذا
نهاية إذا
إذا Left(DefiniteUrl,1)="/" إذن
DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
انتهي إذا
إذا كان DefiniteUrl<>"" إذن
DefiniteUrl=Replace(DefiniteUrl,"//"،/")
DefiniteUrl=Replace(DefiniteUrl"،://"،"،://")
آخر
محددUrl="$False$"
نهاية إذا
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: ReplaceSaveRemoteFile
'الوظيفة: استبدال وحفظ الصور عن بعد
'المعلمة: سلسلة ConStr ------ المراد استبدالها
'المعلمة: SaveTf ------ ما إذا كان سيتم حفظ الملف أم لا، فالخطأ لا يحفظ، والحفظ صحيح
'المعلمة: TistUrl------ عنوان صفحة الويب الحالية
'======================================================================== = =
الوظيفة ReplaceSaveRemoteFile(ConStr,InstallPath,strChannelDir,SaveTf,TistUrl)
إذا كان ConStr = "$False$" أو ConStr = "" أو InstallPath = "" أو strChannelDir = "" فحينئذٍ
ReplaceSaveRemoteFile=ConStr
وظيفة الخروج
نهاية إذا
خافت TempStr،TempStr2،TempStr3،إعادة،مطابقات،مباراة،Tempi،TempArray،TempArray2
تعيين إعادة = التعبير العادي الجديد
Re.IgnoreCase = صحيح
Re.Global = صحيح
إعادة النمط ="<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<>"" ثم
إعادة النمط = "src/s*=/s*"
TempStr=Re.Replace(TempStr،"")
نهاية إذا
تعيين التطابقات = لا شيء
تعيين إعادة = لا شيء
إذا كان TempStr = "" أو IsNull (TempStr) = True إذن
ReplaceSaveRemoteFile=ConStr
وظيفة الخروج
انتهي إذا
TempStr=Replace(TempStr،""""،")
TempStr=Replace(TempStr،"'"،")
TempStr=Replace(TempStr،" ""،")
خافت RemoteFileurl،SavePath،PathTemp،DtNow،strFileName،strFileType،ArrSaveFileName،RanNum،Arr_Path
DtNow=الآن()
'***************************************
إذا SaveTf=صحيح إذن
SavePath=InstallPath&strChannelDir
إذا كان CheckDir(InstallPath & strChannelDir)=خطأ، إذن
إذا لم يكن 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(Tempi)
نهاية إذا
التالي
TempStr=Right(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,"$Array$")
'إزالة الصور المكررة والنهاية
Response.اكتب "<br>تم العثور على الصورة:<br>"&Replace(TempStr,"$Array$"،<br>")
'ابدأ في تحويل عناوين الصور النسبية
TempStr = ""
بالنسبة إلى Tempi=0 إلى Ubound(TempArray)
TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)
التالي
TempStr=Right(TempStr,Len(TempStr)-7)
TempStr=Replace(TempStr,Chr(0),"")
TempArray2=Split(TempStr,"$Array$")
TempStr = ""
'نهاية تحويل عنوان الصورة النسبية
"استبدال/حفظ الصورة."
تعيين إعادة = التعبير العادي الجديد
Re.IgnoreCase = صحيح
Re.Global = صحيح
بالنسبة إلى Tempi=0 إلى Ubound(TempArray2)
'***************************************
RemoteFileUrl=TempArray2(Tempi)
إذا كان RemoteFileUrl<>"$False$" وSaveTf=True، فاحفظ الصورة
ArrSaveFileName = Split(RemoteFileurl,".")
strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'نوع الملف
إذا كان strFileType = "asp" أو strFileType = "asa" أو strFileType = "aspx" أو strFileType = "cer" أو strFileType = "cdx" أو strFileType = "exe" أو strFileType = "rar" أو strFileType = "zip" ثم
تحميل الملفات =""
ReplaceSaveRemoteFile=ConStr
وظيفة الخروج
نهاية إذا
عشوائية
RanNum=Int(900*Rnd)+100
strFileName = year(DtNow) & right("0" & month(DtNow),2) & right("0" & day(DtNow),2) & right("0" & hour(DtNow) )،2) & يمين ("0" & دقيقة(DtNow)،2) & يمين("0" & ثانية(DtNow)،2) & ranNum & "." & strFileType
Re.Pattern =TempArray(Tempi)
استجابة.اكتب "<br>حفظ إلى العنوان المحلي:"&InstallPath & strChannelDir & strFileName
إذا كان SaveRemoteFile(InstallPath & strChannelDir & strFileName,RemoteFileUrl,RemoteFileUrl)=صحيح إذن
Response.اكتب "<font color=blue>النجاح</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(Tempi)
ConStr=Re.Replace(ConStr,RemoteFileUrl)
نهاية إذا
'***************************************
التالي
تعيين إعادة = لا شيء
ReplaceSaveRemoteFile=ConStr
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: ReplaceSwfFile
'الوظيفة: تحليل مسار الرسوم المتحركة
'المعلمة: سلسلة ConStr ------ المراد استبدالها
'المعلمة: TistUrl------ عنوان صفحة الويب الحالية
'======================================================================== = =
الدالة ReplaceSwfFile(ConStr,TistUrl)
إذا كان ConStr = "$False$" أو ConStr = "" أو TistUrl = "" أو TistUrl = "$False$" إذن
ReplaceSwfFile=ConStr
وظيفة الخروج
نهاية إذا
خافت TempStr،TempStr2،TempStr3،إعادة،مطابقات،مباراة،Tempi،TempArray،TempArray2
تعيين إعادة = التعبير العادي الجديد
Re.IgnoreCase = صحيح
Re.Global = صحيح
إعادة النمط ="<object.+?[^/>]>"
تعيين التطابقات =Re.Execute(ConStr)
لكل مباراة في المباريات
إذا TempStr<>"" ثم
TempStr=TempStr & "$Array$" & Match.Value
آخر
TempStr=Match.Value
انتهي إذا
التالي
إذا TempStr<>"" ثم
TempArray=Split(TempStr,"$Array$")
TempStr = ""
بالنسبة إلى Tempi=0 إلى Ubound(TempArray)
إعادة النمط ="value/s*=/s*.+?/.swf"
تعيين التطابقات =Re.Execute(TempArray(Tempi))
لكل مباراة في المباريات
إذا TempStr<>"" ثم
TempStr=TempStr & "$Array$" & Match.Value
آخر
TempStr=Match.Value
انتهي إذا
التالي
التالي
انتهي إذا
إذا TempStr<>"" ثم
إعادة النمط = "القيمة/s*=/s*"
TempStr=Re.Replace(TempStr،"")
نهاية إذا
إذا كان TempStr = "" أو IsNull (TempStr) = True إذن
ReplaceSwfFile=ConStr
وظيفة الخروج
انتهي إذا
TempStr=Replace(TempStr،""""،")
TempStr=Replace(TempStr،"'"،")
TempStr=Replace(TempStr،" ""،")
تعيين التطابقات = لا شيء
تعيين إعادة = لا شيء
'ابدأ بإزالة الملفات المكررة
TempArray=Split(TempStr,"$Array$")
TempStr = ""
بالنسبة إلى Tempi=0 إلى Ubound(TempArray)
إذا كان Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 إذن
TempStr=TempStr & "$Array$" & TempArray(Tempi)
نهاية إذا
التالي
TempStr=Right(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,"$Array$")
'قم بإزالة الملفات المكررة وانتهى
'ابدأ في تحويل العناوين النسبية
TempStr = ""
بالنسبة إلى Tempi=0 إلى Ubound(TempArray)
TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)
التالي
TempStr=Right(TempStr,Len(TempStr)-7)
TempStr=Replace(TempStr,Chr(0),"")
TempArray2=Split(TempStr,"$Array$")
TempStr = ""
'نهاية تحويل العنوان النسبي
'يستبدل
تعيين إعادة = التعبير العادي الجديد
Re.IgnoreCase = صحيح
Re.Global = صحيح
بالنسبة إلى Tempi=0 إلى Ubound(TempArray2)
RemoteFileUrl=TempArray2(Tempi)
Re.Pattern =TempArray(Tempi)
ConStr=Re.Replace(ConStr,RemoteFileUrl)
التالي
تعيين إعادة = لا شيء
ReplaceSwfFile=ConStr
وظيفة النهاية
'======================================================================== = =
'اسم العملية: SaveRemoteFile
'الوظيفة: حفظ الملفات البعيدة إلى الملفات المحلية
'المعلمة: LocalFileName ------ اسم الملف المحلي
'المعلمة: RemoteFileUrl ------ عنوان URL للملف البعيد
'المعلمة: المُحيل ------ ملف الاتصال عن بعد (لمكافحة التحصيل، استخدم عنوان صفحة المحتوى، واتركه فارغًا إذا لم يكن هناك مانع للتحصيل)
'======================================================================== = =
الدالة SaveRemoteFile(LocalFileName,RemoteFileUrl,Referer)
SaveRemoteFile=True
الإعلانات الخافتة، الاسترجاع، GetRemoteData
تعيين الاسترداد = Server.CreateObject("Microsoft.XMLHTTP")
مع الاسترجاع
.فتح "الحصول على"، RemoteFileUrl، خطأ، ""، ""
إذا كان المُحيل <>"" ثم .setRequestHeader "Referer"،Referer
.يرسل
إذا .Readystate<>4 ثم
SaveRemoteFile=False
وظيفة الخروج
نهاية إذا
GetRemoteData = .ResponseBody
نهاية مع
تعيين الاسترجاع = لا شيء
تعيين الإعلانات = Server.CreateObject("Adodb.Stream")
مع الإعلانات
.النوع = 1
.يفتح
.اكتب GetRemoteData
.SaveToFile server.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=LCase(OverStr)
أكثر=Instr(1,TempStr,OverStr)
إذا كان أكثر من <=0 ثم
GetPaing = "$False$"
وظيفة الخروج
آخر
إذا InclR = صحيح ثم
أكثر=أكثر+لين(OverStr)
نهاية إذا
نهاية إذا
TempStr=Mid(TempStr,1,Over)
ابدأ=InstrRev(TempStr,StartStr)
إذا كان IncluL=خطأ إذن
ابدأ=ابدأ+لين(StartStr)
نهاية إذا
إذا كانت البداية <= 0 أو البداية> = بعد ذلك
GetPaing = "$False$"
وظيفة الخروج
نهاية إذا
ConTemp=Mid(ConStr,Start,Over-Start)
ConTemp=تريم(ConTemp)
'ConTemp=Replace(ConTemp،" ""،")
ConTemp=Replace(ConTemp،"،"،")
ConTemp=Replace(ConTemp،"'"،")
ConTemp=Replace(ConTemp،""""،")
ConTemp=Replace(ConTemp،">"،")
ConTemp=Replace(ConTemp،"<"،")
ConTemp=Replace(ConTemp،" ;"،"،")
GetPaing=ConTemp
وظيفة النهاية
'***************************************************************************************************************************************************************************
'اسم الوظيفة: gotTopic
'الوظيفة: اقتطاع السلسلة، يتم احتساب كل حرف صيني كحرفين، ويتم احتساب الحرف الإنجليزي كحرف واحد
'المعلمة: str ---- السلسلة الأصلية
' strlen ---- طول الاعتراض
'قيمة الإرجاع: سلسلة تم اعتراضها
'***************************************************************************************************************************************************************************
الدالة gotTopic(str,strlen)
إذا str = "" ثم
حصلت على الموضوع = ""
وظيفة الخروج
نهاية إذا
خافت ل، ر، ج، ط
str=replace(replace(replace(replace(str"، ""،"،""،chr(34))"،>"،>")،"<"،<")
ل = لين (شارع)
ر = 0
لأني = 1 إلى ل
ج = القيمة المطلقة (تصاعدي (منتصف (شارع، ط، 1)))
إذا ج> 255 ثم
ر=ر+2
آخر
ر=ر+1
نهاية إذا
إذا t>=strlen ثم
gotTopic=left(str,i) & "..."
الخروج ل
آخر
gotTopic=str
نهاية إذا
التالي
gotTopic=replace(replace(replace(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$" إذن
إنشاء كلمة رئيسية = "$False$"
وظيفة الخروج
نهاية إذا
إذا كان Num = "" أو IsNumeric (Num) = خطأ، إذن
رقم = 2
نهاية إذا
كونستر=استبدال(كونستر,CHR(32),"")
كونستر=استبدال(كونستر,CHR(9),"")
Constr=Replace(Constr،" ""،")
Constr=Replace(Constr،" ""،")
كونستر=استبدال(كونستر،"("،"،")
كونستر=استبدال(كونستر،")"،"،"")
كونستر=استبدال(كونستر،"<"،")
كونستر=استبدال(كونستر،">"،")
كونستر=استبدال(كونستر،""""،")
كونستر=استبدال(كونستر،"؟""،")
كونستر=استبدال(كونستر،"*"،"")
كونستر=استبدال(كونستر،"،"،")
كونستر=استبدال(كونستر،،"،"،")
كونستر=استبدال(كونستر،"."،")
كونستر=استبدال(كونستر،"/"،"")
كونستر=استبدال(كونستر،"/"،"")
كونستر=استبدال(كونستر،"-"،"،")
كونستر=استبدال(كونستر،"@"،")
كونستر=استبدال(كونستر،"#"،")
كونستر=استبدال(كونستر،"$"،")
كونستر=استبدال(كونستر،"%"،")
كونستر=استبدال(كونستر،"&"،")
كونستر=استبدال(كونستر،"+"،")
Constr=Replace(Constr,":":"")
كونستر = استبدال (كونستر، ":"، "")
كونستر=استبدال(كونستر،"'"،")
كونستر=استبدال(كونستر،"""،")
كونستر=استبدال(كونستر،"""،")
خافت أنا،ConstrTemp
لأني = 1 إلى لين (كونستر)
ConstrTemp=ConstrTemp & "" & Mid(Constr,i,Num)
التالي
إذا كان Len(ConstrTemp)<254 إذن
ConstrTemp=ConstrTemp & ""
آخر
ConstrTemp=Left(ConstrTemp,254) & ""
نهاية إذا
CreateKeyWord=ConstrTemp
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: CheckUrl
'الوظيفة: التحقق من عنوان URL
'المعلمة: strUrl ------ للتحقق من عنوان URL
'======================================================================== = =
وظيفة CheckUrl(strUrl)
ديم ري
تعيين إعادة = RegExp الجديد
Re.IgnoreCase=true
Re.Global = صحيح
Re.Pattern = "http://([/w-]+/.)+[/w-]+(/[/w-./?%&=]*)؟"
إذا كان Re.test(strUrl)=صحيح إذن
CheckUrl=strUrl
آخر
CheckUrl="$False$"
نهاية إذا
تعيين روبية = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: ScriptHtml
'الوظيفة: تصفية علامات HTML
'المعلمة: ConStr ------ السلسلة المراد تصفيتها
'======================================================================== = =
الوظيفة ScriptHtml (Byval ConStr، TagName، FType)
ديم ري
تعيين إعادة = RegExp الجديد
Re.IgnoreCase=true
Re.Global = صحيح
حدد نوع الحالة
الحالة 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
تعيين إعادة = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: RemoveHTML
'الوظيفة: إزالة علامات HTML بالكامل
'المعلمة: strHTML ------ السلسلة المراد تصفيتها
'======================================================================== = =
وظيفة إزالةHTML(strHTML)
خافت objRegExp، مباراة، مباريات
تعيين objRegExp = New Regexp
objRegExp.IgnoreCase = صحيح
objRegExp.Global = صحيح
'احصل على مغلقة <>
objRegExp.Pattern = "<.+?>"
'مباراة
تعيين التطابقات = objRegExp.Execute(strHTML)
'اجتياز المجموعة المطابقة واستبدال العناصر المطابقة
لكل مباراة في المباريات
strHtml=Replace(strHTML,Match.Value,"")
التالي
RemoveHTML=strHTML
تعيين objRegExp = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: CheckDir
'الوظيفة: التحقق من وجود المجلد
'المعلمة: FolderPath ------ مسار المجلد
'======================================================================== = =
وظيفة CheckDir (byval FolderPath)
خافت
تعيين fso = Server.CreateObject("Scripting.FileSystemObject")
إذا كان fso.FolderExists(Server.MapPath(folderpath)) إذن
'يخرج
CheckDir = صحيح
آخر
"غير موجود."
CheckDir = خطأ
انتهي إذا
تعيين fso = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: MakeNewsDir
'الوظيفة: إنشاء مجلد
'المعلمة: اسم المجلد ------ اسم المجلد
'======================================================================== = =
وظيفة MakeNewsDir (اسم المجلد byval)
خافت
تعيين fso = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
fso.CreateFolder(Server.MapPath(اسم المجلد))
إذا كان fso.FolderExists(Server.MapPath(foldername)) إذن
MakeNewsDir = صحيح
آخر
MakeNewsDir = خطأ
نهاية إذا
تعيين fso = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: DelDir
'الوظيفة: إنشاء مجلد
'المعلمة: اسم المجلد ------ اسم المجلد
'======================================================================== = =
وظيفة DelDir (اسم المجلد byval)
خافت
تعيين fso = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
إذا كان fso.FolderExists(Server.MapPath(foldername)) ثم "حدد ما إذا كان المجلد موجودًا أم لا"
fso.DeleteFolder (Server.MapPath(foldername)) 'حذف المجلد
نهاية إذا
تعيين fso = لا شيء
وظيفة النهاية
'********************************************************************************************************************************************************************************* *
'اسم الوظيفة: IsObjInstalled
'الوظيفة: التحقق من تثبيت المكون
'المعلمة: strClassString ---- اسم المكون
'قيمة الإرجاع: صحيح ---- مثبتة بالفعل
' خطأ ---- غير مثبت
'********************************************************************************************************************************************************************************* *
الدالة IsObjInstalled(strClassString)
IsObjInstalled = خطأ
الخطأ = 0
DimxTestObj
تعيين xTestObj = Server.CreateObject(strClassString)
إذا كان 0 = خطأ، فإن IsObjInstalled = صحيح
تعيين xTestObj = لا شيء
الخطأ = 0
وظيفة النهاية
'********************************************************************************************************************************************************************************* *
'اسم الوظيفة: strLength
'الوظيفة: العثور على طول السلسلة. يتم احتساب الأحرف الصينية على أنها حرفين، والأحرف الإنجليزية على أنها حرف واحد.
'المعلمة: str ----سلسلة بالطول المطلوب
'قيمة الإرجاع: طول السلسلة
'********************************************************************************************************************************************************************************* *
طول الدالة (شارع)
عند حدوث خطأ في الاستئناف التالي
خافت WINNT_CHINESE
WINNT_CHINESE = (لين("الصين")=2)
إذا WINNT_CHINESE ذلك الحين
خافت ل، ر، ج
خافت أنا
ل = لين (شارع)
ر = ل
لأني = 1 إلى ل
ج = تصاعدي (منتصف (شارع، ط، 1))
إذا كان c<0 ثم c=c+65536
إذا ج> 255 ثم
ر=ر+1
نهاية إذا
التالي
طول الطول = ر
آخر
طول الطول = لين (شارع)
نهاية إذا
إذا كان err.number<>0 ثم err.clear
وظيفة النهاية
'********************************************************************************************************************************************************************************* * **
'اسم الوظيفة: إنشاء مجلد متعدد
'الوظيفة: إنشاء أدلة متعددة المستويات، يمكنك إنشاء أدلة جذر غير موجودة
'المعلمة: اسم الدليل الذي سيتم إنشاؤه، والذي يمكن أن يكون متعدد المستويات
'إرجاع القيمة المنطقية: صحيح عند النجاح، خطأ عند الفشل
'قم بإنشاء الدليل الجذر للدليل بدءًا من الدليل الحالي
'********************************************************************************************************************************************************************************* * **
وظيفة إنشاء مجلد متعدد (ByVal CFolder)
خافت objFSO، PhCreateFolder،CreateFolderArray،CreateFolder
Dim i,ii,CreateFolderSub,PhCreateFolderSub,BlInfo
بلينفو=خطأ
CreateFolder = CFolder
على خطأ استئناف التالي
تعيين objFSO = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
إذا أخطأت ثم
خطأ.مسح ()
وظيفة الخروج
نهاية إذا
CreateFolder = استبدال (CreateFolder، "/"، "/")
إذا كان اليسار (CreateFolder،1) = "/" ثم
'CreateFolder = Right(CreateFolder,Len(CreateFolder)-1)
نهاية إذا
إذا كان صحيحًا (CreateFolder،1) = "/" ثم
CreateFolder = Left(CreateFolder,Len(CreateFolder)-1)
نهاية إذا
CreateFolderArray = سبليت(CreateFolder,"/")
لأني = 0 إلى UBound(CreateFolderArray)
كريتفولديرسوب = ""
لثاني = 0 إلى ط
CreateFolderSub = CreateFolderSub وCreateFolderArray(ii) و"/"
التالي
PhCreateFolderSub = Server.MapPath(CreateFolderSub)
'response.Write PhCreateFolderSub&"<br>"
إذا لم يكن objFSO.FolderExists(PhCreateFolderSub) إذن
objFSO.CreateFolder(PhCreateFolderSub)
نهاية إذا
التالي
إذا أخطأت ثم
خطأ.مسح ()
آخر
بلينفو=صحيح
نهاية إذا
اضبط objFSO = لا شيء
CreateMultiFolder = BlInfo
وظيفة النهاية
'********************************************************************************************************************************************************************************* *
'اسم الوظيفة: FSOFileRead
'الوظيفة: استخدم FSO لقراءة وظيفة محتوى الملف
'المعلمة: اسم الملف ---- اسم الملف
"قيمة الإرجاع: محتوى الملف
'********************************************************************************************************************************************************************************* *
وظيفة FSOFileRead (اسم الملف)
خافت objFSO،objCountFile،FiletempData
تعيين objFSO = Server.CreateObject("Scripting.FileSystemObject")
تعيين objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
تعيين objCountFile = لا شيء
تعيين objFSO = لا شيء
وظيفة النهاية
'********************************************************************************************************************************************************************************* *
'اسم الوظيفة: FSOlineedit
'الوظيفة: استخدم FSO لقراءة سطر معين من وظيفة الملف
'المعلمة: اسم الملف ---- اسم الملف
'lineNum ----رقم السطر
'قيمة الإرجاع: محتوى السطر في الملف
'********************************************************************************************************************************************************************************* *
الدالة FSOlineedit (اسم الملف، رقم الخط)
إذا كان Linenum <1 ثم قم بالخروج من الوظيفة
خافت fso،f،temparray،tempcnt
تعيين fso = server.CreateObject("scripting.filesystemobject")
إذا لم يكن fso.fileExists(server.mappath(filename)) ثم قم بالخروج من الوظيفة
تعيين f = fso.opentextfile(server.mappath(filename),1)
إن لم يكن f.AtEndofStream ثم
tempcnt = f.readall
f. إغلاق
مجموعة و = لا شيء
temparray = سبليت (tempcnt، حقوق الإنسان (13) ولجنة حقوق الإنسان (10))
إذا كان lineNum>ubound(temparray)+1 إذن
وظيفة الخروج
آخر
FSOlineedit = temparray(lineNum-1)
نهاية إذا
نهاية إذا
وظيفة النهاية
'********************************************************************************************************************************************************************************* *
'اسم الوظيفة: FSOlinewrite
'الوظيفة: استخدم FSO لكتابة سطر معين من وظيفة الملف
'المعلمة: اسم الملف ---- اسم الملف
'lineNum ----رقم السطر
' محتوى الخط ---- المحتوى
'قيمة الإرجاع: لا شيء
'********************************************************************************************************************************************************************************* *
وظيفة FSOlinewrite (اسم الملف، رقم الخط، محتوى الخط)
إذا كان Linenum <1 ثم قم بالخروج من الوظيفة
خافت fso، f، temparray، tempCnt
تعيين fso = server.CreateObject("scripting.filesystemobject")
إذا لم يكن fso.fileExists(server.mappath(filename)) ثم قم بالخروج من الوظيفة
تعيين f = fso.opentextfile(server.mappath(filename),1)
إذا لم يكن f.AtEndofStream ثم
tempcnt = f.readall
f. إغلاق
temparray = سبليت (tempcnt، حقوق الإنسان (13) ولجنة حقوق الإنسان (10))
إذا كان lineNum>ubound(temparray)+1 إذن
وظيفة الخروج
آخر
temparray(lineNum-1) = lineContent
نهاية إذا
tempcnt = الانضمام (temparray، مركز حقوق الإنسان (13) ومركز حقوق الإنسان (10))
تعيين f = fso.createtextfile(server.mappath(filename),true)
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) إذن
آخر
إنشاء مجلد متعدد (HtmlFolder)
&، ;ملاحظة، ص؛
تعيين fout = fso.Createtextfile(server.mappath(filepath),true)
fout.writeline HtmlContent
fout. Close
تعيين 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 = لا شيء
وظيفة النهاية
'********************************************************************************************************************************************************************************* *
'اسم الدالة: هتملدل
'الوظيفة: استخدم FSO لحذف الملفات
"المعلمة: HtmlFolder ---- المسار
'HtmlFilename ---- اسم الملف
'********************************************************************************************************************************************************************************* *
فرعي Htmldel(HtmlFolder،HtmlFilename)
مسار الملف الخافت، fso
filepath = HtmlFolder&"/"&HtmlFilename
تعيين fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(Server.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 = Replace(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، """، مركز حقوق الإنسان (34))
fString = استبدال (fString، "'"، مركز حقوق الإنسان (39))
fString = استبدال (fString، ""، مركز حقوق الإنسان (13))
fString = استبدال (fString، " "،" ")
fString = Replace(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=replace(unHtmllist,chr(13),"<br>")
نهاية إذا
وظيفة النهاية
وظيفة unhtmllists (المحتوى)
unhtmllists=content
إذا كان المحتوى <> "" إذن
unhtmllists=replace(unhtmllists،""""،")
unhtmllists=replace(unhtmllists،"'"،")
unhtmllists=replace(unhtmllists,chr(10),"")
unHtmllists=replace(unHtmllists,chr(13),"<br>")
نهاية إذا
وظيفة النهاية
قوائم HTML الوظيفية (المحتوى)
htmllists=content
إذا كان المحتوى <> "" إذن
htmllists=replace(htmllists,"''"،""")
htmllists=replace(htmllists,""،"")
htmllists=replace(htmllists,"<br>",chr(13)&chr(10))
نهاية إذا
وظيفة النهاية
قوائم uhtml للوظائف (المحتوى)
uhtmllists=content
إذا كان المحتوى <> "" إذن
uhtlists=replace(uhtlists,""""،"''")
uhtlists=replace(uhtlists,"'",";")
uhtlists=replace(uhtlists,chr(10),"")
uHtmllists=replace(uHtmllists,chr(13),"<br>")
نهاية إذا
وظيفة النهاية
'======================================================================== =
"العملية: النوم."
'الوظيفة: يتوقف البرنامج هنا لبضع ثوان
'المعلمات: iSeconds عدد الثواني التي سيتم إيقافها مؤقتًا
'======================================================================== =
النوم الفرعي (iSeconds)
Response.Write "<font color=blue>بدء الإيقاف المؤقت لمدة "&iSeconds&" ثانية</font><br>"
خافت ر:ر=المؤقت()
بينما (المؤقت ()<t+iSeconds)
لا تفعل شيئًا
ويند
Response.اكتب "<font color=blue>إيقاف مؤقت"&iSeconds&" نهاية الثواني</font><br>"
نهاية الفرعية
'======================================================================== = =
'اسم الوظيفة: MyArray
'الوظيفة: استخراج العلامات للفصل
'المعلمة: ConStr ------استخرج الأحرف الأصلية للعنوان
'======================================================================== = =
الدالة MyArray(ByvalConStr)
تعيين objRegExp = New Regexp
objRegExp.IgnoreCase = صحيح
objRegExp.Global = صحيح
objRegExp.Pattern = "({).+?(})"
تعيين التطابقات =objRegExp.Execute(ConStr)
لكل مباراة في المباريات
TempStr=TempStr & "" & Match.Value
التالي
تعيين التطابقات = لا شيء
TempStr=يمين(TempStr,Len(TempStr)-1)
objRegExp.Pattern = "{"
TempStr=objRegExp.Replace(TempStr،"")
objRegExp.Pattern = "}"
TempStr=objRegExp.Replace(TempStr،"")
اضبط objRegExp = لا شيء
تعيين التطابقات = لا شيء
TempStr=Replace(TempStr،"$"،")
إذا TempStr = "" ثم
MyArray="لا يوجد شيء لاستخراجه في التعليمات البرمجية"
آخر
MyArray=TempStr
انتهي إذا
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: randm
'الوظيفة: إنشاء رقم عشوائي مكون من 6 أرقام
'======================================================================== = =
وظيفة عشوائية
عشوائية
راندم=كثافة العمليات((900000*rnd)+100000)
وظيفة النهاية
%>