Fungsi ini dapat digunakan pada saat pengumpulan atau saat menambahkan artikel secara online.
Kode yang saya cari di Baidu untuk menyimpan gambar jarak jauh ke area lokal sepertinya agak sulit digunakan, dan tidak ada kode siap pakai dan lengkap yang tidak dapat saya pahami.
Saya mengekstrak beberapa fungsi dari sistem pengumpulan berita SNA For 3.62 (diprogram oleh: ansir) dan menggunakannya, yang relatif sederhana dan mudah digunakan.
Berikut fungsinya
kode program
Copy kode kodenya sebagai berikut:
<%
' ===== = =
'Nama fungsi: CheckDir2
'Fungsi: Periksa apakah folder tersebut ada
'Parameter: FolderPath ------alamat folder
' ===== = =
Fungsi CheckDir2 (byval FolderPath)
redupkan
jalur folder=Server.MapPath(.)&/&jalur folder
Setel fso = Server.CreateObject(Scripting.FileSystemObject)
Jika fso.FolderExists(FolderPath) maka
'ada
CheckDir2 = Benar
Kalau tidak
'tidak ada
CheckDir2 = Salah
Berakhir jika
Tetapkan fso = tidak ada
Fungsi Akhir
' ===== = =
'Nama fungsi: MakeNewsDir2
'Fungsi: Membuat folder baru
'Parameter: nama folder ------ nama folder
' ===== = =
Fungsi MakeNewsDir2 (nama folder byval)
redupkan
Setel fso = Server.CreateObject(Scripting.FileSystemObject)
fso.CreateFolder(Server.MapPath(.) &/ &nama folder)
Jika fso.FolderExists(Server.MapPath(.) &/ &namafolder) Lalu
MakeNewsDir2 = Benar
Kalau tidak
MakeNewsDir2 = Salah
Akhiri Jika
Tetapkan fso = tidak ada
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$ Lalu
Url Pasti=$Salah$
Fungsi Keluar
Akhiri Jika
Jika Kiri(ConsultUrl,7)<>HTTP:// Dan Kiri(ConsultUrl,7)<>http:// Lalu
KonsultasikanUrl= http:// & KonsultasikanUrl
Akhiri Jika
ConsultUrl=Ganti(KonsultasikanUrl,://,://)
Jika Benar(KonsultasikanUrl,1)<>/ Lalu
Jika Instr(ConsultUrl,/)>0 Lalu
Jika Instr(Kanan(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(PrimitiveUrl,7) = http:// lalu
DefiniteUrl=Ganti(Url Primitif,://,://)
ElseIf Left(PrimitiveUrl,1) = / Lalu
DefiniteUrl=ConArray(0) & PrimitiveUrl
ElseIf Left(PrimitiveUrl,2)=./ Kemudian
DefiniteUrl=ConArray(0) & Kanan(PrimitiveUrl,Len(PrimitiveUrl)-1)
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=DefiniteUrl & / & 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)=/ Kemudian
DefiniteUrl=http:// & PrimitiveUrl
Kalau tidak
Jika Instr(PriArray(Ubound(PriArray)-1),.)>0 Lalu
DefiniteUrl=http:// & PrimitiveUrl
Kalau tidak
Url Pasti=http:// & Url Primitif & /
Akhiri Jika
Akhiri Jika
Kalau tidak
Jika Benar(KonsultasikanUrl,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(KonsultasikanUrl,1)=/ Lalu
Jika kanan(PrimitiveUrl,3)=.cn atau kanan(PrimitiveUrl,3)=com atau kanan(PrimitiveUrl,3)=net atau kanan(PrimitiveUrl,3)=org Kemudian
Url Pasti=http:// & Url Primitif & /
Kalau tidak
DefiniteUrl=KonsultasikanUrl & PrimitiveUrl
Akhiri Jika
Kalau tidak
Jika kanan(PrimitiveUrl,3)=.cn atau kanan(PrimitiveUrl,3)=com atau kanan(PrimitiveUrl,3)=net atau kanan(PrimitiveUrl,3)=org Kemudian
Url Pasti=http:// & Url Primitif & /
Kalau tidak
DefiniteUrl=Kiri(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl
Akhiri Jika
Akhiri Jika
Kalau tidak
Jika Benar(KonsultasikanUrl,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
Url Pasti=$Salah$
Akhiri Jika
Fungsi Akhir
' ===== = =
'Nama fungsi: GantiSimpanRemoteFile
'Fungsi: mengganti dan menyimpan file jarak jauh
'Parameter: ConStr ------ string yang akan diganti
'Parameter: StarStr ----- terdepan
'Parameter: OverStr -----
'Parameter: Termasuk ------
'Parameter: Termasuk ------
'Parameter: SaveTf ------ Apakah akan menyimpan file, False tidak menyimpan, True menyimpan
'Parameter: SaveFilePath-simpan folder
'Parameter: TistUrl------ alamat halaman web saat ini
' ===== = =
Fungsi GantiSimpanRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl)
Jika ConStr=$False$ atau ConStr= Maka
GantiSimpanRemoteFile=$Salah$
Fungsi Keluar
Akhiri Jika
Redupkan TempStr,TempStr2,ReF,Matches,Match,Tempi,TempArray,TempArray2,OverTypeArray
Setel ReF = Regexp Baru
ReF.IgnoreCase = Benar
ReF.Global = Benar
ReF.Pattern = (&StartStr&).+?(&OverStr&)
Tetapkan Kecocokan =ReF.Execute(ConStr)
Untuk Setiap Pertandingan dalam Pertandingan
Jika Instr(TempStr,Match.Value)=0 Lalu
Jika TempStr<> maka
TempStr=TempStr & $Array$ & Cocok.Nilai
Kalau tidak
TempStr=Cocok.Nilai
Berakhir jika
Akhiri Jika
Berikutnya
Tetapkan Kecocokan=tidak ada
Setel ReF=tidak ada
Jika TempStr= atau IsNull(TempStr)=Benar Maka
GantiSimpanRemoteFile=ConStr
Fungsi keluar
Berakhir jika
Jika IncluL=False maka
TempStr=Ganti(TempStr,StartStr,)
Berakhir jika
Jika InclR=False maka
Jika Instr(OverStr,|)>0 Lalu
OverTypeArray=Pisahkan(OverStr,|)
Untuk Tempi=0 Ke Ubound(OverTypeArray)
TempStr=Ganti(TempStr,OverTypeArray(Tempi),)
Berikutnya
Kalau tidak
TempStr=Ganti(TempStr,OverStr,)
Akhiri Jika
Berakhir jika
TempStr=Ganti(TempStr,,)
TempStr=Ganti(TempStr,',)
Redupkan RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum
Jika Benar(SaveFilePath,1)=/ maka
SaveFilePath=Kiri(SaveFilePath,Len(SaveFilePath)-1)
Akhiri Jika
Jika SaveTf=Benar maka
Jika CheckDir2(SaveFilePath)=False Maka
Jika MakeNewsDir2(SaveFilePath)=Salah Maka
SaveTf=Salah
Akhiri Jika
Akhiri Jika
Akhiri Jika
SaveFilePath=SimpanJalur File & /
'Konversi/penyimpanan gambar
TempArray=Pisahkan(TempStr,$Array$)
Untuk Tempi=0 Ke Ubound(TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
Jika RemoteFileurl<>$False$ Dan SaveTf=True Maka Simpan gambarnya
ArrSaveFileName = Pisahkan(RemoteFileurl,.)
SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'Jenis file
RanNum=Int(900*Rnd)+100
SaveFileName = SaveFilePath&tahun(sekarang)&bulan(sekarang)&hari(sekarang)&jam(sekarang)&menit(sekarang)&detik(sekarang)&ranNum&.&SaveFileType
Panggil SaveRemoteFile(SaveFileName,RemoteFileurl)
ConStr=Ganti(ConStr,TempArray(Tempi),SimpanNamaFile)
ElseIf RemoteFileurl<>$False$ dan SaveTf=False Maka'Jangan simpan gambar
SaveFileName=RemoteFileUrl
ConStr=Ganti(ConStr,TempArray(Tempi),SimpanNamaFile)
Akhiri Jika
Jika RemoteFileUrl<>$False$ Lalu
Jika UploadFiles= maka
UploadFiles=SimpanNamaFile
Kalau tidak
UploadFiles=UnggahFile & |.&SimpanNamaFile
Berakhir jika
Akhiri Jika
Berikutnya
GantiSimpanRemoteFile=ConStr
Fungsi akhir
' ===== = =
'Nama proses: SaveRemoteFile
'Fungsi: menyimpan file jarak jauh ke lokal
'Parameter: LocalFileName ------ nama file lokal
'Parameter: RemoteFileUrl ------ URL file jarak jauh
' ===== = =
subSimpanRemoteFile(LocalFileName,RemoteFileUrl)
redupkan Iklan, Pengambilan, GetRemoteData
Setel Pengambilan = Server.CreateObject(Microsoft.XMLHTTP)
Dengan Pengambilan
.Buka Dapatkan, RemoteFileUrl, Salah,,
.Mengirim
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
sub akhir
' ===== = =
'Nama proses: GetImg
'Fungsi: Mendapatkan gambar pertama di artikel
'Parameter: str ------ konten artikel
'Parameter: strpath ------ jalur untuk menyimpan gambar
' ===== = =
Fungsi GetImg(str,strpath)
atur objregEx = RegExp baru
objregEx.IgnoreCase = benar
objregEx.Global = benar
zzstr=&strpath&(.+?)/.(jpg|gif|png|bmp)
objregEx.Pattern = zzstr
setel kecocokan = objregEx.execute(str)
untuk setiap pertandingan dalam pertandingan
retstr = retstr &|& Cocokkan.Nilai
Berikutnya
jika retstr<> maka
Daftar gambar=berpisah(retstr,|)
Hilang=ganti(Imglist(1),strpath,)
GetImg=Tidak ada lagi
kalau tidak
DapatkanImg=
berakhir jika
fungsi akhir
%>
Berikut ini adalah contohnya
kode program
Copy kode kodenya sebagai berikut:
<form id=form1 name=form1 method=posting tindakan=?action=test>
<nama area teks=body cols=50 baris=5 id=body>
<img tinggi=180 src=http://cimg2.163.com/cnews/2006/8/21/200608210738371d0a8.jpg lebar=240 batas=0 />
<img class=leftsrc=http://news.163.com/img/netease_logo.gif lebar=114 />
<img tinggi=60 src=http://cimg2.163.com/cnews/2006/8/18/2006081811465369976.jpg lebar=120 batas=0 />
<img tinggi=60 /></textarea>
<tipe input=nama kirim=Kirim nilai=Kirim/>
</bentuk>
<%
jika request.QueryString(action)=test maka
'String yang memulai gambar
FileStartStr=src=
'Tali di akhir gambar
FilesOverStr=gif|jpg|bmp
'Folder untuk menyimpan gambar
FilePath=qq
'Dapatkan URL situs web tempat gambar disimpan dan secara otomatis menentukan apakah itu jalur absolut atau relatif. Dalam contoh ini, gambar adalah alamat absolut, jadi NEWURL tidak berguna. gif, Anda perlu menentukan URL BARU.
NewsUrl=http://news.163.com
'Dapatkan konten artikelnya
Konten =Permintaan.Formulir(isi)
'Mulailah menyimpan gambar
Konten=ReplaceSaveRemoteFile(Konten,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
'Buat thumbnail untuk gambar pertama dalam berita
jika GetImg(Content,FilesPath)<> lalu
Igsrc=GetImg(Konten,Jalur File)
Imgsrc=ganti(Imgsrc,FilesPath,)
Setel Jpeg = Server.CreateObject(Persits.Jpeg)
Jalur = Server.MapPath(&FilesPath&) & /&Imgsrc&
Jpeg.Jalur Terbuka
'Jika lebar gambar kurang dari atau sama dengan 120 dan tingginya kurang dari atau sama dengan 90, thumbnail tidak akan dibuat.
jika Jpeg.OriginalWidth<=120 dan Jpeg.Height<=90 maka
Jpeg.Lebar = Jpeg.Lebar Asli
Jpeg.Tinggi = Jpeg.Tinggi Asli
Smallimg=FilesPath&&GetImg(Konten,FilesPath)
kalau tidak
'Lebar dan tinggi gambar/2
Jpeg.Lebar = Jpeg.Lebar Asli / 2
Jpeg.Tinggi = Jpeg.Tinggi Asli / 2
Jpeg.Simpan Server.MapPath(&FilesPath&) & /small_&Imgsrc&
Smallimg=&FilesPath&/small_&Imgsrc&
berakhir jika
berakhir jika
'Tampilkan hasil
respon.Tulis(Gambar pertama di berita adalah :)
respon.Tulis(<img src=&FilesPath&/&GetImg(Konten,FilesPath)&>)
respon.Write(<br>Thumbnail gambar pertama di berita adalah :)
respon.Tulis(<img src=&Smallimg&>)
respon.Write(<br>Konten berita baru (gambar lokal):<br>)
Respon.Tulis(Isi)
Respon.Akhir()
berakhir jika
%>