Diese Funktion kann beim Online-Sammeln oder Hinzufügen von Artikeln verwendet werden. Diese Funktion kann beim Online-Sammeln oder Hinzufügen von Artikeln verwendet werden.
Der Code, den ich auf Baidu zum Speichern von Remote-Bildern im lokalen Bereich gesucht habe, scheint etwas schwierig zu verwenden zu sein, und es gibt keinen vorgefertigten und vollständigen Code, den ich nicht verstehen kann.
Ich habe einige Funktionen aus dem SNA-Nachrichtenerfassungssystem für 3.62 (programmiert von: ansir) extrahiert und verwendet, was relativ einfach und benutzerfreundlich ist.
Das Folgende ist die Funktion
Programmcode
Kopieren Sie den Codecode wie folgt:
<%
'============================================== = =
'Funktionsname: CheckDir2
'Funktion: Prüfen, ob der Ordner existiert
'Parameter: FolderPath ------Ordneradresse
'============================================== = =
Funktion CheckDir2(byval FolderPath)
dim fso
Ordnerpfad=Server.MapPath(.)&/&Ordnerpfad
Setze fso = Server.CreateObject(Scripting.FileSystemObject)
Wenn fso.FolderExists(FolderPath), dann
'existieren
CheckDir2 = True
Anders
'existiert nicht
CheckDir2 = Falsch
Beenden Sie, wenn
Setze fso = nichts
Funktion beenden
'============================================== = =
'Funktionsname: MakeNewsDir2
'Funktion: Einen neuen Ordner erstellen
'Parameter: Ordnername ------Ordnername
'============================================== = =
Funktion MakeNewsDir2(byval Ordnername)
dim fso
Setze fso = Server.CreateObject(Scripting.FileSystemObject)
fso.CreateFolder(Server.MapPath(.) &/ &Ordnername)
Wenn fso.FolderExists(Server.MapPath(.) &/ &foldername) Dann
MakeNewsDir2 = True
Anders
MakeNewsDir2 = Falsch
Ende wenn
Setze fso = nichts
Funktion beenden
'============================================== = =
'Funktionsname: DefiniteUrl
'Funktion: Relative Adresse in absolute Adresse umwandeln
'Parameter: PrimitiveUrl ------ relative Adresse, die konvertiert werden soll
'Parameter: ConsultUrl ------Aktuelle Webseitenadresse
'============================================== = =
Funktion DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Dim ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
Wenn PrimitiveUrl= oder ConsultUrl= oder PrimitiveUrl=$False$ Dann
DefiniteUrl=$False$
Exit-Funktion
Ende wenn
Wenn Left(ConsultUrl,7)<>HTTP:// und Left(ConsultUrl,7)<>http:// dann
ConsultUrl= http:// & ConsultUrl
Ende wenn
ConsultUrl=Replace(ConsultUrl,://,://)
If Right(ConsultUrl,1)<>/ Then
Wenn Instr(ConsultUrl,/)>0 Dann
Wenn Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,/)),.)>0 dann
Anders
ConsultUrl=ConsultUrl & /
Ende wenn
Anders
ConsultUrl=ConsultUrl & /
Ende wenn
Ende wenn
ConArray=Split(ConsultUrl,/)
Wenn Left(PrimitiveUrl,7) = http:// dann
DefiniteUrl=Replace(PrimitiveUrl,://,://)
ElseIf Left(PrimitiveUrl,1) = / Then
DefiniteUrl=ConArray(0) & PrimitiveUrl
ElseIf Left(PrimitiveUrl,2)=./ Then
DefiniteUrl=ConArray(0) & Right(PrimitiveUrl,Len(PrimitiveUrl)-1)
ElseIf Left(PrimitiveUrl,3)=../ then
Do While Left(PrimitiveUrl,3)=../
PrimitiveUrl=Right(PrimitiveUrl,Len(PrimitiveUrl)-3)
Pi=Pi+1
Schleife
Für Ci=0 bis (Ubound(ConArray)-1-Pi)
Wenn DefiniteUrl<> Dann
DefiniteUrl=DefiniteUrl & / & ConArray(Ci)
Anders
DefiniteUrl=ConArray(Ci)
Ende wenn
Nächste
DefiniteUrl=DefiniteUrl & / & PrimitiveUrl
Anders
Wenn Instr(PrimitiveUrl,/)>0 Dann
PriArray=Split(PrimitiveUrl,/)
Wenn Instr(PriArray(0),.)>0 Dann
Wenn Right(PrimitiveUrl,1)=/ Then
DefiniteUrl=http:// & PrimitiveUrl
Anders
Wenn Instr(PriArray(Ubound(PriArray)-1),.)>0 Dann
DefiniteUrl=http:// & PrimitiveUrl
Anders
DefiniteUrl=http:// & PrimitiveUrl & /
Ende wenn
Ende wenn
Anders
Wenn Right(ConsultUrl,1)=/ Then
DefiniteUrl=ConsultUrl & PrimitiveUrl
Anders
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & PrimitiveUrl
Ende wenn
Ende wenn
Anders
Wenn Instr(PrimitiveUrl,.)>0 Dann
Wenn Right(ConsultUrl,1)=/ Then
Wenn right(PrimitiveUrl,3)=.cn oder right(PrimitiveUrl,3)=com oder right(PrimitiveUrl,3)=net oder right(PrimitiveUrl,3)=org Dann
DefiniteUrl=http:// & PrimitiveUrl & /
Anders
DefiniteUrl=ConsultUrl & PrimitiveUrl
Ende wenn
Anders
Wenn right(PrimitiveUrl,3)=.cn oder right(PrimitiveUrl,3)=com oder right(PrimitiveUrl,3)=net oder right(PrimitiveUrl,3)=org Dann
DefiniteUrl=http:// & PrimitiveUrl & /
Anders
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl
Ende wenn
Ende wenn
Anders
Wenn Right(ConsultUrl,1)=/ Then
DefiniteUrl=ConsultUrl & PrimitiveUrl & /
Anders
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl & /
Ende wenn
Ende wenn
Ende wenn
Ende wenn
Wenn Left(DefiniteUrl,1)=/ dann
DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
Beenden Sie, wenn
Wenn DefiniteUrl<> Dann
DefiniteUrl=Replace(DefiniteUrl,//,/)
DefiniteUrl=Replace(DefiniteUrl,://,://)
Anders
DefiniteUrl=$False$
Ende wenn
Funktion beenden
'============================================== = =
'Funktionsname: ReplacementSaveRemoteFile
'Funktion: Remote-Dateien ersetzen und speichern
'Parameter: ConStr ------ zu ersetzende Zeichenfolge
'Parameter: StarStr ----- führend
'Parameter: OverStr -----
'Parameter:IncluL ------
'Parameter:IncluR ------
'Parameter: SaveTf ------ Gibt an, ob die Datei gespeichert werden soll. False speichert nicht, True speichert
'Parameter: SaveFilePath-Speicherordner
'Parameter: TistUrl------ aktuelle Webseitenadresse
'============================================== = =
Funktion ReplacementSaveRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl)
Wenn ConStr=$False$ oder ConStr= Dann
ReplacementSaveRemoteFile=$False$
Exit-Funktion
Ende wenn
Dim TempStr,TempStr2,ReF,Matches,Match,Tempi,TempArray,TempArray2,OverTypeArray
Setze ReF = Neuer regulärer Ausdruck
ReF.IgnoreCase = True
ReF.Global = True
ReF.Pattern = (&StartStr&).+?(&OverStr&)
Übereinstimmungen festlegen =ReF.Execute(ConStr)
Für jedes Spiel in Spielen
Wenn Instr(TempStr,Match.Value)=0, dann
Wenn TempStr<> dann
TempStr=TempStr & $Array$ & Match.Value
Anders
TempStr=Match.Value
Beenden Sie, wenn
Ende wenn
Nächste
Setze Übereinstimmungen=nichts
Setze ReF=nichts
Wenn TempStr= oder IsNull(TempStr)=True, dann
ReplacementSaveRemoteFile=ConStr
Exit-Funktion
Beenden Sie, wenn
Wenn IncluL=False, dann
TempStr=Replace(TempStr,StartStr,)
Beenden Sie, wenn
Wenn InclR=False, dann
Wenn Instr(OverStr,|)>0 Dann
OverTypeArray=Split(OverStr,|)
Für Tempi=0 bis Ubound(OverTypeArray)
TempStr=Replace(TempStr,OverTypeArray(Tempi),)
Nächste
Anders
TempStr=Replace(TempStr,OverStr,)
Ende wenn
Beenden Sie, wenn
TempStr=Replace(TempStr,,)
TempStr=Replace(TempStr,',)
Dimmen Sie RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum
Wenn Right(SaveFilePath,1)=/ dann
SaveFilePath=Left(SaveFilePath,Len(SaveFilePath)-1)
Ende wenn
Wenn SaveTf=True, dann
Wenn CheckDir2(SaveFilePath)=False, dann
Wenn MakeNewsDir2(SaveFilePath)=False, dann
SaveTf=False
Ende wenn
Ende wenn
Ende wenn
SaveFilePath=SaveFilePath & /
„Bildkonvertierung/Speichern
TempArray=Split(TempStr,$Array$)
Für Tempi=0 bis Ubound(TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
Wenn RemoteFileurl<>$False$ und SaveTf=True, dann speichern Sie das Bild
ArrSaveFileName = Split(RemoteFileurl,.)
SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'Dateityp
RanNum=Int(900*Rnd)+100
SaveFileName = SaveFilePath&Jahr(jetzt)&Monat(jetzt)&Tag(jetzt)&Stunde(jetzt)&Minute(jetzt)&Sekunde(jetzt)&ranNum&.&SaveFileType
Rufen Sie SaveRemoteFile(SaveFileName,RemoteFileurl) auf.
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
ElseIf RemoteFileurl<>$False$ und SaveTf=False Then'Speichern Sie das Bild nicht
SaveFileName=RemoteFileUrl
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
Ende wenn
Wenn RemoteFileUrl<>$False$, dann
Wenn UploadFiles= dann
UploadFiles=SaveFileName
Anders
UploadFiles=UploadFiles & | & SaveFileName
Beenden Sie, wenn
Ende wenn
Nächste
ReplacementSaveRemoteFile=ConStr
Funktion beenden
'============================================== = =
'Prozessname: SaveRemoteFile
'Funktion: Remote-Dateien lokal speichern
'Parameter: LocalFileName ------ lokaler Dateiname
'Parameter: RemoteFileUrl ------ Remote-Datei-URL
'============================================== = =
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
dim Ads,Retrieval,GetRemoteData
Set Retrieval = Server.CreateObject(Microsoft.XMLHTTP)
Mit Abruf
.Open Get, RemoteFileUrl, False, ,
.Schicken
GetRemoteData = .ResponseBody
Ende mit
Abruf festlegen = Nichts
Set Ads = Server.CreateObject(Adodb.Stream)
Mit Werbung
.Typ = 1
.Offen
.GetRemoteData schreiben
.SaveToFile server.MapPath(LocalFileName),2
.Stornieren()
.Schließen()
Ende mit
Legen Sie „Anzeigen=nichts“ fest
Ende sub
'============================================== = =
'Prozessname: GetImg
'Funktion: Holen Sie sich das erste Bild im Artikel
'Parameter: str ------ Artikelinhalt
'Parameter: strpath ------ Pfad zum Speichern des Bildes
'============================================== = =
Funktion GetImg(str,strpath)
set objregEx = new RegExp
objregEx.IgnoreCase = true
objregEx.Global = true
zzstr=&strpath&(.+?)/.(jpg|gif|png|bmp)
objregEx.Pattern = zzstr
set match = objregEx.execute(str)
für jedes Spiel in Spielen
retstr = retstr &|& Match.Value
nächste
wenn retstr<> dann
Imglist=split(retstr,|)
Imgone=replace(Imglist(1),strpath,)
GetImg=Imgone
anders
GetImg=
Ende wenn
Endfunktion
%>
Im Folgenden finden Sie Beispiele
Programmcode
Kopieren Sie den Codecode wie folgt:
<form id=form1 name=form1 method=post action=?action=test>
<textarea name=body cols=50 rows=5 id=body>
<img height=180 src=http://cimg2.163.com/cnews/2006/8/21/200608210738371d0a8.jpg width=240 border=0 />
<img class=leftsrc=http://news.163.com/img/netease_logo.gif width=114 />
<img height=60 src=http://cimg2.163.com/cnews/2006/8/18/2006081811465369976.jpg width=120 border=0 />
<img height=60 /></textarea>
<Eingabetyp=Submit-Name=Submit-Wert=Submit/>
</form>
<%
wenn request.QueryString(action)=test dann
„Die Zeichenfolge, mit der das Bild beginnt.“
FilesStartStr=src=
'String am Ende des Bildes
FilesOverStr=gif|jpg|bmp
'Ordner zum Speichern von Bildern
FilesPath=qq
„Rufen Sie die URL der Website ab, auf der das Bild gespeichert ist, und bestimmen Sie automatisch, ob es sich um einen absoluten oder relativen Pfad handelt. In diesem Beispiel ist das Bild eine absolute Adresse, daher ist NEWURL nutzlos, wenn es ../images/123 ist.“ gif müssen Sie NEWURL angeben.
NewsUrl=http://news.163.com
'Holen Sie sich den Inhalt des Artikels
Inhalt =Request.Form(body)
„Beginnen Sie mit dem Speichern von Bildern.“
Content=ReplaceSaveRemoteFile(Content,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
„Erstellen Sie ein Miniaturbild für das erste Bild in den Nachrichten.“
if GetImg(Content,FilesPath)<> dann
Imgsrc=GetImg(Content,FilesPath)
Imgsrc=replace(Imgsrc,FilesPath,)
Setze Jpeg = Server.CreateObject(Persits.Jpeg)
Pfad = Server.MapPath(&FilesPath&) & /&Imgsrc&
Jpeg.Pfad öffnen
„Wenn die Bildbreite kleiner oder gleich 120 und die Höhe kleiner oder gleich 90 ist, wird kein Miniaturbild erstellt.
wenn Jpeg.OriginalWidth<=120 und Jpeg.Height<=90 dann
Jpeg.Width = Jpeg.OriginalWidth
Jpeg.Height = Jpeg.OriginalHeight
Smallimg=FilesPath&&GetImg(Content,FilesPath)
anders
'Bildbreite und -höhe/2
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
Jpeg.Save Server.MapPath(&FilesPath&) & /small_&Imgsrc&
Smallimg=&FilesPath&/small_&Imgsrc&
Ende wenn
Ende wenn
'Ergebnisse anzeigen
Antwort.Write(Das erste Bild in den Nachrichten ist:)
Response.Write(<img src=&FilesPath&/&GetImg(Content,FilesPath)&>)
Response.Write(<br>Das Miniaturbild des ersten Bildes in den Nachrichten ist:)
Antwort.Write(<img src=&Smallimg&>)
Response.Write(<br>Neuer Nachrichteninhalt (Bild ist lokal):<br>)
Response.Write(Inhalt)
Response.End()
Ende wenn
%>