يمكن استخدام هذه الوظيفة أثناء التجميع أو عند إضافة مقالات عبر الإنترنت. يمكن استخدام هذه الوظيفة أثناء التجميع أو عند إضافة مقالات عبر الإنترنت.
يبدو أن الكود الذي بحثت عنه في Baidu لحفظ الصور عن بعد في المنطقة المحلية صعب الاستخدام بعض الشيء، ولا يوجد كود جاهز وكامل لا أستطيع فهمه.
لقد استخرجت بعض الوظائف من نظام جمع الأخبار SNA للإصدار 3.62 (مبرمج بواسطة: ansir) واستخدمتها، وهي بسيطة نسبيًا وسهلة الاستخدام.
فيما يلي الوظيفة
رمز البرنامج
انسخ رمز الكود كما يلي:
<%
'======================================================================== = =
'اسم الوظيفة: CheckDir2
'الوظيفة: التحقق من وجود المجلد
'المعلمة: FolderPath ------ عنوان المجلد
'======================================================================== = =
وظيفة CheckDir2 (byval FolderPath)
خافت
Folderpath=Server.MapPath(.)&/&folderpath
تعيين fso = Server.CreateObject(Scripting.FileSystemObject)
إذا كان fso.FolderExists(FolderPath) إذن
'يخرج
CheckDir2 = صحيح
آخر
"غير موجود."
CheckDir2 = خطأ
انتهي إذا
تعيين fso = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: MakeNewsDir2
'الوظيفة: إنشاء مجلد جديد
'المعلمة: اسم المجلد ------ اسم المجلد
'======================================================================== = =
وظيفة MakeNewsDir2 (اسم المجلد الجانبي)
خافت
تعيين fso = Server.CreateObject(Scripting.FileSystemObject)
fso.CreateFolder(Server.MapPath(.) &/ &foldername)
إذا كان fso.FolderExists(Server.MapPath(.) &/ &foldername) إذن
MakeNewsDir2 = صحيح
آخر
MakeNewsDir2 = خطأ
نهاية إذا
تعيين fso = لا شيء
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: DefiniteUrl
'الوظيفة: تحويل العنوان النسبي إلى العنوان المطلق
'المعلمة: PrimitiveUrl ------ العنوان النسبي المطلوب تحويله
'المعلمة: ConsultUrl ------ عنوان صفحة الويب الحالية
'======================================================================== = =
الدالة DefiniteUrl(Byval PrimitiveUrl,Byval ConsultUrl)
Dim ConTemp،PriTemp،Pi،Ci،PriArray،ConArray
إذا كان PrimitiveUrl= أو ConsultUrl= أو PrimitiveUrl=$False$ إذن
DefiniteUrl=$False$
وظيفة الخروج
نهاية إذا
إذا كان اليسار (ConsultUrl,7)<>HTTP:// واليسار (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)
ElseIf 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=DefiniteUrl & / & 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 & /
نهاية إذا
نهاية إذا
آخر
إذا كان Right(ConsultUrl,1)=/ إذن
DefiniteUrl=ConsultUrl & PrimitiveUrl
آخر
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & PrimitiveUrl
نهاية إذا
نهاية إذا
آخر
إذا Instr(PrimitiveUrl,.)>0 ثم
إذا كان Right(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
نهاية إذا
نهاية إذا
آخر
إذا كان Right(ConsultUrl,1)=/ إذن
DefiniteUrl=ConsultUrl & PrimitiveUrl & /
آخر
DefiniteUrl=Left(ConsultUrl,InstrRev(ConsultUrl,/)) & / & PrimitiveUrl & /
نهاية إذا
نهاية إذا
نهاية إذا
نهاية إذا
إذا Left(DefiniteUrl,1)=/ إذن
DefiniteUrl=Right(DefiniteUrl,Len(DefiniteUrl)-1)
انتهي إذا
إذا DefiniteUrl<> ثم
DefiniteUrl=استبدال(DefiniteUrl,//,/)
DefiniteUrl=Replace(DefiniteUrl,://,://)
آخر
DefiniteUrl=$False$
نهاية إذا
وظيفة النهاية
'======================================================================== = =
'اسم الوظيفة: ReplaceSaveRemoteFile
'الوظيفة: استبدال وحفظ الملفات البعيدة
'المعلمة: سلسلة ConStr ------ المراد استبدالها
'المعلمة: StarStr ----- الرائدة
'المعلمة: OverStr -----
'المعلمة: متضمنة ------
'المعلمة: شاملة ------
'المعلمة: SaveTf ------ ما إذا كان سيتم حفظ الملف أم لا، فالخطأ لا يحفظ، والحفظ صحيح
'المعلمة: مجلد حفظ SaveFilePath
'المعلمة: TistUrl------ عنوان صفحة الويب الحالية
'======================================================================== = =
الوظيفة ReplaceSaveRemoteFile(ConStr,StartStr,OverStr,IncluL,IncluR,SaveTf,SaveFilePath,TistUrl)
إذا كان ConStr=$False$ أو ConStr= إذن
ReplaceSaveRemoteFile=$False$
وظيفة الخروج
نهاية إذا
Dim TempStr,TempStr2,ReF,المطابقات,تطابق,Tempi,TempArray,TempArray2,OverTypeArray
تعيين ReF = Regexp الجديد
ReF.IgnoreCase = صحيح
ReF.Global = صحيح
ReF.Pattern = (&StartStr&).+?(&OverStr&)
تعيين التطابقات =ReF.Execute(ConStr)
لكل مباراة في المباريات
إذا كان Instr(TempStr,Match.Value)=0 إذن
إذا TempStr<> ثم
TempStr=TempStr & $Array$ & Match.Value
آخر
TempStr=Match.Value
انتهي إذا
نهاية إذا
التالي
تعيين التطابقات = لا شيء
تعيين ReF = لا شيء
إذا كان TempStr= أو IsNull(TempStr)=True إذن
ReplaceSaveRemoteFile=ConStr
وظيفة الخروج
انتهي إذا
إذا IncluL=False إذن
TempStr=Replace(TempStr,StartStr,)
انتهي إذا
إذا InclR = خطأ إذن
إذا Instr(OverStr,|)>0 ثم
OverTypeArray=Split(OverStr,|)
بالنسبة لـ Tempi=0 إلى Ubound(OverTypeArray)
TempStr=Replace(TempStr,OverTypeArray(Tempi)،)
التالي
آخر
TempStr=Replace(TempStr,OverStr,)
نهاية إذا
انتهي إذا
TempStr=استبدال(TempStr,,)
TempStr=Replace(TempStr,',)
خافت RemoteFile،RemoteFileurl،SaveFileName،SaveFileType،ArrSaveFileName،RanNum
إذا كان Right(SaveFilePath,1)=/ إذن
SaveFilePath=Left(SaveFilePath,Len(SaveFilePath)-1)
نهاية إذا
إذا SaveTf=صحيح إذن
إذا كان CheckDir2(SaveFilePath)=خطأ إذن
إذا MakeNewsDir2(SaveFilePath)=خطأ إذن
SaveTf=خطأ
نهاية إذا
نهاية إذا
نهاية إذا
SaveFilePath=SaveFilePath & /
'تحويل/حفظ الصور
TempArray=Split(TempStr,$Array$)
بالنسبة إلى Tempi=0 إلى Ubound(TempArray)
RemoteFileurl=DefiniteUrl(TempArray(Tempi),TistUrl)
إذا كان RemoteFileurl<>$False$ وSaveTf=True، فاحفظ الصورة
ArrSaveFileName = سبليت (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 = ثم
UploadFiles=SaveFileName
آخر
UploadFiles=UploadFiles & |.& SaveFileName
انتهي إذا
نهاية إذا
التالي
ReplaceSaveRemoteFile=ConStr
وظيفة النهاية
'======================================================================== = =
'اسم العملية: SaveRemoteFile
'الوظيفة: حفظ الملفات البعيدة إلى الملفات المحلية
'المعلمة: LocalFileName ------ اسم الملف المحلي
'المعلمة: RemoteFileUrl ------ عنوان URL للملف البعيد
'======================================================================== = =
SaveRemoteFile الفرعي (LocalFileName،RemoteFileUrl)
الإعلانات الخافتة، الاسترجاع، GetRemoteData
تعيين الاسترداد = Server.CreateObject(Microsoft.XMLHTTP)
مع الاسترجاع
.فتح الحصول على، RemoteFileUrl، خطأ،،،
.يرسل
GetRemoteData = .ResponseBody
نهاية مع
تعيين الاسترجاع = لا شيء
تعيين الإعلانات = Server.CreateObject(Adodb.Stream)
مع الإعلانات
.النوع = 1
.يفتح
.اكتب GetRemoteData
.SaveToFile server.MapPath(LocalFileName),2
.يلغي()
.يغلق()
نهاية مع
تعيين الإعلانات = لا شيء
النهاية الفرعية
'======================================================================== = =
"اسم العملية: GetImg
'الوظيفة: احصل على الصورة الأولى في المقالة
'المعلمة: str ------ محتوى المقالة
'المعلمة: strpath ------ المسار لحفظ الصورة
'======================================================================== = =
الدالة GetImg(str,strpath)
set objregEx = new RegExp
objregEx.IgnoreCase = true
objregEx.Global = صحيح
zzstr=&strpath&(.+?)/.(jpg|gif|png|bmp)
objregEx.Pattern = zzstr
تعيين التطابقات = objregEx.execute(str)
لكل مباراة في المباريات
retstr = retstr &|& Match.Value
التالي
إذا retstr <> ثم
Imglist=split(retstr,|)
Imgone=replace(Imglist(1),strpath,)
GetImg=Imgone
آخر
GetImg=
نهاية إذا
وظيفة النهاية
%>
فيما يلي أمثلة
رمز البرنامج
انسخ رمز الكود كما يلي:
<معرف النموذج=اسم النموذج1=طريقة النموذج1=إجراء ما بعد=?الإجراء=اختبار>
<اسم منطقة النص = أعمدة الجسم = 50 صفًا = 5 معرف = الجسم>
<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(body)
'ابدأ بحفظ الصور
المحتوى=ReplaceSaveRemoteFile(Content,FilesStartStr,FilesOverStr,False,True,True,FilesPath,NewsUrl)
'قم بإنشاء صورة مصغرة للصورة الأولى في الأخبار
إذا كان GetImg(Content,FilesPath)<> إذن
Imgsrc=GetImg(Content,FilesPath)
Imgsrc=replace(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>الصورة المصغرة للصورة الأولى في الخبر هي :)
استجابة.كتابة(<img src=&Smallimg&>)
Response.Write(<br>محتوى إخباري جديد (الصورة محلية):<br>)
الاستجابة.الكتابة (المحتوى)
الاستجابة. النهاية ()
نهاية إذا
%>