Cette fonction peut être utilisée lors de la collecte ou lors de l'ajout d'articles en ligne. Cette fonction peut être utilisée lors de la collecte ou lors de l'ajout d'articles en ligne.
Le code que j'ai recherché sur Baidu pour enregistrer des images distantes dans la zone locale semble un peu difficile à utiliser, et il n'y a pas de code prêt à l'emploi et complet que je ne puisse pas comprendre.
J'ai extrait certaines fonctions du système de collecte d'actualités SNA For 3.62 (programmé par : ansir) et je les ai utilisées, qui est relativement simple et facile à utiliser.
Voici la fonction
code de programme
Copiez le code comme suit :
<%
'================================================== = =
'Nom de la fonction : CheckDir2
'Fonction : Vérifier si le dossier existe
'Paramètre : FolderPath ------adresse du dossier
'================================================== = =
Fonction CheckDir2 (byval FolderPath)
faible fso
chemin du dossier = Server.MapPath (.) &/& chemin du dossier
Définir fso = Server.CreateObject (Scripting.FileSystemObject)
Si fso.FolderExists (FolderPath) alors
'exister
CheckDir2 = Vrai
Autre
'n'existe pas
CheckDir2 = Faux
Terminer si
Définir fso = rien
Fonction de fin
'================================================== = =
'Nom de la fonction : MakeNewsDir2
'Fonction : Créer un nouveau dossier
'Paramètre : nom du dossier ------nom du dossier
'================================================== = =
Fonction MakeNewsDir2 (nom du dossier byval)
faible fso
Définir fso = Server.CreateObject (Scripting.FileSystemObject)
fso.CreateFolder(Server.MapPath(.) &/ &nom du dossier)
Si fso.FolderExists(Server.MapPath(.) &/ &foldername) Alors
MakeNewsDir2 = Vrai
Autre
MakeNewsDir2 = Faux
Fin si
Définir fso = rien
Fonction de fin
'================================================== = =
'Nom de la fonction : DefiniteUrl
'Fonction : Convertir l'adresse relative en adresse absolue
'Paramètre : PrimitiveUrl ------ adresse relative à convertir
'Paramètre : ConsultUrl ------Adresse actuelle de la page Web
'================================================== = =
Fonction DefiniteUrl (Byval PrimitiveUrl, Byval ConsultUrl)
Dim ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
Si PrimitiveUrl= ou ConsultUrl= ou PrimitiveUrl=$False$ Alors
DefiniteUrl=$Faux$
Fonction de sortie
Fin si
Si Left(ConsultUrl,7)<>HTTP:// Et Left(ConsultUrl,7)<>http:// Then
ConsultUrl= http:// & ConsultUrl
Fin si
ConsultUrl=Remplacer(ConsultUrl,://,://)
Si c'est vrai(ConsultUrl,1)<>/ Alors
Si Instr(ConsultUrl,/)>0 Alors
Si Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,/)),.)>0 alors
Autre
ConsultUrl=ConsultUrl & /
Fin si
Autre
ConsultUrl=ConsultUrl & /
Fin si
Fin si
ConArray=Split(ConsultUrl,/)
Si Left(PrimitiveUrl,7) = http:// alors
DefiniteUrl=Remplacer(PrimitiveUrl,://,://)
SinonSi Gauche(PrimitiveUrl,1) = / Alors
DefiniteUrl=ConArray(0) et PrimitiveUrl
ElseIf Left(PrimitiveUrl,2)=./ Then
DefiniteUrl=ConArray(0) & Right(PrimitiveUrl,Len(PrimitiveUrl)-1)
ElseIf Left(PrimitiveUrl,3)=../ then
Faire en restant à gauche(PrimitiveUrl,3)=../
PrimitiveUrl=Droite(PrimitiveUrl,Len(PrimitiveUrl)-3)
Pi=Pi+1
Boucle
Pour Ci=0 à (Ubound(ConArray)-1-Pi)
Si DefiniteUrl<> Alors
DefiniteUrl=DefiniteUrl & / & ConArray(Ci)
Autre
DefiniteUrl = ConArray (Ci)
Fin si
Suivant
DefiniteUrl=DefiniteUrl & / & PrimitiveUrl
Autre
Si Instr(PrimitiveUrl,/)>0 Alors
PriArray=Split(PrimitiveUrl,/)
Si Instr(PriArray(0),.)>0 Alors
Si c'est vrai(PrimitiveUrl,1)=/ Alors
DefiniteUrl=http:// & PrimitiveUrl
Autre
Si Instr(PriArray(Ubound(PriArray)-1),.)>0 Alors
DefiniteUrl=http:// & PrimitiveUrl
Autre
DefiniteUrl = http:// & PrimitiveUrl & /
Fin si
Fin si
Autre
Si c'est vrai(ConsultUrl,1)=/ Alors
DefiniteUrl=ConsultUrl et PrimitiveUrl
Autre
DefiniteUrl = Gauche (ConsultUrl, InstrRev (ConsultUrl,/)) et PrimitiveUrl
Fin si
Fin si
Autre
Si Instr(PrimitiveUrl,.)>0 Alors
Si c'est vrai(ConsultUrl,1)=/ Alors
Si right(PrimitiveUrl,3)=.cn ou right(PrimitiveUrl,3)=com ou right(PrimitiveUrl,3)=net ou right(PrimitiveUrl,3)=org Alors
DefiniteUrl = http:// & PrimitiveUrl & /
Autre
DefiniteUrl=ConsultUrl et PrimitiveUrl
Fin si
Autre
Si right(PrimitiveUrl,3)=.cn ou right(PrimitiveUrl,3)=com ou right(PrimitiveUrl,3)=net ou right(PrimitiveUrl,3)=org Alors
DefiniteUrl = http:// & PrimitiveUrl & /
Autre
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl
Fin si
Fin si
Autre
Si c'est vrai(ConsultUrl,1)=/ Alors
DefiniteUrl=ConsultUrl & PrimitiveUrl & /
Autre
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl & /
Fin si
Fin si
Fin si
Fin si
Si Gauche(DefiniteUrl,1)=/ alors
DefiniteUrl=Droite(DefiniteUrl,Len(DefiniteUrl)-1)
Terminer si
Si DefiniteUrl<> Alors
DefiniteUrl = Remplacer (DefiniteUrl,//,/)
DefiniteUrl = Remplacer (DefiniteUrl,://,://)
Autre
DefiniteUrl=$Faux$
Fin si
Fonction de fin
'================================================== = =
'Nom de la fonction : ReplaceSaveRemoteFile
'Fonction : remplacer et enregistrer des fichiers distants
'Paramètre : ConStr ------ chaîne à remplacer
'Paramètre : StarStr ----- leader
'Paramètre : OverStr -----
'Paramètre : IncluL ------
'Paramètre : IncluR ------
'Paramètre : SaveTf ------ S'il faut enregistrer le fichier, False n'enregistre pas, True enregistre
'Paramètre : dossier de sauvegarde SaveFilePath
'Paramètre : TistUrl------ adresse de la page Web actuelle
'================================================== = =
Fonction ReplaceSaveRemoteFile (ConStr, StartStr, OverStr, IncluL, IncluR, SaveTf, SaveFilePath, TistUrl)
Si ConStr=$False$ ou ConStr= Alors
ReplaceSaveRemoteFile=$False$
Fonction de sortie
Fin si
Dim TempStr, TempStr2, ReF, Matches, Match, Tempi, TempArray, TempArray2, OverTypeArray
Définir ReF = Nouvelle expression rationnelle
ReF.IgnoreCase = Vrai
ReF.Global = Vrai
ReF.Pattern = (&StartStr&).+?(&OverStr&)
Définir les correspondances =ReF.Execute(ConStr)
Pour chaque match dans les matchs
Si Instr(TempStr,Match.Value)=0 Alors
Si TempStr<> alors
TempStr=TempStr & $Array$ & Match.Value
Autre
TempStr=Match.Valeur
Terminer si
Fin si
Suivant
Définir les correspondances = rien
Définir ReF = rien
Si TempStr= ou IsNull(TempStr)=True Alors
ReplaceSaveRemoteFile=ConStr
Fonction de sortie
Terminer si
Si IncluL=False alors
TempStr=Remplacer(TempStr,StartStr,)
Terminer si
Si InclR=Faux alors
Si Instr(OverStr,|)>0 Alors
OverTypeArray=Split(OverStr,|)
Pour Tempi = 0 à Ubound (OverTypeArray)
TempStr=Remplacer(TempStr,OverTypeArray(Tempi),)
Suivant
Autre
TempStr=Remplacer(TempStr,OverStr,)
Fin si
Terminer si
TempStr=Remplacer(TempStr,,)
TempStr=Remplacer(TempStr,',)
Dim RemoteFile,RemoteFileurl,SaveFileName,SaveFileType,ArrSaveFileName,RanNum
Si c'est vrai(SaveFilePath,1)=/ alors
SaveFilePath=Gauche(SaveFilePath,Len(SaveFilePath)-1)
Fin si
Si SaveTf=True alors
Si CheckDir2(SaveFilePath)=False Alors
Si MakeNewsDir2(SaveFilePath)=False Alors
SaveTf=Faux
Fin si
Fin si
Fin si
SaveFilePath=SaveFilePath & /
'Conversion/enregistrement d'image
TempArray=Split(TempStr,$Array$)
Pour Tempi = 0 à Ubound (TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
Si RemoteFileurl<>$False$ et SaveTf=True alors enregistrez l'image
ArrSaveFileName = Split(RemoteFileurl,.)
SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'Type de fichier
RanNum=Int(900*Rnd)+100
SaveFileName = SaveFilePath&année(maintenant)&mois(maintenant)&jour(maintenant)&heure(maintenant)&minute(maintenant)&seconde(maintenant)&ranNum&.&SaveFileType
Appelez SaveRemoteFile(SaveFileName,RemoteFileurl)
ConStr=Remplacer(ConStr,TempArray(Tempi),SaveFileName)
ElseIf RemoteFileurl<>$False$ et SaveTf=False Then'Ne pas enregistrer l'image
SaveFileName=RemoteFileUrl
ConStr=Remplacer(ConStr,TempArray(Tempi),SaveFileName)
Fin si
Si RemoteFileUrl<>$False$ Alors
Si UploadFiles= alors
UploadFiles=SaveFileName
Autre
UploadFiles=TéléchargerFichiers & | & SaveFileName
Terminer si
Fin si
Suivant
ReplaceSaveRemoteFile=ConStr
Fin de fonction
'================================================== = =
'Nom du processus : SaveRemoteFile
'Fonction : enregistrer les fichiers distants en local
'Paramètre : LocalFileName ------ nom du fichier local
'Paramètre : RemoteFileUrl ------ URL du fichier distant
'================================================== = =
sous SaveRemoteFile (LocalFileName, RemoteFileUrl)
dim Annonces, Récupération, GetRemoteData
Définir la récupération = Server.CreateObject (Microsoft.XMLHTTP)
Avec récupération
.Ouvrez Get, RemoteFileUrl, False, ,
.Envoyer
GetRemoteData = .ResponseBody
Terminer par
Définir la récupération = Rien
Définir les annonces = Server.CreateObject (Adodb.Stream)
Avec des publicités
.Type = 1
.Ouvrir
.Écrire GetRemoteData
.SaveToFile serveur.MapPath(LocalFileName),2
.Annuler()
.Fermer()
Terminer par
Définir les annonces = rien
fin du sous
'================================================== = =
'Nom du processus : GetImg
'Fonction : Obtenez la première image de l'article
'Paramètre : str ------ contenu de l'article
'Paramètre : strpath ------ chemin pour enregistrer l'image
'================================================== = =
Fonction GetImg(str,strpath)
définir objregEx = nouveau RegExp
objregEx.IgnoreCase = vrai
objregEx.Global = vrai
zzstr=&strpath&(.+?)/.(jpg|gif|png|bmp)
objregEx.Pattern = zzstr
définir les correspondances = objregEx.execute(str)
pour chaque match en matchs
retstr = retstr &|& Match.Value
suivant
si retstr<> alors
Imglist=split(retstr,|)
Imgone=remplacer(Imglist(1),strpath,)
GetImg=Imgoné
autre
ObtenirImg=
finir si
fonction de fin
%>
Voici des exemples
code de programme
Copiez le code comme suit :
<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 hauteur=60 /></textarea>
<input type=submit name=Submit value=Soumettre/>
</form>
<%
si request.QueryString(action)=test alors
'La chaîne qui commence l'image
FichiersStartStr=src=
'Ficelle à la fin de l'image
FilesOverStr=gif|jpg|bmp
'Dossier pour enregistrer les images
Chemin de fichiers = qq
'Obtenez l'URL du site Web sur lequel l'image est enregistrée et déterminez automatiquement s'il s'agit d'un chemin absolu ou relatif. Dans cet exemple, l'image est une adresse absolue, donc NEWURL est inutile Si c'est ../images/123. gif, vous devez spécifier NEWURL.
NewsUrl=http://news.163.com
'Obtenir le contenu de l'article
Contenu =Request.Form(corps)
'Commencez à enregistrer les photos
Content=ReplaceSaveRemoteFile(Content,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
'Créer une vignette pour la première photo de l'actualité
si GetImg(Content,FilesPath)<> alors
Imgsrc=GetImg(Contenu,CheminFichiers)
Imgsrc=remplacer(Imgsrc,FilesPath,)
Définir Jpeg = Server.CreateObject (Persits.Jpeg)
Chemin = Server.MapPath(&FilesPath&) & /&Imgsrc&
Jpeg.Chemin ouvert
'Si la largeur de l'image est inférieure ou égale à 120 et la hauteur est inférieure ou égale à 90, aucune vignette ne sera créée.
si Jpeg.OriginalWidth<=120 et Jpeg.Height<=90 alors
Jpeg.Largeur = Jpeg.OriginalWidth
Jpeg.Hauteur = Jpeg.OriginalHeight
Smallimg=FilesPath&&GetImg(Contenu,FilesPath)
autre
'Largeur et hauteur de l'image/2
Jpeg.Largeur = Jpeg.OriginalWidth / 2
Jpeg.Hauteur = Jpeg.OriginalHeight / 2
Jpeg.Save Server.MapPath(&FilesPath&) & /small_&Imgsrc&
Smallimg=&CheminFichiers&/small_&Imgsrc&
finir si
finir si
'Afficher les résultats
réponse.Write(La première image dans l'actualité est :)
réponse.Write(<img src=&FilesPath&/&GetImg(Content,FilesPath)&>)
réponse.Write(<br>La vignette de la première image de l'actualité est :)
réponse.Write(<img src=&Smallimg&>)
réponse.Write(<br>Nouveau contenu d'actualité (l'image est locale) :<br>)
Réponse.Write (Contenu)
Réponse.Fin()
finir si
%>