Program ini mengurangi pembacaan database dengan menggunakan fungsionalitas FSO ASP. Setelah dilakukan pengujian, dapat mengurangi beban server hingga 90%. Kecepatan akses halaman pada dasarnya sama dengan halaman statis. Copy kode kodenya sebagai berikut:
<%@LANGUAGE=KODE VBSCRIPT=65001%>
<% Response.CodePage=65001%>
<% Respon.Charset=UTF-8 %>
<%
'Program ini mengurangi pembacaan database dengan menggunakan fungsionalitas FSO ASP. Setelah dilakukan pengujian, dapat mengurangi beban server hingga 90%. Kecepatan akses halaman pada dasarnya sama dengan halaman statis.
'Cara menggunakan: Tempatkan file di situs web, lalu gunakan include untuk mereferensikannya di baris pertama file yang perlu direferensikan.
'========Area parameter========== =====
DirName=cachenew/ 'Direktori tempat menyimpan file statis harus memiliki / di akhir. Tidak perlu membuatnya secara manual, program akan membuatnya secara otomatis.
TimeDelay=30 'Perbarui interval waktu, satuannya adalah menit, misalnya 1440 menit adalah 1 hari. File statis yang dihasilkan akan dihapus setelah interval ini.
'=======Area program utama========= ====
foxrax=Permintaan(foxrax)
jika foxrax = maka
Nama File=GetStr()&.txt
Nama File=NamaDir&NamaFile
if tesfold(DirName)=false maka'Buat foldernya jika tidak ada
buatfold(Server.MapPath(.)&/&DirName)
berakhir jika
if ReportFileStatus(Server.MapPath(.)&/&FileName)=true maka'Jika ada file statis yang dihasilkan, baca file tersebut secara langsung
Setel FSO=CreateObject(Scripting.FileSystemObject)
Redupkan File, LatCatch
Set Files=FSO.GetFile(Server.MapPath(FileName)) 'Tentukan objek file CatchFile
LastCatch=CDate(Files.DateLastModified)
Jika DateDiff(n,LastCatch,Now())>TimeDelay Then' terlampaui
Daftar=getHTTPHalaman(GetUrl())
TulisFile(Nama File)
Kalau tidak
Daftar=BacaFile(NamaFile)
Akhiri Jika
Tetapkan FSO = tidak ada
Respon.Tulis(Daftar)
Respon.Akhir()
kalau tidak
Daftar=getHTTPHalaman(GetUrl())
TulisFile (Nama File)
berakhir jika
berakhir jika
'=========Area fungsi========= = =====
'Dapatkan url halaman saat ini
Fungsi GetStr()
'Pada Kesalahan Lanjutkan Berikutnya
Redupkan strTemps
strTemps = strTemps & Permintaan.ServerVariables(HTTP_X_REWRITE_URL)
GetStr = Server.URLEncode(strTemps)
Fungsi Akhir
'Dapatkan url halaman yang di-cache
Fungsi DapatkanUrl()
Pada Kesalahan Lanjutkan Berikutnya
Redupkan strTemp
Jika LCase(Request.ServerVariables(HTTPS)) = mati Lalu
strTemp = http://
Kalau tidak
strTemp = https://
Akhiri Jika
strTemp = strTemp & Permintaan.ServerVariables(SERVER_NAME)
Jika Request.ServerVariables(SERVER_PORT) <> 80 Lalu
strTemp = strTemp & : & Permintaan.ServerVariables(SERVER_PORT)
berakhir jika
strTemp = strTemp & Permintaan.ServerVariables(URL)
Jika Memangkas(Request.QueryString) <> Lalu
strTemp = strTemp & ? & Pangkas(Permintaan.QueryString) & &foxrax=foxrax
kalau tidak
strTemp = strTemp & ?
berakhir jika
DapatkanUrl = strTemp
Fungsi Akhir
'Tangkap halamannya
Fungsi getHTTPHalaman(url)
Setel Mail1 = Server.CreateObject(CDO.Pesan)
Mail1.Buat URL Badan MHTML,31
AA=Mail1.HTMLBody
Setel Mail1 = Tidak Ada
dapatkanHalaman HTTP=AA
'Atur Pengambilan = Server.CreateObject(Microsoft.Xmlhttp)
'Pengambilan.Buka GET,url,false,,
'Pengambilan.Kirim
'getHTTPPage = Pengambilan.ResponseBody
'Atur Pengambilan = Tidak Ada
Fungsi Akhir
SubTulisFile(Jalur File)
stm redup
setel stm=Server.CreateObject(adodb.stream)
stm.Type=2 'adTypeText, data teks
stm.Mode=3 'adModeReadWrite, baca dan tulis, jika parameter ini 2, kesalahan akan dilaporkan
stm.Charset=utf-8
stm.Buka
stm.Daftar WriteText
stm.SaveToFile Server.MapPath(filePath),2 'adSaveCreateOverWrite, timpa jika file ada
stm.Siram
stm.Tutup
atur stm=tidak ada
Akhiri Sub
Fungsi ReadFile(jalur file)
stm redup
setel stm=Server.CreateObject(adodb.stream)
stm.Type=1 'adTypeBinary, baca dalam data biner
stm.Mode=3 'adModeReadWrite, hanya 3 yang dapat digunakan di sini, yang lain akan menyebabkan kesalahan
stm.Buka
stm.LoadFromFile Server.MapPath(filePath)
stm.Position=0 'Pindahkan penunjuk kembali ke titik awal
stm.Type=2 'Data teks
stm.Charset=utf-8
ReadFile = stm.BacaTeks
stm.Tutup
atur stm=tidak ada
Fungsi Akhir
'Periksa apakah file itu ada
Fungsi ReportFileStatus (Nama File)
set fso = server.createobject(scripting.filesystemobject)
jika fso.fileexists(FileName) = true maka
ReportFileStatus=benar
kalau tidak
ReportFileStatus=salah
berakhir jika
atur fso=tidak ada
fungsi akhir
'Periksa apakah direktori itu ada
fungsi tesfold(nama nama)
set fs=buat objek(scripting.filesystemobject)
filepathjm=server.mappath(namafon)
jika fs.folderexists(filepathjm) maka
tesfold=Benar
kalau tidak
tesfold=Salah
berakhir jika
atur fs=tidak ada
fungsi akhir
'Buat direktori
subbuat lipat(nama fom)
set fs=buat objek(scripting.filesystemobject)
fs.createfolder (nama nama)
atur fs=tidak ada
sub akhir
'Hapus file
function del_file(path) 'path, path file berisi nama file
setel objfso = server.createobject(scripting.FileSystemObject)
'jalur=Server.MapPath(jalur)
if objfso.FileExists(path) lalu 'Jika ada, hapus
objfso.DeleteFile(jalur) 'Hapus file
kalau tidak
'response.write <script bahasa='Javascript'>alert('File tidak ada')</script>
berakhir jika
setel objfso = tidak ada
fungsi akhir
%>