Эту функцию можно использовать при сборе или добавлении статей в Интернете. Эту функцию можно использовать при сборе или добавлении статей в Интернете.
Код, который я искал на Baidu для сохранения удаленных изображений в локальной области, кажется немного сложным в использовании, и не существует готового и полного кода, который я не могу понять.
Я извлек некоторые функции из системы сбора новостей SNA для версии 3.62 (программируется: ansir) и использовал их, что относительно просто и удобно в использовании.
Ниже приведена функция
программный код
Скопируйте код кода следующим образом:
<%
'============================================== = =
'Имя функции: CheckDir2
'Функция: проверить, существует ли папка
'Параметр: FolderPath ------ адрес папки
'============================================== = =
Функция CheckDir2 (byval FolderPath)
тусклый фсо
путь к папке=Server.MapPath(.)&/&путь к папке
Установите fso = Server.CreateObject(Scripting.FileSystemObject)
Если fso.FolderExists(FolderPath), то
'существовать
ЧекДир2 = Истина
Еще
'не существует
ЧекДир2 = Ложь
Конец, если
Установите fso = ничего
Конечная функция
'============================================== = =
'Имя функции: MakeNewsDir2
'Функция: создать новую папку
'Параметр: имя_папки ------имя папки
'============================================== = =
Функция MakeNewsDir2 (имя_папки)
тусклый фсо
Установите fso = Server.CreateObject(Scripting.FileSystemObject)
fso.CreateFolder(Server.MapPath(.) &/ &имя папки)
Если fso.FolderExists(Server.MapPath(.) &/ &имя_папки) Тогда
MakeNewsDir2 = Истина
Еще
MakeNewsDir2 = Ложь
Конец, если
Установите fso = ничего
Конечная функция
'============================================== = =
'Имя функции: DefiniteUrl
'Функция: преобразовать относительный адрес в абсолютный адрес.
'Параметр: PrimitiveUrl ------ относительный адрес для преобразования
'Параметр: ConsultUrl ------ адрес текущей веб-страницы
'============================================== = =
Функция DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Тусклый ConTemp, PriTemp, Pi, Ci, PriArray, ConArray
Если PrimitiveUrl= или ConsultUrl= или PrimitiveUrl=$False$ Тогда
DefiniteUrl=$False$
Выход из функции
Конец, если
Если Left(ConsultUrl,7)<>HTTP:// И Left(ConsultUrl,7)<>http:// Тогда
ConsultUrl= http:// & ConsultUrl
Конец, если
ConsultUrl=Replace(ConsultUrl,://,://)
Если Верно(ConsultUrl,1)<>/ Тогда
Если Instr(ConsultUrl,/)>0 Тогда
Если Instr(Right(ConsultUrl,Len(ConsultUrl)-InstrRev(ConsultUrl,/)),.)>0, то
Еще
ConsultUrl=ConsultUrl & /
Конец, если
Еще
ConsultUrl=ConsultUrl & /
Конец, если
Конец, если
ConArray=Split(ConsultUrl,/)
Если Left(PrimitiveUrl,7) = http://, то
DefiniteUrl=Replace(PrimitiveUrl,://,://)
ElseIf Left(PrimitiveUrl,1) = / Тогда
DefiniteUrl=ConArray(0) и PrimitiveUrl
ElseIf Left(PrimitiveUrl,2)=./ Тогда
DefiniteUrl=ConArray(0) & Right(PrimitiveUrl,Len(PrimitiveUrl)-1)
ИначеЕсли Left(PrimitiveUrl,3)=../ тогда
Делать, пока слева(PrimitiveUrl,3)=../
PrimitiveUrl=Вправо(PrimitiveUrl,Len(PrimitiveUrl)-3)
Пи=Пи+1
Петля
От Ci=0 до (Ubound(ConArray)-1-Pi)
Если DefiniteUrl<> Тогда
DefiniteUrl=DefiniteUrl &/& ConArray(Ci)
Еще
DefiniteUrl=ConArray(Ci)
Конец, если
Следующий
DefiniteUrl=Определенный URL &/& PrimitiveUrl
Еще
Если Instr(PrimitiveUrl,/)>0 Тогда
PriArray=Split(PrimitiveUrl,/)
Если Instr(PriArray(0),.)>0 Тогда
Если Right(PrimitiveUrl,1)=/ Тогда
DefiniteUrl=http:// и PrimitiveUrl
Еще
Если Instr(PriArray(Ubound(PriArray)-1),.)>0 Тогда
DefiniteUrl=http:// и PrimitiveUrl
Еще
DefiniteUrl=http:// & PrimitiveUrl & /
Конец, если
Конец, если
Еще
Если Правильно(ConsultUrl,1)=/ Тогда
DefiniteUrl=ConsultUrl и PrimitiveUrl
Еще
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & PrimitiveUrl
Конец, если
Конец, если
Еще
Если Instr(PrimitiveUrl,.)>0 Тогда
Если Правильно(ConsultUrl,1)=/ Тогда
Если right(PrimitiveUrl,3)=.cn или right(PrimitiveUrl,3)=com или right(PrimitiveUrl,3)=net или right(PrimitiveUrl,3)=org Тогда
DefiniteUrl=http:// & PrimitiveUrl & /
Еще
DefiniteUrl=ConsultUrl и PrimitiveUrl
Конец, если
Еще
Если right(PrimitiveUrl,3)=.cn или right(PrimitiveUrl,3)=com или right(PrimitiveUrl,3)=net или right(PrimitiveUrl,3)=org Тогда
DefiniteUrl=http:// & PrimitiveUrl & /
Еще
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl
Конец, если
Конец, если
Еще
Если Правильно(ConsultUrl,1)=/ Тогда
DefiniteUrl=ConsultUrl & PrimitiveUrl & /
Еще
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl & /
Конец, если
Конец, если
Конец, если
Конец, если
Если Left(DefiniteUrl,1)=/, то
DefiniteUrl=Вправо(DefiniteUrl,Len(DefiniteUrl)-1)
Конец, если
Если DefiniteUrl<> Тогда
DefiniteUrl=Заменить(DefiniteUrl,//,/)
DefiniteUrl=Replace(DefiniteUrl,://,://)
Еще
DefiniteUrl=$False$
Конец, если
Конечная функция
'============================================== = =
'Имя функции: replaceSaveRemoteFile
'Функция: замена и сохранение удаленных файлов
'Параметр: ConStr ------ заменяемая строка
'Параметр: StarStr ----- ведущий
'Параметр: OverStr -----
'Параметр:IncluL ------
'Параметр:IncluR ------
'Параметр: SaveTf ------ Сохранять ли файл, False не сохраняет, True сохраняет
'Параметр: SaveFilePath — папка сохранения
'Параметр: TistUrl ------ адрес текущей веб-страницы.
'============================================== = =
Функция replaceSaveRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl)
Если ConStr=$False$ или ConStr= Тогда
replaceSaveRemoteFile=$False$
Выход из функции
Конец, если
Dim TempStr, TempStr2, ReF, Matches, Match, Tempi, TempArray, TempArray2, OverTypeArray
Установить ReF = Новое регулярное выражение
ReF.IgnoreCase = Истина
ReF.Global = Истина
ReF.Pattern = (&StartStr&).+?(&OverStr&)
Установить совпадения =ReF.Execute(ConStr)
За каждый матч в матчах
Если Instr(TempStr,Match.Value)=0 Тогда
Если TempStr<>, то
TempStr=TempStr & $Array$ & Match.Value
Еще
TempStr=Соответствие.Значение
Конец, если
Конец, если
Следующий
Установить совпадения = ничего
Установить ReF=ничего
Если TempStr= или IsNull(TempStr)=True Тогда
replaceSaveRemoteFile=ConStr
Функция выхода
Конец, если
Если IncluL=False, то
TempStr=Заменить(TempStr,StartStr,)
Конец, если
Если InclR=False, то
Если Instr(OverStr,|)>0 Тогда
OverTypeArray=Разделить(OverStr,|)
Для Tempi = 0 в Ubound (OverTypeArray)
TempStr=Replace(TempStr,OverTypeArray(Tempi),)
Следующий
Еще
TempStr=Заменить(TempStr,OverStr,)
Конец, если
Конец, если
TempStr=Заменить(TempStr,,)
TempStr=Заменить(TempStr,',)
Dim RemoteFile, RemoteFileurl, SaveFileName, SaveFileType, ArrSaveFileName, RanNum
Если Right(SaveFilePath,1)=/, то
SaveFilePath=Влево(SaveFilePath,Len(SaveFilePath)-1)
Конец, если
Если SaveTf=True, тогда
Если CheckDir2(SaveFilePath)=False Тогда
Если MakeNewsDir2(SaveFilePath)=False Тогда
SaveTf=False
Конец, если
Конец, если
Конец, если
SaveFilePath=SaveFilePath & /
'Преобразование/сохранение изображения
TempArray=Split(TempStr,$Array$)
Для Tempi = 0 в Ubound (TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
Если RemoteFileurl<>$False$ и SaveTf=True, то сохраните изображение.
ArrSaveFileName = Split(RemoteFileurl,.)
SaveFileType=ArrSaveFileName(Ubound(ArrSaveFileName))'Тип файла
RanNum=Int(900*Rnd)+100
SaveFileName = SaveFilePath&год(сейчас)&месяц(сейчас)&день(сейчас)&час(сейчас)&минуту(сейчас)&секунду(сейчас)&ranNum&.&SaveFileType
Вызов SaveRemoteFile(SaveFileName,RemoteFileurl)
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
ElseIf RemoteFileurl<>$False$ и SaveTf=False Тогда «Не сохранять изображение»
SaveFileName=RemoteFileUrl
ConStr=Replace(ConStr,TempArray(Tempi),SaveFileName)
Конец, если
Если RemoteFileUrl<>$False$ Тогда
Если ЗагрузитьФайлы=, то
UploadFiles=SaveFileName
Еще
UploadFiles=ЗагрузитьФайлы & & ИмяФайлаСохранить
Конец, если
Конец, если
Следующий
replaceSaveRemoteFile=ConStr
Конечная функция
'============================================== = =
'Имя процесса: SaveRemoteFile
'Функция: сохранять удаленные файлы на локальном
'Параметр: LocalFileName ------ имя локального файла
'Параметр: RemoteFileUrl ------ URL-адрес удаленного файла
'============================================== = =
sub SaveRemoteFile (LocalFileName, RemoteFileUrl)
тусклые объявления, извлечение, GetRemoteData
Установить получение = Server.CreateObject(Microsoft.XMLHTTP)
С поиском
.Открыть Get, RemoteFileUrl, False, ,
.Отправлять
GetRemoteData = .ResponseBody
Конец с
Установить получение = Ничего
Установить рекламу = Server.CreateObject(Adodb.Stream)
С рекламой
.Тип = 1
.Открыть
.Напишите GetRemoteData
.SaveToFile server.MapPath(LocalFileName),2
.Отмена()
.Закрывать()
Конец с
Установить рекламу = ничего
конец субтитра
'============================================== = =
'Имя процесса: GetImg
'Функция: получить первое изображение в статье.
'Параметр: str ------ содержимое статьи
'Параметр: strpath ------ путь для сохранения изображения
'============================================== = =
Функция GetImg(str,strpath)
установить objregEx = новое RegExp
objregEx.IgnoreCase = правда
objregEx.Global = правда
zzstr=&strpath&(.+?)/.(jpg|gif|png|bmp)
objregEx.Pattern = zzstr
установить совпадения = objregEx.execute(str)
за каждый матч в матчах
retstr = retstr &|& Match.Value
следующий
если retstr<> тогда
Imglist=split(retstr,|)
Imgone = заменить (Imglist (1), strpath,)
GetImg=Убрать
еще
GetImg=
конец, если
конечная функция
%>
Ниже приведены примеры
программный код
Скопируйте код кода следующим образом:
<идентификатор формы=form1 name=form1 метод=post action=?action=test>
<имя текстовой области=тело cols=50 строк=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>
<тип ввода=имя отправки=значение отправки=Отправить/>
</форма>
<%
если request.QueryString(action)=test, то
'Строка, с которой начинается изображение
FilesStartStr=src=
'Строка в конце изображения
FilesOverStr=gif|jpg|bmp
'Папка для сохранения фотографий
FilesPath=qq
'Получите URL-адрес веб-сайта, на котором сохранено изображение, и автоматически определите, является ли это абсолютным или относительным путем. В этом примере изображение является абсолютным адресом, поэтому NEWURL бесполезен, если это ../images/123. gif, вам нужно указать NEWURL.
NewsUrl=http://news.163.com
'Получить содержимое статьи
Содержимое =Request.Form(тело)
'Начни сохранять картинки
Content=ReplaceSaveRemoteFile(Content,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
'Создать миниатюру для первой картинки в новостях
если GetImg(Content,FilesPath)<> то
Imgsrc=GetImg(Содержимое,FilesPath)
Imgsrc = заменить (Imgsrc, FilesPath,)
Установить Jpeg = Server.CreateObject(Persits.Jpeg)
Путь = Server.MapPath(&FilesPath&) & /&Imgsrc&
Jpeg.Открытый путь
«Если ширина изображения меньше или равна 120, а высота меньше или равна 90, миниатюра не будет создана.
если Jpeg.OriginalWidth<=120 и Jpeg.Height<=90, то
Jpeg.Width = Jpeg.OriginalWidth
Jpeg.Height = Jpeg.OriginalHeight
Smallimg=FilesPath&&GetImg(Content,FilesPath)
еще
'Ширина и высота изображения/2
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
Jpeg.Save Server.MapPath(&FilesPath&) & /small_&Imgsrc&
Smallimg=&FilesPath&/small_&Imgsrc&
конец, если
конец, если
'Показать результаты
ответ.Написать(Первая картинка в новости такая:)
response.Write(<img src=&FilesPath&/&GetImg(Content,FilesPath)&>)
response.Write(<br>Миниатюра первой картинки в новости:)
ответ.Write(<img src=&Smallimg&>)
response.Write(<br>Новый новостной контент (изображение локальное):<br>)
Ответ.Запись(Содержимое)
Ответ.Конец()
конец, если
%>