أداة تجمع محتوى المقالة عن بعد، وتحفظ الصور، وتنشئ الملفات، وما إلى ذلك.

توفر هذه المقالة مجموعة كاملة من وظائف مجموعة 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)

وظيفة النهاية

%>