توفر هذه المقالة مجموعة كاملة من وظائف مجموعة 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 الحصول على، HttpUrl، خطأ
المتشعب.إرسال ()
إذا 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 طول المحتوى،Len(PostData)
xmlHttp.setRequestHeader نوع المحتوى، التطبيق/x-www-form-urlencoded
xmlHttp.setRequestHeader مُحيل، RefererUrl
xmlHttp.إرسال بيانات البريد
إذا 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 = 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 أو 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=خطأ إذن
ابدأ=ابدأ+LenB(StartStr)
نهاية إذا
نهاية إذا
Over=InStrB(Start,ConStrTemp,OverStr,vbBinaryCompare)
إذا كان أكثر من <= 0 أو أكثر من <= ابدأ بعد ذلك
GetBody=$False$
وظيفة الخروج
آخر
إذا 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=$False$
وظيفة الخروج
نهاية إذا
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=$False$
وظيفة الخروج
نهاية إذا
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=استبدال(TempStr,,)
TempStr=Replace(TempStr,',)
TempStr=Replace(TempStr, ,)
TempStr=استبدال(TempStr,(,)
TempStr=استبدال(TempStr،)،)
إذا TempStr= ثم
GetArray=$False$
آخر
GetArray=TempStr
انتهي إذا
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: DefiniteUrl
'الوظيفة: تحويل العنوان النسبي إلى العنوان المطلق
'المعلمة: PrimitiveUrl ------ العنوان النسبي المطلوب تحويله
'المعلمة: ConsultUrl ------ عنوان صفحة الويب الحالية
'======================================================================== = =
الدالة DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Dim ConTemp،PriTemp،Pi،Ci،PriArray،ConArray
إذا كان PrimitiveUrl= أو ConsultUrl= أو PrimitiveUrl=$False$ أو ConsultUrl=$False$ إذن
DefiniteUrl=$False$
وظيفة الخروج
نهاية إذا
إذا اليسار (Lcase(ConsultUrl),7)<>http:// ثم
ConsultUrl= http:// & ConsultUrl
نهاية إذا
ConsultUrl=استبدال(ConsultUrl,/,/)
ConsultUrl=Replace(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=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=استبدال(DefiniteUrl,//,/)
DefiniteUrl=Replace(DefiniteUrl,://,://)
آخر
DefiniteUrl=$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=استبدال(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) ثم
Response.Write 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=يمين(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=يمين(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 = سبليت (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 = سنة (DtNow) & يمين (0 & شهر (DtNow),2) & يمين (0 & يوم (DtNow),2) & يمين (0 & ساعة (DtNow),2) & يمين (0 & دقيقة (DtNow) ) ),2) & right(0 & Second(DtNow),2) & ranNum &
Re.Pattern =TempArray(Tempi)
استجابة.اكتب <br>احفظ في العنوان المحلي:&InstallPath & strChannelDir & strFileName
إذا كان SaveRemoteFile(InstallPath & strChannelDir & strFileName,RemoteFileUrl,RemoteFileUrl)=صحيح إذن
استجابة.اكتب <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 = صحيح
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<> ثم
إعادة النمط = القيمة/الصورة*=/الصورة*
TempStr=Re.Replace(TempStr,)
نهاية إذا
إذا كان TempStr= أو IsNull(TempStr)=True إذن
ReplaceSwfFile=ConStr
وظيفة الخروج
انتهي إذا
TempStr=استبدال(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=يمين(TempStr,Len(TempStr)-7)
TempArray=Split(TempStr,$Array$)
'قم بإزالة الملفات المكررة وانتهى
'ابدأ في تحويل العناوين النسبية
TempStr=
بالنسبة إلى Tempi=0 إلى Ubound(TempArray)
TempStr=TempStr & $Array$ & DefiniteUrl(TempArray(Tempi),TistUrl)
التالي
TempStr=يمين(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
.يرسل
إذا .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= إذن
JoinChar=
وظيفة الخروج
نهاية إذا
إذا كان 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)=False إذن
رقم = 2
نهاية إذا
كونستر = استبدال (كونستر، CHR (32)،)
كونستر=استبدال(كونستر،CHR(9)،)
كونستر=استبدال(كونستر،،)
كونستر=استبدال(كونستر،،)
كونستر = استبدال (كونستر، (،)
كونستر = استبدال (كونستر،)،)
كونستر=استبدال(كونستر،<،)
كونستر=استبدال(كونستر،>،)
كونستر=استبدال(كونستر،،)
كونستر=استبدال(كونستر،؟،)
كونستر=استبدال(كونستر،*،)
كونستر=استبدال(كونستر،،)
كونستر=استبدال(كونستر،،،)
كونستر=استبدال(كونستر،.،)
كونستر=استبدال(كونستر،/،)
كونستر=استبدال(كونستر،/،)
كونستر=استبدال(كونستر،-،)
كونستر=استبدال(كونستر،@،)
كونستر=استبدال(كونستر،#،)
كونستر=استبدال(كونستر،$،)
كونستر=استبدال(كونستر،٪،)
كونستر=استبدال(كونستر،&،)
كونستر=استبدال(كونستر،+،)
كونستر=استبدال(كونستر،:،)
كونستر=استبدال(كونستر،:،)
كونستر=استبدال(كونستر،'،)
كونستر=استبدال(كونستر،،)
كونستر=استبدال(كونستر،،)
خافت أنا،ConstrTemp
لأني = 1 إلى لين (كونستر)
ConstrTemp=ConstrTemp & & Mid(Constr,i,Num)
التالي
إذا كان Len(ConstrTemp)<254 إذن
ConstrTemp=ConstrTemp &
آخر
ConstrTemp=يسار(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
وظيفة النهاية
'********************************************************************************************************************************************************************************* * **
'اسم الوظيفة: إنشاء مجلد متعدد
'الوظيفة: إنشاء أدلة متعددة المستويات، يمكنك إنشاء أدلة جذر غير موجودة
'المعلمة: اسم الدليل الذي سيتم إنشاؤه، والذي يمكن أن يكون متعدد المستويات
'إرجاع القيمة المنطقية: صحيح عند النجاح، خطأ عند الفشل
'قم بإنشاء الدليل الجذر للدليل بدءًا من الدليل الحالي
'********************************************************************************************************************************************************************************* * **
وظيفة CreateMultiFolder (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 = استبدال(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 = 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.Write <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)
وظيفة النهاية
%>