Artikel ini menyediakan serangkaian fungsi pengumpulan ASP lengkap, termasuk fungsi seperti mengekstraksi karakter asli alamat, menyimpan file jarak jauh ke login simulasi lokal, dan mendapatkan kode sumber halaman web.
Copy kode kodenya sebagai berikut:
' ===== = =
'Nama fungsi: GetHttpPage
'Fungsi: Mendapatkan kode sumber halaman web
'Parameter: HttpUrl ------Alamat halaman web
' ===== = =
Fungsi DapatkanHttpPage(HttpUrl)
Jika IsNull(HttpUrl)=Benar Atau Len(HttpUrl)<18 Atau HttpUrl="$False$" Lalu
GetHttpPage="$Salah$"
Fungsi Keluar
Akhiri Jika
Redupkan Http
Setel Http=server.createobject("MSX" & "ML2.XM" & "LHT" & "TP")
Http.buka "GET",HttpUrl,False
Http.Kirim()
Jika Http.Readystate<>4 maka
Setel Http=Tidak Ada
GetHttpPage="$Salah$"
Fungsi keluar
Berakhir jika
DapatkanHTTPPage=bytesToBSTR(Http.responseBody,"GB2312")
GetHTTPPage=ganti(ganti(GetHTTPPage , vbCr,""),vbLf,"")
Setel Http=Tidak Ada
Jika Err.number<>0 maka
Err. Jelas
Akhiri Jika
Fungsi Akhir
' ===== = =
'Nama fungsi: BytesToBstr
'Fungsi: Mengubah kode sumber yang diperoleh ke dalam bahasa Mandarin
'Parameter: Isi ------Variabel yang akan dikonversi
'Parameter: Cset ------ketik yang akan dikonversi
' ===== = =
Fungsi BytesToBstr(Badan,Cset)
Redupkan Objstream
Setel Objstream = Server.CreateObject("ad" & "odb.str" & "eam")
objstream.Jenis = 1
objstream.Mode =3
objstream.Buka
objstream.Tulis isi
objstream.Posisi = 0
objstream.Jenis = 2
objstream.Charset = Cset
BytesToBstr = objstream.ReadText
objstream.Tutup
setel objstream = tidak ada
Fungsi Akhir
' ===== = =
'Nama fungsi: PostHttpPage
'Fungsi: masuk
' ===== = =
Fungsi PostHttpPage(RefererUrl,PostUrl,PostData)
DimxmlHttp
RedupRetStr
Setel xmlHttp = CreateObject("Msx" & "ml2.XM" & "LHT" & "TP")
xmlHttp.Buka "POST", PostUrl, Salah
XmlHTTP.setRequestHeader "Panjang Konten", Len (Data Pos)
xmlHttp.setRequestHeader "Jenis Konten", "aplikasi/x-www-form-urlencoded"
xmlHttp.setRequestHeader "Referer", RefererUrl
xmlHttp.Kirim PostData
Jika Err.Number <> 0 Lalu
Setel xmlHttp=Tidak Ada
PostHttpPage = "$Salah$"
Fungsi Keluar
Akhiri Jika
PostHttpPage=bytesToBSTR(xmlHttp.responseBody,"GB2312")
Setel xmlHttp = tidak ada
Fungsi Akhir
' ===== = =
'Nama fungsi: UrlEncoding
'Fungsi: Mengonversi pengkodean
' ===== = =
Fungsi Pengkodean Url(DataStr)
Redupkan StrReturn,Si,ThisChr,InnerCode,Hight8,Low8
StrKembali = ""
Untuk Si = 1 Ke Len(DataStr)
ThisChr = Tengah(DataStr,Si,1)
Jika Abs(Asc(ThisChr)) < &HFF Lalu
StrReturn = StrReturn & IniChr
Kalau tidak
Kode Dalam = Asc(ThisChr)
Jika InnerCode < 0 Maka
Kode Dalam = Kode Dalam + &H10000
Akhiri Jika
Hight8 = (Kode Dalam Dan &HFF00)/ &HFF
Low8 = Kode Dalam Dan &HFF
StrReturn = StrReturn & "%" & Hex(Tinggi8) & "%" & Hex(Rendah8)
Akhiri Jika
Berikutnya
UrlEncoding = StrReturn
Fungsi Akhir
' ===== = =
'Nama fungsi: GetBody
'Fungsi: mencegat string
'Parameter: ConStr ------ String yang akan dicegat
'Parameter: StartStr ------ string awal
'Parameter: OverStr ------ String akhir
'Parameter: IncluL ------ Apakah StartStr disertakan
'Parameter:IncluR ------apakah akan menyertakan OverStr
' ===== = =
Fungsi GetBody(ConStr,StartStr,OverStr,IncluL,IncluR)
Jika ConStr="$False$" atau ConStr="" atau IsNull(ConStr)=True Atau StartStr="" atau IsNull(StartStr)=True Atau OverStr="" atau IsNull(OverStr)=True Maka
DapatkanBody="$Salah$"
Fungsi Keluar
Akhiri Jika
DimConStrTemp
Redupkan Mulai, Selesai
ConStrTemp=Lcase(ConStr)
MulaiStr=Lkasus(MulaiStr)
OverStr=Lkasus(OverStr)
Mulai = InStrB(1, ConStrTemp, StartStr, vbBinaryCompare)
Jika Mulai<=0 maka
DapatkanBody="$Salah$"
Fungsi Keluar
Kalau tidak
Jika Termasuk = Salah Maka
Mulai=Mulai+LenB(MulaiStr)
Akhiri Jika
Akhiri Jika
Over=InStrB(Mulai,ConStrTemp,OverStr,vbBinaryCompare)
Jika Lebih<=0 Atau Lebih<=Mulai maka
DapatkanBody="$Salah$"
Fungsi Keluar
Kalau tidak
Jika InclR=Benar Maka
Atas=Atas+LenB(AtasStr)
Akhiri Jika
Akhiri Jika
GetBody=MidB(ConStr,Mulai,Awal-Awal)
Fungsi Akhir
' ===== = =
'Nama fungsi: GetArray
'Fungsi: Ekstrak alamat tautan, dipisahkan dengan $Array$
'Parameter: ConStr ------Ekstrak karakter asli alamat
'Parameter: StartStr ------ string awal
'Parameter: OverStr ------ String akhir
'Parameter: IncluL ------ Apakah StartStr disertakan
'Parameter:IncluR ------apakah akan menyertakan OverStr
' ===== = =
Fungsi GetArray(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
Jika ConStr="$False$" atau ConStr="" Atau IsNull(ConStr)=True atau StartStr="" Atau OverStr="" atau IsNull(StartStr)=Benar Atau IsNull(OverStr)=True Maka
DapatkanArray="$Salah$"
Fungsi Keluar
Akhiri Jika
Redupkan TempStr,TempStr2,objRegExp,Cocok,Cocok
SuhuStr=""
Setel objRegExp = Regexp Baru
objRegExp.IgnoreCase = Benar
objRegExp.Global = Benar
objRegExp.Pattern = "("&StartStr&").+?("&OverStr&")"
Tetapkan Kecocokan =objRegExp.Execute(ConStr)
Untuk Setiap Pertandingan dalam Pertandingan
TempStr=TempStr & "$Array$" & Cocok.Nilai
Berikutnya
Tetapkan Kecocokan=tidak ada
Jika TempStr = "" Lalu
DapatkanArray="$Salah$"
Fungsi Keluar
Akhiri Jika
TempStr=Kanan(TempStr,Len(TempStr)-7)
Jika IncluL=False maka
objRegExp.Pattern =StartStr
TempStr=objRegExp.Replace(TempStr,"")
Berakhir jika
Jika InclR=False maka
objRegExp.Pattern =OverStr
TempStr=objRegExp.Replace(TempStr,"")
Berakhir jika
Setel objRegExp=tidak ada
Tetapkan Kecocokan=tidak ada
TempStr=Ganti(TempStr,"""","")
TempStr=Ganti(TempStr,"'","")
TempStr=Ganti(TempStr," ","")
TempStr=Ganti(TempStr,"(","")
TempStr=Ganti(TempStr,"")","")
Jika TempStr="" maka
DapatkanArray="$Salah$"
Kalau tidak
DapatkanArray=TempStr
Berakhir jika
Fungsi Akhir
' ===== = =
'Nama fungsi: DefiniteUrl
'Fungsi: Mengubah alamat relatif menjadi alamat absolut
'Parameter: PrimitiveUrl ------ alamat relatif yang akan dikonversi
'Parameter: ConsultUrl ------Alamat halaman web saat ini
' ===== = =
Fungsi DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Redupkan ConTemp,PriTemp,Pi,Ci,PriArray,ConArray
Jika PrimitiveUrl="" atau ConsultUrl="" atau PrimitiveUrl="$False$" atau ConsultUrl="$False$" Lalu
PastiUrl="$Salah$"
Fungsi Keluar
Akhiri Jika
Jika Kiri(Lcase(ConsultUrl),7)<>"http://" Lalu
KonsultasikanUrl= "http://" & KonsultasikanUrl
Akhiri Jika
ConsultUrl=Ganti(KonsultasikanUrl,"/","/")
ConsultUrl=Ganti(KonsultasikanUrl,"://","://")
PrimitiveUrl=Ganti(PrimitiveUrl,"/","/")
Jika Benar(ConsultUrl,1)<>"/" Lalu
Jika Instr(ConsultUrl,"/")>0 Lalu
Jika Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,"/")),".")>0 maka
Kalau tidak
ConsultUrl=KonsultasikanUrl & "/"
Akhiri Jika
Kalau tidak
ConsultUrl=KonsultasikanUrl & "/"
Akhiri Jika
Akhiri Jika
ConArray=Split(KonsultasikanUrl,"/")
Jika Kiri(LCase(PrimitiveUrl),7) = "http://" maka
DefiniteUrl=Ganti(PrimitiveUrl,"://","://")
ElseIf Left(PrimitiveUrl,1) = "/" Lalu
DefiniteUrl=ConArray(0) & PrimitiveUrl
ElseIf Left(PrimitiveUrl,2)="./" Lalu
PrimitiveUrl=Kanan(PrimitiveUrl,Len(PrimitiveUrl)-2)
Jika Benar(ConsultUrl,1)="/" Lalu
DefiniteUrl=KonsultasikanUrl & PrimitiveUrl
Kalau tidak
DefiniteUrl=Kiri(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
Akhiri Jika
ElseIf Left(PrimitiveUrl,3)="../" lalu
Lakukan Sementara Kiri(PrimitiveUrl,3)="../"
PrimitiveUrl=Kanan(PrimitiveUrl,Len(PrimitiveUrl)-3)
Pi=Pi+1
Lingkaran
Untuk Ci=0 hingga (Ubound(ConArray)-1-Pi)
Jika DefiniteUrl<>"" Lalu
DefiniteUrl=Url Pasti & "/" & ConArray(Ci)
Kalau tidak
Url Pasti=ConArray(Ci)
Akhiri Jika
Berikutnya
DefiniteUrl=Url Pasti & "/" & Url Primitif
Kalau tidak
Jika Instr(PrimitiveUrl,"/")>0 Lalu
PriArray=Pisahkan(Url Primitif,"/")
Jika Instr(PriArray(0),".")>0 Lalu
Jika Benar(PrimitiveUrl,1)="/" Lalu
DefiniteUrl="http://" & PrimitiveUrl
Kalau tidak
Jika Instr(PriArray(Ubound(PriArray)-1),".")>0 Lalu
DefiniteUrl="http://" & PrimitiveUrl
Kalau tidak
DefiniteUrl="http://" & PrimitiveUrl & "/"
Akhiri Jika
Akhiri Jika
Kalau tidak
Jika Benar(ConsultUrl,1)="/" Lalu
DefiniteUrl=KonsultasikanUrl & PrimitiveUrl
Kalau tidak
DefiniteUrl=Kiri(ConsultUrl,InstrRev(ConsultUrl,"/")) & PrimitiveUrl
Akhiri Jika
Akhiri Jika
Kalau tidak
Jika Instr(PrimitiveUrl,".")>0 Lalu
Jika Benar(ConsultUrl,1)="/" Lalu
Jika benar(LCase(PrimitiveUrl),3)=".cn" atau kanan(LCase(PrimitiveUrl),3)="com" atau kanan(LCase(PrimitiveUrl),3)="net" atau kanan(LCase(PrimitiveUrl) ,3)="org" Lalu
DefiniteUrl="http://" & PrimitiveUrl & "/"
Kalau tidak
DefiniteUrl=KonsultasikanUrl & PrimitiveUrl
Akhiri Jika
Kalau tidak
Jika benar(LCase(PrimitiveUrl),3)=".cn" atau kanan(LCase(PrimitiveUrl),3)="com" atau kanan(LCase(PrimitiveUrl),3)="net" atau kanan(LCase(PrimitiveUrl) ,3)="org" Lalu
DefiniteUrl="http://" & PrimitiveUrl & "/"
Kalau tidak
DefiniteUrl=Kiri(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl
Akhiri Jika
Akhiri Jika
Kalau tidak
Jika Benar(ConsultUrl,1)="/" Lalu
DefiniteUrl=KonsultasikanUrl & PrimitiveUrl & "/"
Kalau tidak
DefiniteUrl=Kiri(ConsultUrl,InstrRev(ConsultUrl,"/")) & "/" & PrimitiveUrl & "/"
Akhiri Jika
Akhiri Jika
Akhiri Jika
Akhiri Jika
Jika Kiri(DefiniteUrl,1)="/" maka
DefiniteUrl=Kanan(DefiniteUrl,Len(DefiniteUrl)-1)
Berakhir jika
Jika DefiniteUrl<>"" Lalu
DefiniteUrl=Ganti(DefiniteUrl,"//","/")
DefiniteUrl=Ganti(DefiniteUrl,"://","://")
Kalau tidak
PastiUrl="$Salah$"
Akhiri Jika
Fungsi Akhir
' ===== = =
'Nama fungsi: GantiSimpanRemoteFile
'Fungsi: mengganti dan menyimpan gambar jarak jauh
'Parameter: ConStr ------ string yang akan diganti
'Parameter: SaveTf ------ Apakah akan menyimpan file, False tidak menyimpan, True menyimpan
'Parameter: TistUrl------ alamat halaman web saat ini
' ===== = =
Fungsi GantiSimpanRemoteFile(ConStr,InstallPath,strChannelDir,SaveTf,TistUrl)
Jika ConStr="$False$" atau ConStr="" atau InstallPath="" atau strChannelDir="" Lalu
GantiSimpanRemoteFile=ConStr
Fungsi Keluar
Akhiri Jika
Redupkan TempStr,TempStr2,TempStr3,Re,Cocok,Cocok,Tempi,TempArray,TempArray2
Setel Re = Regexp Baru
Re.IgnoreCase = Benar
Re.Global = Benar
Re.Pola ="<img.+?>"
Tetapkan Kecocokan =Re.Execute(ConStr)
Untuk Setiap Pertandingan dalam Pertandingan
Jika TempStr<>"" maka
TempStr=TempStr & "$Array$" & Cocok.Nilai
Kalau tidak
TempStr=Cocok.Nilai
Berakhir jika
Berikutnya
Jika TempStr<>"" Lalu
TempArray=Pisahkan(TempStr,"$Array$")
SuhuStr=""
Untuk Tempi=0 Ke Ubound(TempArray)
Re.Pattern ="src/s*=/s*.+?/.(gifjpgbmpjpegpsdpngsvgdxfwmftiff)"
Tetapkan Kecocokan =Re.Execute(TempArray(Tempi))
Untuk Setiap Pertandingan dalam Pertandingan
Jika TempStr<>"" maka
TempStr=TempStr & "$Array$" & Cocok.Nilai
Kalau tidak
TempStr=Cocok.Nilai
Berakhir jika
Berikutnya
Berikutnya
Berakhir jika
Jika TempStr<>"" Lalu
Re.Pola = "src/s*=/s*"
TempStr=Re.Ganti(TempStr,"")
Akhiri Jika
Tetapkan Kecocokan=tidak ada
Tetapkan Re=tidak ada
Jika TempStr="" atau IsNull(TempStr)=Benar Maka
GantiSimpanRemoteFile=ConStr
Fungsi keluar
Berakhir jika
TempStr=Ganti(TempStr,"""","")
TempStr=Ganti(TempStr,"'","")
TempStr=Ganti(TempStr," ","")
Redupkan RemoteFileurl,SavePath,PathTemp,DtNow,strFileName,strFileType,ArrSaveFileName,RanNum,Arr_Path
DtSekarang=Sekarang()
'************************************
Jika SaveTf=Benar maka
SavePath=InstallPath&strChannelDir
Jika CheckDir(InstallPath & strChannelDir)=False Maka
Jika Tidak CreateMultiFolder(InstallPath & strChannelDir) Lalu
respon.Tulis InstallPath & strChannelDir&"Pembuatan direktori gagal"
SaveTf=Salah
Akhiri Jika
Akhiri Jika
Akhiri Jika
'Mulailah dengan menghapus gambar duplikat
TempArray=Pisahkan(TempStr,"$Array$")
SuhuStr=""
Untuk Tempi=0 Ke Ubound(TempArray)
Jika Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 Maka
TempStr=TempStr & "$Array$" & TempArray(Tempi)
Akhiri Jika
Berikutnya
TempStr=Kanan(TempStr,Len(TempStr)-7)
TempArray=Pisahkan(TempStr,"$Array$")
'Hapus gambar duplikat dan akhiri
respon.Tulis "<br>Gambar ditemukan:<br>"&Replace(TempStr,"$Array$","<br>")
'Mulai mengonversi alamat gambar relatif
SuhuStr=""
Untuk Tempi=0 Ke Ubound(TempArray)
TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)
Berikutnya
TempStr=Kanan(TempStr,Len(TempStr)-7)
TempStr=Ganti(TempStr,Chr(0),"")
TempArray2=Pisahkan(TempStr,"$Array$")
SuhuStr=""
'Akhir dari konversi alamat gambar relatif
'Penggantian/simpan gambar
Setel Re = Regexp Baru
Re.IgnoreCase = Benar
Re.Global = Benar
Untuk Tempi=0 Ke Ubound(TempArray2)
'***************************************
RemoteFileUrl=TempArray2(Tempi)
Jika RemoteFileUrl<>"$False$" Dan SaveTf=True Maka Simpan gambarnya
ArrSaveFileName = Pisahkan(RemoteFileurl,.")
strFileType=Lcase(ArrSaveFileName(Ubound(ArrSaveFileName)))'Jenis file
Jika strFileType='asp' atau strFileType='asa' atau strFileType='aspx' atau strFileType='cer' atau strFileType='cdx' atau strFileType='exe' atau strFileType='rar' atau strFileType='zip' maka
Unggah File = ""
GantiSimpanRemoteFile=ConStr
Fungsi Keluar
Akhiri Jika
Acak
RanNum=Int(900*Rnd)+100
strFileName = tahun(DtNow) & kanan("0" & bulan(DtNow),2) & kanan("0" & hari(DtNow),2) & kanan("0" & jam(DtNow ),2) & kanan ("0" & menit(DtNow),2) & kanan("0" & detik(DtNow),2) & ranNum & "." & strFileType
Re.Pola =TempArray(Tempi)
respon.Tulis "<br>Simpan ke alamat lokal:"&InstallPath & strChannelDir & strFileName
Jika SaveRemoteFile(InstallPath & strChannelDir & strFileName,RemoteFileUrl,RemoteFileUrl)=Benar Maka
respon.Tulis "<font color=blue>Sukses</font><br>"
PathTemp=InstallPath & strChannelDir & strFileName
ConStr=Re.Ganti(ConStr,PathTemp)
Re.Pattern=InstallPath&strChannelDir
UploadFiles=UploadFiles & "" & InstallPath & strChannelDir & strFileName
Kalau tidak
PathTemp=RemoteFileUrl
ConStr=Re.Ganti(ConStr,PathTemp)
Akhiri Jika
ElseIf RemoteFileurl<>"$False$" dan SaveTf=False Maka'Jangan simpan gambar
Re.Pola =TempArray(Tempi)
ConStr=Re.Ganti(ConStr,RemoteFileUrl)
Akhiri Jika
'***************************************
Berikutnya
Tetapkan Re=tidak ada
GantiSimpanRemoteFile=ConStr
Fungsi akhir
' ===== = =
'Nama fungsi: GantiSwfFile
'Fungsi: mengurai jalur animasi
'Parameter: ConStr ------ string yang akan diganti
'Parameter: TistUrl------ alamat halaman web saat ini
' ===== = =
Fungsi GantiSwfFile(ConStr,TistUrl)
Jika ConStr="$False$" atau ConStr="" atau TistUrl="" atau TistUrl="$False$" Maka
GantiSwfFile=ConStr
Fungsi Keluar
Akhiri Jika
Redupkan TempStr,TempStr2,TempStr3,Re,Cocok,Cocok,Tempi,TempArray,TempArray2
Setel Re = Regexp Baru
Re.IgnoreCase = Benar
Re.Global = Benar
Re.Pattern ="<objek.+?[^/>]>"
Tetapkan Kecocokan =Re.Execute(ConStr)
Untuk Setiap Pertandingan dalam Pertandingan
Jika TempStr<>"" maka
TempStr=TempStr & "$Array$" & Cocok.Nilai
Kalau tidak
TempStr=Cocok.Nilai
Berakhir jika
Berikutnya
Jika TempStr<>"" Lalu
TempArray=Pisahkan(TempStr,"$Array$")
SuhuStr=""
Untuk Tempi=0 Ke Ubound(TempArray)
Re.Pattern = "nilai/s*=/s*.+?/.swf"
Tetapkan Kecocokan =Re.Execute(TempArray(Tempi))
Untuk Setiap Pertandingan dalam Pertandingan
Jika TempStr<>"" maka
TempStr=TempStr & "$Array$" & Cocok.Nilai
Kalau tidak
TempStr=Cocok.Nilai
Berakhir jika
Berikutnya
Berikutnya
Berakhir jika
Jika TempStr<>"" Lalu
Re.Pola = "nilai/s*=/s*"
TempStr=Re.Ganti(TempStr,"")
Akhiri Jika
Jika TempStr="" atau IsNull(TempStr)=Benar Maka
GantiSwfFile=ConStr
Fungsi keluar
Berakhir jika
TempStr=Ganti(TempStr,"""","")
TempStr=Ganti(TempStr,"'","")
TempStr=Ganti(TempStr," ","")
Tetapkan Kecocokan=tidak ada
Tetapkan Re=tidak ada
'Mulailah dengan menghapus file duplikat
TempArray=Pisahkan(TempStr,"$Array$")
SuhuStr=""
Untuk Tempi=0 Ke Ubound(TempArray)
Jika Instr(Lcase(TempStr),Lcase(TempArray(Tempi)))<1 Maka
TempStr=TempStr & "$Array$" & TempArray(Tempi)
Akhiri Jika
Berikutnya
TempStr=Kanan(TempStr,Len(TempStr)-7)
TempArray=Pisahkan(TempStr,"$Array$")
'Hapus file duplikat dan akhiri
'Mulai konversi alamat relatif
SuhuStr=""
Untuk Tempi=0 Ke Ubound(TempArray)
TempStr=TempStr & "$Array$" & DefiniteUrl(TempArray(Tempi),TistUrl)
Berikutnya
TempStr=Kanan(TempStr,Len(TempStr)-7)
TempStr=Ganti(TempStr,Chr(0),"")
TempArray2=Pisahkan(TempStr,"$Array$")
SuhuStr=""
'Akhir dari konversi alamat relatif
'mengganti
Setel Re = Regexp Baru
Re.IgnoreCase = Benar
Re.Global = Benar
Untuk Tempi=0 Ke Ubound(TempArray2)
RemoteFileUrl=TempArray2(Tempi)
Re.Pola =TempArray(Tempi)
ConStr=Re.Ganti(ConStr,RemoteFileUrl)
Berikutnya
Tetapkan Re=tidak ada
GantiSwfFile=ConStr
Fungsi akhir
' ===== = =
'Nama proses: SaveRemoteFile
'Fungsi: menyimpan file jarak jauh ke lokal
'Parameter: LocalFileName ------ nama file lokal
'Parameter: RemoteFileUrl ------ URL file jarak jauh
'Parameter: Referer ------ File panggilan jarak jauh (untuk anti-koleksi, gunakan alamat halaman konten, biarkan kosong jika tidak ada anti-koleksi)
' ===== = =
Fungsi SaveRemoteFile(LocalFileName,RemoteFileUrl,Referer)
SaveRemoteFile=Benar
redupkan Iklan, Pengambilan, GetRemoteData
Setel Pengambilan = Server.CreateObject("Microsoft.XMLHTTP")
Dengan Pengambilan
.Buka "Dapatkan", RemoteFileUrl, Salah, "", ""
jika Referer<>"" maka .setRequestHeader "Referer",Referer
.Mengirim
Jika .Readystate<>4 maka
SaveRemoteFile=Salah
Fungsi Keluar
Akhiri Jika
GetRemoteData = .ResponseBody
Akhiri Dengan
Setel Pengambilan = Tidak Ada
Setel Iklan = Server.CreateObject("Adodb.Stream")
Dengan Iklan
.Jenis = 1
.Membuka
.Tulis GetRemoteData
Server .SaveToFile.MapPath(NamaFile Lokal),2
.Membatalkan()
.Menutup()
Akhiri Dengan
Setel Iklan=tidak ada
Fungsi akhir
' ===== = =
'Nama fungsi: GetPaing
'Fungsi: Dapatkan penomoran halaman
' ===== = =
Fungsi GetPaing(Byval ConStr,StartStr,OverStr,IncluL,IncluR)
Jika ConStr="$False$" atau ConStr="" Atau StartStr="" Atau OverStr="" atau IsNull(ConStr)=True atau IsNull(StartStr)=Benar Atau IsNull(OverStr)=True Maka
DapatkanPaing="$Salah$"
Fungsi Keluar
Akhiri Jika
Redupkan Mulai, Selesai, ConTemp, TempStr
SuhuStr=LCase(ConStr)
MulaiStr=LCase(MulaiStr)
OverStr=LCase(OverStr)
Atas=Instr(1,TempStr,OverStr)
Jika Lebih<=0 Lalu
DapatkanPaing="$Salah$"
Fungsi Keluar
Kalau tidak
Jika InclR=Benar Maka
Atas=Atas+Len(AtasStr)
Akhiri Jika
Akhiri Jika
TempStr=Tengah(TempStr,1,Atas)
Mulai=InstrRev(TempStr,StartStr)
Jika Termasuk = Salah Maka
Mulai=Mulai+Len(StartStr)
Akhiri Jika
Jika Mulai<=0 Atau Mulai>=Selesai Kemudian
DapatkanPaing="$Salah$"
Fungsi Keluar
Akhiri Jika
ConTemp=Mid(ConStr,Start,Over-Start)
ConTemp=Trim(ConTemp)
'ConTemp=Ganti(ConTemp," ","")
ConTemp=Ganti(ConTemp,","")
ConTemp=Ganti(ConTemp,"'","")
ConTemp=Ganti(ConTemp,"""","")
ConTemp=Ganti(ConTemp,">","")
ConTemp=Ganti(ConTemp,"<","")
ConTemp=Ganti(ConTemp," ;","")
GetPaing=ConTemp
Fungsi Akhir
'***************************************************
'Nama fungsi: gotTopic
'Fungsi: memotong string, setiap karakter Cina dihitung sebagai dua karakter, dan karakter Inggris dihitung sebagai satu karakter
'Parameter: str ---- string asli
' strlen ---- panjang intersep
'Nilai kembalian: string yang dicegat
'***************************************************
fungsi gotTopic(str,strlen)
jika str = "" maka
mendapatTopik=""
fungsi keluar
berakhir jika
redup l,t,c,i
str=ganti(ganti(ganti(ganti(str," "," "),""",chr(34)),">",">"),"<","<")
aku=len(str)
t=0
untuk i=1 sampai l
c=Abs(Asc(Tengah(str,i,1)))
jika c>255 maka
t=t+2
kalau tidak
t=t+1
berakhir jika
jika t>=strlen maka
gotTopic=kiri(str,i) & "..."
keluar untuk
kalau tidak
mendapatTopik=str
berakhir jika
Berikutnya
gotTopic=ganti(ganti(ganti(ganti(gotTopic," "," "),chr(34),"""),">",">"),"<","<;")
fungsi akhir
'***************************************************
'Nama fungsi: JoinChar
'Fungsi: Tambahkan ? atau & ke alamat
'Parameter: strUrl ---- URL
'Nilai pengembalian: URL dengan ? atau & ditambahkan
'***************************************************
fungsi GabungChar(strUrl)
jika strUrl = "" maka
GabungChar=""
fungsi keluar
berakhir jika
jika InStr(strUrl,"?")<len(strUrl) lalu
jika InStr(strUrl,"?")>1 lalu
jika InStr(strUrl,"&")<len(strUrl) maka
GabungChar=strUrl & "&"
kalau tidak
GabungChar=strUrl
berakhir jika
kalau tidak
GabungChar=strUrl & "?"
berakhir jika
kalau tidak
GabungChar=strUrl
berakhir jika
fungsi akhir
'*******************************************************
'Nama fungsi: CreateKeyWord
'Fungsi: Menghasilkan kata kunci dari string yang diberikan
'Parameter: Constr---string asli untuk menghasilkan kata kunci
'Nilai pengembalian: kata kunci yang dihasilkan
'*******************************************************
Fungsi CreateKeyWord(byval Constr,Num)
Jika Constr="" atau IsNull(Constr)=Benar atau Constr="$False$" Maka
BuatKeyWord="$False$"
Fungsi Keluar
Akhiri Jika
Jika Num="" atau IsNumeric(Num)=False Maka
Jumlah = 2
Akhiri Jika
Constr=Ganti(Constr,CHR(32),"")
Constr=Ganti(Constr,CHR(9),"")
Constr=Ganti(Konstr," ","")
Constr=Ganti(Konstr," ","")
Constr=Ganti(Constr,"(","")
Constr=Ganti(Constr,"")","")
Constr=Ganti(Constr,"<","")
Constr=Ganti(Constr,">","")
Constr=Ganti(Constr,"""","")
Constr=Ganti(Konstr,"?","")
Constr=Ganti(Constr,"*","")
Constr=Ganti(Constr,"","")
Constr=Ganti(Constr,",","")
Constr=Ganti(Constr,".","")
Constr=Ganti(Constr,"/","")
Constr=Ganti(Constr,"/","")
Constr=Ganti(Constr,"-","")
Constr=Ganti(Constr,"@","")
Constr=Ganti(Constr,"#","")
Constr=Ganti(Constr,"$","")
Constr=Ganti(Constr,"%","")
Constr=Ganti(Konstr,"&","")
Constr=Ganti(Constr,"+","")
Constr=Ganti(Constr,":","")
Constr=Ganti(Constr,"：","")
Constr=Ganti(Constr,"'","")
Constr=Ganti(Konstr,""","")
Constr=Ganti(Konstr,""","")
Redupkan saya,ConstrTemp
Untuk i=1 Ke Len(Konstr)
ConstrTemp=ConstrTemp & "" & Tengah(Konstr,i,Bilangan)
Berikutnya
Jika Len(ConstrTemp)<254 Lalu
ConstrTemp=KonstrTemp & ""
Kalau tidak
ConstrTemp=Kiri(ConstrTemp,254) & ""
Akhiri Jika
CreateKeyWord=ConstrTemp
Fungsi Akhir
' ===== = =
'Nama fungsi: CheckUrl
'Fungsi: Periksa Url
'Parameter: strUrl ------ Untuk memeriksa Url
' ===== = =
Fungsi CheckUrl(strUrl)
Redupkan Ulang
Setel Re=RegExp baru
Re.IgnoreCase=benar
Re.Global=Benar
Re.Pattern="http://([/w-]+/.)+[/w-]+(/[/w-./?%&=]*)?"
Jika Re.test(strUrl)=Benar Maka
PeriksaUrl=strUrl
Kalau tidak
PeriksaUrl="$Salah$"
Akhiri Jika
Tetapkan Rs=Tidak Ada
Fungsi Akhir
' ===== = =
'Nama fungsi: ScriptHtml
'Fungsi: memfilter tag html
'Parameter: ConStr ------ String yang akan difilter
' ===== = =
Fungsi ScriptHtml(Byval ConStr,TagName,FType)
Redupkan Ulang
Setel Re=RegExp baru
Re.IgnoreCase=benar
Re.Global=Benar
Pilih Kasus FType
Kasus 1
Re.Pattern="<" & Nama Tag & "([^>])*>"
ConStr=Re.Ganti(ConStr,"")
Kasus 2
Re.Pattern="<" & Nama Tag & "([^>])*>.*?</" & Nama Tag & "([^>])*>"
ConStr=Re.Ganti(ConStr,"")
Kasus 3
Re.Pattern="<" & Nama Tag & "([^>])*>"
ConStr=Re.Ganti(ConStr,"")
Re.Pattern="</" & Nama Tag & "([^>])*>"
ConStr=Re.Ganti(ConStr,"")
Pilihan Akhir
ScriptHtml=KontraStr
Tetapkan Re=Tidak Ada
Fungsi Akhir
' ===== = =
'Nama fungsi: HapusHTML
'Fungsi: Hapus tag html sepenuhnya
'Parameter: strHTML ------ String yang akan difilter
' ===== = =
Fungsi HapusHTML(strHTML)
Redupkan objRegExp, Cocok, Cocok
Setel objRegExp = Regexp Baru
objRegExp.IgnoreCase = Benar
objRegExp.Global = Benar
'Tutup <>
objRegExp.Pattern = "<.+?>"
'Cocok
Setel Kecocokan = objRegExp.Execute(strHTML)
' Lintasi set yang cocok dan ganti item yang cocok
Untuk Setiap Pertandingan dalam Pertandingan
strHtml=Ganti(strHTML,Match.Value,"")
Berikutnya
HapusHTML=strHTML
Setel objRegExp = Tidak Ada
Fungsi Akhir
' ===== = =
'Nama fungsi: CheckDir
'Fungsi: Periksa apakah folder tersebut ada
'Parameter: FolderPath ------ jalur folder
' ===== = =
Fungsi CheckDir (byval FolderPath)
redupkan
Setel fso = Server.CreateObject("Scripting.FileSystemObject")
Jika fso.FolderExists(Server.MapPath(folderpath)) maka
'ada
CheckDir = Benar
Kalau tidak
'tidak ada
CheckDir = Salah
Berakhir jika
Tetapkan fso = tidak ada
Fungsi Akhir
' ===== = =
'Nama fungsi: MakeNewsDir
'Fungsi: Membuat folder
'Parameter: nama folder ------ nama folder
' ===== = =
Fungsi MakeNewsDir (nama folder byval)
redupkan
Setel fso = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
fso.CreateFolder(Server.MapPath(nama folder))
Jika fso.FolderExists(Server.MapPath(nama folder)) Lalu
MakeNewsDir = Benar
Kalau tidak
MakeNewsDir = Salah
Akhiri Jika
Tetapkan fso = tidak ada
Fungsi Akhir
' ===== = =
'Nama fungsi: DelDir
'Fungsi: Membuat folder
'Parameter: nama folder ------ nama folder
' ===== = =
Fungsi DelDir (nama folder byval)
redupkan
Setel fso = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
Jika fso.FolderExists(Server.MapPath(nama folder)) Lalu 'Tentukan apakah folder tersebut ada
fso.DeleteFolder (Server.MapPath(nama folder)) 'Hapus folder
Akhiri Jika
Tetapkan fso = tidak ada
Fungsi Akhir
'*******************************************************
'Nama fungsi: IsObjInstalled
'Fungsi : Mengecek apakah komponen sudah terpasang
'Parameter: strClassString ---- nama komponen
'Nilai pengembalian: Benar ---- Sudah diinstal
' Salah ---- tidak diinstal
'*******************************************************
Fungsi IsObjInstalled(strClassString)
IsObjInstalled = Salah
Salah = 0
DimxTestObj
Setel xTestObj = Server.CreateObject(strClassString)
Jika 0 = Err Maka IsObjInstalled = Benar
Setel xTestObj = Tidak Ada
Salah = 0
Fungsi Akhir
'*******************************************************
'Nama fungsi: strLength
'Fungsi: Menemukan panjang string. Karakter Cina dihitung sebagai dua karakter, dan karakter Inggris dihitung sebagai satu karakter.
'Parameter: str ---- String dengan panjang yang dibutuhkan
'Nilai kembalian: panjang string
'*******************************************************
fungsi strPanjang(str)
PADA EROR RESUME BERIKUTNYA
redupkan WINNT_CHINESE
WINNT_CHINESE = (len("Tiongkok")=2)
jika WINNT_CHINESE maka
redup l,t,c
redupkan aku
aku=len(str)
t=l
untuk i=1 sampai l
c=asc(tengah(str,i,1))
jika c<0 maka c=c+65536
jika c>255 maka
t=t+1
berakhir jika
Berikutnya
strPanjang=t
kalau tidak
strPanjang=len(str)
berakhir jika
jika err.number<>0 maka err.clear
fungsi akhir
'******************************************************* **
'Nama fungsi: Buat MultiFolder
'Fungsi: Membuat direktori multi-level, Anda dapat membuat direktori root yang tidak ada
'Parameter: nama direktori yang akan dibuat, bisa bertingkat
'Kembalikan nilai logis: Benar jika berhasil, Salah jika gagal
'Buat direktori root dari direktori mulai dari direktori saat ini
'******************************************************* **
Fungsi BuatMultiFolder(ByVal CFolder)
Redupkan objFSO,PhCreateFolder,CreateFolderArray,CreateFolder
Redupkan i,ii,CreateFolderSub,PhCreateFolderSub,BlInfo
BlInfo=Salah
BuatFolder = CFolder
Pada Kesalahan Lanjutkan Berikutnya
Setel objFSO = Server.CreateObject("Scri" & "pti" & "ng.Fil" & "eSyst" & "emOb" & "ject")
Jika Salah Lalu
Err.Hapus()
Fungsi Keluar
Akhiri Jika
CreateFolder = Ganti(CreateFolder,"/","/")
Jika Kiri(CreateFolder,1)="/" Lalu
'BuatFolder = Kanan(BuatFolder,Len(BuatFolder)-1)
Akhiri Jika
Jika Benar(CreateFolder,1)="/" Lalu
CreateFolder = Kiri(CreateFolder,Len(CreateFolder)-1)
Akhiri Jika
CreateFolderArray = Pisahkan(CreateFolder,"/")
Untuk i = 0 hingga UBound(CreateFolderArray)
BuatFolderSub = ""
Untuk ii = 0 sampai i
CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/"
Berikutnya
PhCreateFolderSub = Server.MapPath(CreateFolderSub)
'response.Tulis PhCreateFolderSub&"<br>"
Jika Bukan objFSO.FolderExists(PhCreateFolderSub) Lalu
objFSO.CreateFolder(PhCreateFolderSub)
Akhiri Jika
Berikutnya
Jika Salah Lalu
Err.Hapus()
Kalau tidak
BlInfo=Benar
Akhiri Jika
Setel objFSO=tidak ada
BuatMultiFolder = BlInfo
Fungsi Akhir
'*******************************************************
'Nama fungsi: FSOFileRead
'Fungsi: Gunakan FSO untuk membaca fungsi konten file
'Parameter: nama file ---- nama file
'Nilai pengembalian: konten file
'*******************************************************
fungsi FSOFileRead (nama file)
Redupkan objFSO,objCountFile,FiletempData
Setel objFSO = Server.CreateObject("Scripting.FileSystemObject")
Setel objCountFile = objFSO.OpenTextFile(Server.MapPath(nama file),1,True)
FSOFileRead = objCountFile.ReadAll
objCountFile.Tutup
Setel objCountFile=Tidak Ada
Setel objFSO = Tidak Ada
Fungsi Akhir
'*******************************************************
'Nama fungsi: FSOlineedit
'Fungsi: Gunakan FSO untuk membaca baris tertentu dari fungsi file
'Parameter: nama file ---- nama file
' lineNum ---- nomor baris
'Nilai kembalian: isi baris dalam file
'*******************************************************
fungsi FSOlineedit(nama file,Nomor baris)
jika linenum <1 maka keluar dari fungsi
redupkan fso,f,temparray,tempcnt
set fso = server.CreateObject("scripting.filesystemobject")
jika tidak fso.fileExists(server.mappath(nama file)) maka keluar dari fungsi
set f = fso.opentextfile(server.mappath(nama file),1)
jika bukan f.AtEndofStream maka
tempcnt = f.baca semua
f.tutup
atur f = tidak ada
temparray = split(tempcnt,chr(13)&chr(10))
jika lineNum>ubound(temparray)+1 maka
fungsi keluar
kalau tidak
FSOlineedit = temparray(barisNum-1)
berakhir jika
berakhir jika
fungsi akhir
'*******************************************************
'Nama fungsi: FSOlinewrite
'Fungsi: Gunakan FSO untuk menulis baris tertentu dari fungsi file
'Parameter: nama file ---- nama file
' lineNum ---- nomor baris
' Konten baris ---- konten
'Nilai pengembalian: Tidak ada
'*******************************************************
fungsi FSOlinewrite (nama file, LineNum, Linecontent)
jika linenum <1 maka keluar dari fungsi
redupkan fso,f,temparray,tempCnt
set fso = server.CreateObject("scripting.filesystemobject")
jika tidak fso.fileExists(server.mappath(nama file)) maka keluar dari fungsi
set f = fso.opentextfile(server.mappath(nama file),1)
jika bukan f.AtEndofStream maka
tempcnt = f.baca semua
f.tutup
temparray = split(tempcnt,chr(13)&chr(10))
jika lineNum>ubound(temparray)+1 maka
fungsi keluar
kalau tidak
temparray(lineNum-1) = konten baris
berakhir jika
tempcnt = gabung(temparray,chr(13)&chr(10))
set f = fso.createtextfile(server.mappath(nama file),true)
f.writetempcnt
berakhir jika
f.tutup
atur f = tidak ada
fungsi akhir
'*******************************************************
'Nama fungsi: Htmlmake
'Fungsi: Gunakan FSO untuk membuat file
'Parameter: HtmlFolder ---- jalur
' HtmlNama File ---- nama file
'HtmlKonten ---- Konten
'*******************************************************
fungsi Htmlmake(HtmlFolder,HtmlFilename,HtmlContent)
Pada Kesalahan Lanjutkan Berikutnya
jalur file redup, fso, fout
jalur file = HtmlFolder&"/"&HtmlFilename
Setel fso = Server.CreateObject("Scripting.FileSystemObject")
Jika fso.FolderExists(HtmlFolder) Lalu
Kalau tidak
Buat MultiFolder (HtmlFolder)
&, ;nbs, p; Berakhir Jika
Setel fout = fso.Createtextfile(server.mappath(filepath),true)
fout.writeline HtmlContent
fut.close
atur fso=tidak ada
Setel fso = Server.CreateObject("Scripting.FileSystemObject")
Jika fso.fileexists(Server.MapPath(filepath)) Lalu
Response.Tulis "File<font color=red>"&HtmlFilename&"</font> telah dibuat!<br>"
Kalau tidak
'Respon.Tulis Server.MapPath(jalur file)
Response.Tulis "File<font color=red>"&HtmlFilename&"</font> tidak dibuat!<br>"
Akhiri Jika
Tetapkan fso = tidak ada
Fungsi akhir
'*******************************************************
'Nama fungsi: Htmldel
'Fungsi: Gunakan FSO untuk menghapus file
'Parameter: HtmlFolder ---- jalur
' HtmlNama File ---- nama file
'*******************************************************
Sub Htmldel(HtmlFolder,HtmlNamaFile)
jalur file redup, jika tidak
jalur file = HtmlFolder&"/"&HtmlFilename
Setel fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(Server.mappath(jalur file))
Tetapkan fso = tidak ada
Setel fso = Server.CreateObject("Scripting.FileSystemObject")
Jika fso.fileexists(Server.MapPath(filepath)) Lalu
Response.Tulis "File<font color=red>"&HtmlFilename&"</font> tidak dihapus!<br>"
Kalau tidak
'Respon.Tulis Server.MapPath(jalur file)
Response.Tulis "File<font color=red>"&HtmlFilename&"</font> telah dihapus!<br>"
Akhiri Jika
Tetapkan fso = tidak ada
Akhiri Sub
' ===== =
'Nama proses: HTMLEncode
'Fungsi: memfilter format HTML
'Parameter: fString ---- Konten konversi
' ===== =
fungsi HTMLEncode(ByVal fString)
Jika IsNull(fString)=False atau fString<>"" atau fString<>"$False$" Lalu
fString = Ganti(fString, ">", ">")
fString = Ganti(fString, "<", "<")
fString = Ganti(fString, Chr(32), " ")
fString = Ganti(fString, Chr(9), " ")
fString = Ganti(fString, Chr(34), """)
fString = Ganti(fString, Chr(39), "'")
fString = Ganti(fString, Chr(13), "")
fString = Ganti(fString, " ", " ")
fString = Ganti(fString, CHR(10) & CHR(10), "</P><P>")
fString = Ganti(fString, Chr(10), "<br /> ")
HTMLEncode = fString
kalau tidak
HTMLEncode = "$Salah$"
berakhir jika
fungsi akhir
' ===== =
'Nama proses: unHTMLEncode
'Fungsi: mengembalikan format HTML
'Parameter: fString ---- Konten konversi
' ===== =
fungsi unHTMLEncode(ByVal fString)
Jika IsNull(fString)=False atau fString<>"" atau fString<>"$False$" Lalu
fString = Ganti(fString, ">", ">")
fString = Ganti(fString, "<", "<")
fString = Ganti(fString, " ", Chr(32))
fString = Ganti(fString, """, Chr(34))
fString = Ganti(fString, "'", Chr(39))
fString = Ganti(fString, "", Chr(13))
fString = Ganti(fString, " ", " ")
fString = Ganti(fString, "</P><P>" , CHR(10) & CHR(10))
fString = Ganti(fString, "<br> ", Chr(10))
unHTMLEncode = fString
kalau tidak
unHTMLEncode = "$Salah$"
berakhir jika
fungsi akhir
fungsi unhtmllist(konten)
unhtmldaftar=konten
jika konten <> "" maka
unhtmldaftar=ganti(unhtmldaftar,"'","";")
unhtmldaftar=ganti(unhtmldaftar,chr(10),"")
unHtmllist=ganti(unHtmllist,chr(13),"<br>")
berakhir jika
fungsi akhir
fungsi unhtmldaftar(konten)
unhtmldaftar=konten
jika konten <> "" maka
unhtmldaftar=ganti(unhtmldaftar,"""","")
unhtmldaftar=ganti(unhtmldaftar,"'","")
unhtmllists=replace(unhtmllists,chr(10),"")
unHtmllists=ganti(unHtmllists,chr(13),"<br>")
berakhir jika
fungsi akhir
fungsi daftar html (konten)
htmldaftar=konten
jika konten <> "" maka
htmldaftar=ganti(htmldaftar,"''","""")
htmldaftar=ganti(htmldaftar,"","'")
htmldaftar=ganti(htmldaftar,"<br>",chr(13)&chr(10))
berakhir jika
fungsi akhir
fungsi daftar uhtml(konten)
uhtmldaftar=konten
jika konten <> "" maka
uhtlists=ganti(uhtlists,"""","''")
uhtlists=ganti(uhtlists,"'","";")
uhtlists=ganti(uhtlists,chr(10),"")
uHtmllists=ganti(uHtmllists,chr(13),"<br>")
berakhir jika
fungsi akhir
' ===== =
'Proses: Tidur
'Fungsi: Program berhenti di sini selama beberapa detik
'Parameter: iSeconds Jumlah detik untuk jeda
' ===== =
Sub Tidur (iSeconds)
respon.Tulis "<font color=blue>Mulai jeda selama "&iSeconds&" detik</font><br>"
Redupkan t:t=Timer()
While(Timer()<t+iSeconds)
'Jangan lakukan apa pun
Pergi ke
respon.Tulis "<font color=blue>Jeda"&iSeconds&" detik berakhir</font><br>"
Akhiri Sub
' ===== = =
'Nama fungsi: MyArray
'Fungsi: mengekstrak tag untuk dipisahkan
'Parameter: ConStr ------Ekstrak karakter asli alamat
' ===== = =
Fungsi MyArray(ByvalConStr)
Setel objRegExp = Regexp Baru
objRegExp.IgnoreCase = Benar
objRegExp.Global = Benar
objRegExp.Pattern = "({).+?(})"
Tetapkan Kecocokan =objRegExp.Execute(ConStr)
Untuk Setiap Pertandingan dalam Pertandingan
TempStr=TempStr & "" & Cocok.Nilai
Berikutnya
Tetapkan Kecocokan=tidak ada
TempStr=Kanan(TempStr,Len(TempStr)-1)
objRegExp.Pattern="{"
TempStr=objRegExp.Replace(TempStr,"")
objRegExp.Pattern="}"
TempStr=objRegExp.Replace(TempStr,"")
Setel objRegExp=tidak ada
Tetapkan Kecocokan=tidak ada
TempStr=Ganti(TempStr,"$","")
Jika TempStr="" maka
MyArray="Tidak ada yang perlu diekstrak dalam kode"
Kalau tidak
Array Saya=TempStr
Berakhir jika
Fungsi Akhir
' ===== = =
'Nama fungsi: acak
'Fungsi: Menghasilkan angka acak 6 digit
' ===== = =
Fungsi acak
mengacak
acak=Int((900000*rnd)+100000)
Fungsi Akhir
%>