结合FSO操作和Aspjpeg组件写的Class

《结合FSO操作写的一个Class》，尚在完善中,基本功能已具备.也可作为初学者的教程：

程序代码

1. <%  
2. '***************************** CDS系统 FSO操作类 Beta1 *****************************  
3. '调用方法: Set Obj=New FSOControl  
4. '所有路径必须为绝对路径,请采用Server.MapPath方法转换路径后再定义变量  
5. '------ FileRun ---------------------------------------  
6. '  
7. '必选参数:  
8. 'FilePath ------ 处理文件路径  
9. '  
10. '可选参数:  
11. 'FileAllowType ------ 处理文件允许的类型,定义方法例: gif|jpg|png|txt  
12. 'FileNewDir ------ 文件处理后保存到的目录  
13. 'FileNewName ------ 新文件名前缀,请不要添加后缀, 例: sample.txt 则为 sample  
14. 'CoverPr ------ 是否覆盖已有的文件 0为否 1为是 默认为1  
15. 'deletePr ------ 是否删除原文件 0为否 1为是 默认为1  
16. '---------------------------------------------------------  
17.  
18. '------ UpDir(path) 取path的父目录  
19. 'path可为文件,也可为目录  
20.  
21. '------ GetPrefixName(path) 取文件名前缀  
22. 'path必须为文件,可为完整路径,也可是单独文件名  
23.  
24. '------ GetFileName(path) 取文件名  
25. 'path必须为文件,可为完整路径,也可是单独文件名  
26.  
27. '------ GetExtensionName(path) 取文件名后缀,不包含"."  
28. 'path必须为文件,可为完整路径,也可是单独文件名  
29.  
30. '------ FileIs(path) path是否为一文件  
31. '如为,返回 true 否则返回 false  
32. '------ FolderCreat(Path)  
33. '------ Folderdelete(Path,FileIF)  
34. '------ FileCopy(Path_From,Path_To,CoverIF)  
35. '------ FileMove(Path_From,Path_To,CoverIF)  
36. '------ Filedelete(Path)  
37. '------ Filerename(OldName,NewName,CoverIf)  
38.  
39. Class FSOControl  
40.  
41. Dim FSO  
42. Private File_Path,File_AllowType,File_NewFolder_Path,File_NewName,File_CoverIf,File_deleteIf  
43. Public Property Let FilePath(StrType)  
44. File_Path=StrType  
45. End Property  
46. Public Property Let FileAllowType(StrType)  
47. File_AllowType=StrType  
48. End Property  
49. Public Property Let FileNewDir(StrType)  
50. File_NewFolder_Path=StrType  
51. End Property  
52. Public Property Let FileNewName(StrType)  
53. File_NewName=StrType  
54. End Property  
55. Public Property Let CoverPr(LngSize)  
56. If isNumeric(LngSize) then  
57. File_CoverIf=Clng(LngSize)  
58. End If  
59. End Property  
60. Public Property Let deletePr(LngSize)  
61. If isNumeric(LngSize) then  
62. File_deleteIf=Clng(LngSize)  
63. End If  
64. End Property  
65.  
66. Private Sub Class_Initialize()  
67. Set FSO=createObject("Scripting.FileSystemObject")   
68. File_Path=""  
69. File_AllowType="gif|jpg|png|txt"  
70. File_NewFolder_Path=""  
71. File_NewName=""  
72. File_CoverIf=1  
73. File_deleteIf=0  
74. End Sub   
75. Private Sub Class_Terminate()  
76. Err.Clear  
77. Set FSO=Nothing  
78. End Sub  
79.  
80.  
81. Public Function UpDir(ByVal D)  
82. If Len(D) = 0 then  
83. UpDir=""  
84. Else  
85. UpDir=Left(D,InStrRev(D,"\")-1)  
86. End If  
87. End Function  
88. Public Function GetPrefixName(ByVal D)  
89. If Len(D) = 0 then  
90. GetPrefixName=""  
91. Else  
92. FileName=GetFileName(D)  
93. GetPrefixName=Left(FileName,InStrRev(FileName,".")-1)  
94. End If  
95. End Function  
96. Public Function GetFileName(name)  
97. FileName=Split(name,"\")  
98. GetFileName=FileName(Ubound(FileName))  
99. End Function  
100. Public Function GetExtensionName(name)  
101. FileName=Split(name,".")  
102. GetExtensionName=FileName(Ubound(FileName))  
103. End Function  
104. Public Function FileIs(Path)  
105. If fso.FileExists(Path) then  
106. FileIs=true  
107. Else  
108. FileIs=false  
109. End If  
110. End Function  
111.  
112. Public Function FileOpen(Path,NewFile,ReadAction,LineCount)  
113. If FileIs(Path)=False then  
114. If NewFile<>1 then  
115. FileOpen=False  
116. ElseIf FolderIs(UpDir(Path))=False then  
117. FileOpen=False  
118. Exit Function  
119. Else  
120. fso.OpenTextFile Path,1,True  
121. FileOpen=""  
122. End If  
123. Exit Function  
124. End If  
125. Set FileOption=fso.GetFile(Path)  
126. If FileOption.size=0 then  
127. Set FileOption=Nothing  
128. FileOpen=""  
129. Exit Function  
130. End If  
131. Set FileOption=Nothing  
132. Set FileText=fso.OpenTextFile(Path,1)  
133. If IsNumeric(ReadAction) then  
134. FileOpen=FileText.Read(ReadAction)  
135. ElseIf Ucase(ReadAction)="ALL" then  
136. FileOpen=FileText.ReadAll()  
137. ElseIf Ucase(ReadAction)="LINE" then  
138. If Not(IsNumeric(LineCount)) or LineCount=0 then  
139. FileOpen=False  
140. Set FileText=Nothing  
141. Exit Function  
142. Else  
143. i=0  
144. Do While Not FileText.AtEndOfStream  
145. FileOpen=FileOpen&FileText.ReadLine  
146. i=i+1  
147. If i=LineCount then Exit Do  
148. Loop  
149. End If  
150. End If  
151. Set FileText=Nothing   
152. End Function  
153.  
154. Public Function FileWrite(Path,WriteStr,NewFile)  
155. If FolderIs(UpDir(Path))=False then  
156. FileWrite=False  
157. Exit Function  
158. ElseIf FileIs(Path)=False and NewFile<>1 then  
159. FileWrite=False  
160. Exit Function  
161. End If  
162. Set FileText=fso.OpenTextFile(Path,2,True)  
163. FileText.Write WriteStr  
164. Set FileText=Nothing  
165. FileWrite=True  
166. End Function  
167.  
168. Public Function FolderIs(Path)  
169. If fso.FolderExists(Path) then  
170. FolderIs=true  
171. Else  
172. FolderIs=false  
173. End If  
174. End Function  
175. Public Function FolderCreat(Path)  
176. If fso.FolderExists(Path) then  
177. FolderCreat="指定要创建目录已存在"  
178. Exit Function  
179. ElseIf Not(fso.FolderExists(UpDir(Path))) then  
180. FolderCreat="指定要创建的目录路径错误"  
181. Exit Function  
182. End If  
183. fso.createFolder(Path)  
184. FolderCreat=True  
185. End Function  
186. Public Function Folderdelete(Path,FileIF)  
187. If Not(fso.FolderExists(Path)) then  
188. Folderdelete="指定要删除的目录不存在"  
189. Exit Function  
190. End If  
191. If FileIF=1 then  
192. Set FsoFile = Fso.GetFolder(Path)  
193. If(FsoFile.SubFolders.count>0 or FsoFile.Files.count>0) then  
194. Set FsoFile=Nothing  
195. Folderdelete="只要要删除的目录下含有文件或子目录,不允许删除"  
196. Exit Function  
197. End If  
198. Set FsoFile=Nothing  
199. End If  
200. Fso.deleteFolder(Path)  
201. Folderdelete=True  
202. End Function  
203. Public Function FileCopy(Path_From,Path_To,CoverIF)  
204. If Not(fso.FileExists(Path_From)) then  
205. FileCopy="指定要复制的文件不存在"  
206. Exit Function  
207. ElseIf Not(fso.FolderExists(UpDir(Path_To))) then  
208. FileCopy="指定要复制到的目录不存在"  
209. Exit Function  
210. End If  
211. If CoverIF=0 and fso.FileExists(Path_To) then  
212. FileCopy="指定要复制到的目录下已存在相同名称文件,不允许覆盖"  
213. Exit Function  
214. End If  
215. fso.CopyFile Path_From,Path_To  
216. FileCopy=True  
217. End Function  
218. Public Function FileMove(Path_From,Path_To,CoverIF)  
219. If Not(fso.FileExists(Path_From)) then  
220. FileMove="指定要移动的文件不存在"  
221. Exit Function  
222. ElseIf Not(fso.FolderExists(UpDir(Path_To))) then  
223. FileMove="指定要移动到的目录不存在"  
224. Exit Function  
225. End If  
226. If fso.FileExists(Path_To) then  
227. If CoverIF=0 then  
228. FileMove="指定要移动到的目录下已存在相同名称文件,不允许覆盖"  
229. Exit Function  
230. Else  
231. Call Filedelete(Path_To)  
232. End If  
233. End If  
234. fso.MoveFile Path_From,Path_To  
235. FileMove=True  
236. End Function  
237. Public Function Filedelete(Path)  
238. If Not(fso.FileExists(Path)) then  
239. Filedelete="指定要删除的文件不存在"  
240. Exit Function  
241. End If  
242. Fso.deleteFile Path  
243. Filedelete=True  
244. End Function  
245. Public Function Filerename(OldName,NewName,CoverIf)  
246. NewName=NewName&"."&GetExtensionName(OldName)  
247. If GetFileName(OldName)=NewName then  
248. Filerename="更改前的文件与更改后的文件名称相同"  
249. Exit Function  
250. ElseIf Not(fso.FileExists(OldName)) then  
251. Filerename="指定更改名称的文件不存在"  
252. Exit Function  
253. ElseIf fso.FileExists(UpDir(OldName)&"\"&NewName) then  
254. If CoverIf=0 then  
255. Filerename="目录下已存在与更改后的文件名称相同的文件,不允许覆盖"  
256. Exit Function  
257. Else  
258. Call Filedelete(UpDir(OldName)&"\"&NewName)  
259. End If  
260. End If  
261. Set FsoFile=fso.GetFile(OldName)  
262. FsoFile.Name=NewName  
263. Set FsoFile=Nothing  
264. Filerename=True  
265. End Function  
266.  
267. Public Function FileRun()  
268. If File_NewFolder_Path="" and File_NewName="" then  
269. FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"  
270. Exit Function  
271. ElseIf File_Path="" or Not(fso.FileExists(File_Path)) then  
272. FileRun="要进行操作的文件不存在"  
273. Exit Function  
274. ElseIf Instr(File_AllowType,GetExtensionName(File_Path))=0 then  
275. FileRun="要进行操作的文件被系统拒绝,允许的格式为: "&Replace(File_AllowType,"|"," ")  
276. Exit Function  
277. End If  
278.  
279. If File_NewFolder_Path="" then  
280. File_NewFolder_Path=UpDir(File_Path)  
281. ElseIf Not(fso.FolderExists(File_NewFolder_Path)) then  
282. FileRun="指定要移动到的目录不存在"  
283. Exit Function  
284. End If  
285. If Right(File_NewFolder_Path,1)<>"\" then File_NewFolder_Path=File_NewFolder_Path&"\"  
286. If File_NewName="" then  
287. File_NewPath=File_NewFolder_Path&GetFileName(File_Path)  
288. Else  
289. File_NewPath=File_NewFolder_Path&File_NewName&"."&GetExtensionName(File_Path)  
290. End If  
291. If File_Path=File_NewPath then  
292. FileRun="此操作执行后并未对指定文件产生变动,系统自动中止"  
293. Exit Function  
294. ElseIf UpDir(File_Path)<>UpDir(File_NewPath) then  
295. If File_deleteIf=1 then  
296. Call FileMove(File_Path,File_NewPath,File_CoverIf)  
297. Else  
298. Call FileCopy(File_Path,File_NewPath,File_CoverIf)  
299. End If  
300. FileRun=True  
301. Else  
302. 'If File_deleteIf=1 then  
303. Call Filerename(File_Path,GetPrefixName(File_NewPath),File_CoverIf)  
304. 'Else  
305. ' Call FileCopy(File_Path,File_NewPath,File_CoverIf)  
306. 'End If  
307. FileRun=True  
308. End If  
309. End Function  
310. End Class  
311. %>   
312.  
313.  
314. 《ASPJPEG综合操作CLASS》  
315. >>>---------我想分页！--这么长的文章，在这里来个分页多好啊！哈哈----------<<<  
316. 《ASPJPEG综合操作CLASS》  
317. 基本上能实现ASPJPEG的所有功能  
318. 代码有详细注释,还不懂的请提出  
319.  
320. 有建议及更多功能提议的请提出  
321.  
322. 谢谢  
323.  
324.  程序代码  
325. <%  
326. 'ASPJPEG综合操作CLASS  
327. 'Authour: tony 05/09/05  
328. Class AspJpeg  
329. Dim AspJpeg_Obj,obj  
330. Private Img_MathPath_From,Img_MathPath_To,Img_Reduce_Size,CoverIf  
331. Private Img_Frame_Size,Img_Frame_Color,Img_Frame_Solid,Img_Frame_Width,Img_Frame_Height  
332. Private Img_Font_Content,Img_Font_Family,Img_Font_Color,Img_Font_Quality,Img_Font_Size,Img_Font_Bold,Img_Font_X,Img_Font_Y  
333. Private Img_PicIn_Path,Img_PicIn_X,Img_PicIn_Y  
334. '--------------取原文件路径  
335. Public Property Let MathPathFrom(StrType)  
336. Img_MathPath_From=StrType  
337. End Property  
338.  
339. '--------------取文件保存路径  
340. Public Property Let MathPathTo(strType)  
341. Img_MathPath_To=strType  
342. End Property  
343.  
344. '--------------保存文件时是否覆盖已有文件  
345. Public Property Let CovePro(LngSize)  
346. If LngSize=0 or LngSize=1 or LngSize=true or LngSize=false then  
347. CoverIf=LngSize  
348. End If  
349. End Property  
350.  
351. '---------------取缩略图/放大图 缩略值  
352. Public Property Let ReduceSize(LngSize)  
353. If isNumeric(LngSize) then  
354. Img_Reduce_Size=LngSize  
355. End If  
356. End Property  
357.  
358. '---------------取描边属性  
359. '边框粗细  
360. Public Property Let FrameSize(LngSize)  
361. If isNumeric(LngSize) then  
362. Img_Frame_Size=Clng(LngSize)  
363. End If  
364. End Property  
365. '边框宽度  
366. Public Property Let FrameWidth(LngSize)  
367. If isNumeric(LngSize) then  
368. Img_Frame_Width=Clng(LngSize)  
369. End If  
370. End Property  
371. '边框高度  
372. Public Property Let FrameHeight(LngSize)  
373. If isNumeric(LngSize) then  
374. Img_Frame_Height=Clng(LngSize)  
375. End If  
376. End Property  
377. '边框颜色  
378. Public Property Let FrameColor(strType)  
379. If strType<>"" then  
380. Img_Frame_Color=strType  
381. End If  
382. End Property  
383. '边框是否加粗  
384. Public Property Let FrameSolid(LngSize)  
385. If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then  
386. Img_Frame_Solid=LngSize  
387. End If  
388. End Property  
389.  
390. '---------------取插入文字属性  
391. '插入的文字  
392. Public Property Let Content(strType)  
393. If strType<>"" then  
394. Img_Font_Content=strType  
395. End If  
396. End Property  
397. '文字字体  
398. Public Property Let FontFamily(strType)  
399. If strType<>"" then  
400. Img_Font_Family=strType  
401. End If  
402. End Property  
403. '文字颜色  
404. Public Property Let FontColor(strType)  
405. If strType<>"" then  
406. Img_Font_Color=strType  
407. End If  
408. End Property  
409. '文字品质  
410. Public Property Let FontQuality(LngSize)  
411. If isNumeric(LngSize) then  
412. Img_Font_Quality=Clng(LngSize)  
413. End If  
414. End Property  
415. '文字大小  
416. Public Property Let FontSize(LngSize)  
417. If isNumeric(LngSize) then  
418. Img_Font_Size=Clng(LngSize)  
419. End If  
420. End Property  
421. '文字是否加粗  
422. Public Property Let FontBold(LngSize)  
423. If LngSize=1 or LngSize=0 or LngSize=true or LngSize=false then  
424. Img_Font_Bold=LngSize  
425. End If  
426. End Property  
427. '输入文字的X坐标  
428. Public Property Let FontX(LngSize)  
429. If isNumeric(LngSize) then  
430. Img_Font_X=Clng(LngSize)  
431. End If  
432. End Property  
433. '输入文字的Y坐标  
434. Public Property Let FontY(LngSize)  
435. If isNumeric(LngSize) then  
436. Img_Font_Y=Clng(LngSize)  
437. End If  
438. End Property  
439.  
440. '---------------取插入图片属性  
441. '插入图片的路径  
442. Public Property Let PicInPath(strType)  
443. Img_PicIn_Path=strType  
444. End Property  
445. '图片插入的X坐标  
446. Public Property Let PicInX(LngSize)  
447. If isNumeric(LngSize) then  
448. Img_PicIn_X=Clng(LngSize)  
449. End If  
450. End Property  
451. '图片插入的Y坐标  
452. Public Property Let PicInY(LngSize)  
453. If isNumeric(LngSize) then  
454. Img_PicIn_Y=Clng(LngSize)  
455. End If  
456. End Property  
457.  
458.  
459. Private Sub Class_Initialize()  
460. Set AspJpeg_Obj=createObject("Persits.Jpeg")   
461. Img_MathPath_From=""  
462. Img_MathPath_To=""  
463. Img_Reduce_Size=150  
464. Img_Frame_Size=1  
465. 'Img_Frame_Width=0  
466. 'Img_Frame_Height=0  
467. 'Img_Frame_Color="&H000000"  
468. 'Img_Frame_Bold=false  
469. Img_Font_Content="GoldenLeaf"  
470. 'Img_Font_Family="Arial"  
471. 'Img_Font_Color="&H000000"  
472. Img_Font_Quality=3  
473. Img_Font_Size=14  
474. 'Img_Font_Bold=False  
475. Img_Font_X=10  
476. Img_Font_Y=5  
477. 'Img_PicIn_X=0  
478. 'Img_PicIn_Y=0  
479. CoverIf=1  
480.  
481. End Sub   
482. Private Sub Class_Terminate()  
483. Err.Clear  
484. Set AspJpeg_Obj=Nothing  
485. End Sub  
486. '判断文件是否存在  
487. Private Function FileIs(path)  
488. Set fsos=Server.createObject("Scripting.FileSystemObject")  
489. FileIs=fsos.FileExists(path)  
490. Set fsos=Nothing  
491. End Function  
492.  
493. '判断目录是否存在  
494. Private Function FolderIs(path)  
495. Set fsos=Server.createObject("Scripting.FileSystemObject")  
496. FolderIs=fsos.FolderExists(path)  
497. Set fsos=Nothing  
498. End Function  
499. '*******************************************  
500. '函数作用：取得当前文件的上一级路径  
501. '*******************************************  
502. Private Function UpDir(ByVal D)  
503. If Len(D) = 0 then  
504. UpDir=""  
505. Else  
506. UpDir=Left(D,InStrRev(D,"\")-1)  
507. End If  
508. End Function  
509.  
510. Private Function Errors(Errors_id)  
511. select Case Errors_id  
512. Case "0"  
513. Errors="指定文件不存在"  
514. Case 1  
515. Errors="指定目录不存在"  
516. Case 2  
517. Errors="已存在相同名称文件"  
518. Case 3  
519. Errors="参数溢出"  
520. End select  
521. End Function  
522.  
523.  
524. '取图片宽度  
525. Public Function ImgInfo_Width(Img_MathPath)  
526. If Not(FileIs(Img_MathPath)) then  
527. 'Exit Function  
528. ImgInfo_Width=Errors(0)  
529. Else  
530. AspJpeg_Obj.Open Img_MathPath  
531. ImgInfo_Width=AspJpeg_Obj.width  
532. End If  
533. End Function  
534. '取图片高度  
535. Public Function ImgInfo_Height(Img_MathPath)  
536. If Not(FileIs(Img_MathPath)) then  
537. 'Exit Function  
538. ImgInfo_Height=Errors(0)  
539. Else  
540. AspJpeg_Obj.Open Img_MathPath  
541. ImgInfo_Height=AspJpeg_Obj.height  
542. End If  
543. End Function  
544. '生成缩略图/放大图  
545. Public Function Img_Reduce()  
546. If Not(FileIs(Img_MathPath_From)) then  
547. Img_Reduce=Errors(0)  
548. Exit Function  
549. End If  
550. If Not(FolderIs(UpDir(Img_MathPath_To))) then  
551. Img_Reduce=Errors(1)  
552. Exit Function  
553. End If  
554. If CoverIf=0 or CoverIf=False then  
555. If FileIs(Img_MathPath_To) then  
556. Img_Reduce=Errors(2)  
557. Exit Function  
558. End If  
559. End If  
560. AspJpeg_Obj.Open Img_MathPath_From  
561. AspJpeg_Obj.PreserveAspectRatio = True  
562. If AspJpeg_Obj.OriginalWidth>AspJpeg_Obj.OriginalHeight Then  
563. AspJpeg_Obj.Width=Img_Reduce_Size  
564. Else  
565. AspJpeg_Obj.Height=Img_Reduce_Size  
566. End If  
567. If AspJpeg_Obj.OriginalWidth>Img_Reduce_Size or AspJpeg_Obj.OriginalHeight>Img_Reduce_Size Then  
568. If AspJpeg_Obj.Width<Img_Reduce_Size or AspJpeg_Obj.Height<Img_Reduce_Size then  
569. Set AspJpeg_Obj_New=createObject("Persits.Jpeg")  
570. AspJpeg_Obj_New.new Img_Reduce_Size,Img_Reduce_Size,&HFFFFFF  
571. AspJpeg_Obj_New.DrawImage (150-AspJpeg_Obj.width)/2,(150-AspJpeg_Obj.height)/2,AspJpeg_Obj  
572. If Img_Frame_Size>0 then  
573. Call Img_Pen(AspJpeg_Obj_New)  
574. End If  
575. If Img_Font_Content<>"" then  
576. Img_Font_X=AspJpeg_Obj_New.Width/2  
577. Img_Font_Y=AspJpeg_Obj_New.Height-15  
578. Call Img_Font(AspJpeg_Obj_New)  
579. End If  
580. AspJpeg_Obj_New.Sharpen 1, 130  
581. AspJpeg_Obj_New.Save Img_MathPath_To  
582. Set AspJpeg_Obj_New=Nothing  
583. Else  
584. If Img_Frame_Size>0 then  
585. Call Img_Pen(AspJpeg_Obj)  
586. End If  
587. If Img_Font_Content<>"" then  
588. Img_Font_X=AspJpeg_Obj.Width/2  
589. Img_Font_Y=AspJpeg_Obj.Height-15  
590. Call Img_Font(AspJpeg_Obj)  
591. End If  
592. AspJpeg_Obj.Sharpen 1, 130  
593. AspJpeg_Obj.Save Img_MathPath_To  
594. End If  
595. Else  
596. If Img_Frame_Size>0 then  
597. Call Img_Pen(AspJpeg_Obj)  
598. End If  
599. If Img_Font_Content<>"" then  
600. Img_Font_X=AspJpeg_Obj.Width/2  
601. Img_Font_Y=AspJpeg_Obj.Height-15  
602. Call Img_Font(AspJpeg_Obj)  
603. End If  
604. AspJpeg_Obj.Sharpen 1, 130  
605. AspJpeg_Obj.Save Img_MathPath_To  
606. End If  
607. End Function  
608. '生成水印  
609. Public Function Img_WaterMark()  
610. If Not(FileIs(Img_MathPath_From)) then  
611. Img_WaterMark=Errors(0)  
612. Exit Function  
613. End If  
614. If Img_MathPath_To="" then  
615. Img_MathPath_To=Img_MathPath_From  
616. ElseIf Not(FolderIs(UpDir(Img_MathPath_To))) then  
617. Img_WaterMark=Errors(1)  
618. Exit Function  
619. End If  
620. If CoverIf=0 or CoverIf=false then  
621. If Img_MathPath_To<>Img_MathPath_From and FileIs(Img_MathPath_To) then  
622. Img_WaterMark=Errors(2)  
623. Exit Function  
624. End If  
625. End If  
626. AspJpeg_Obj.Open Img_MathPath_From  
627. If Img_PicIn_Path<>"" then  
628. If Not(FileIs(Img_PicIn_Path)) then  
629. Img_WaterMark=Errors(0)  
630. Exit Function  
631. End If  
632. Set AspJpeg_Obj_New=createObject("Persits.Jpeg")  
633. AspJpeg_Obj_New.Open Img_PicIn_Path  
634. AspJpeg_Obj.PreserveAspectRatio = True  
635. AspJpeg_Obj_New.PreserveAspectRatio = True  
636. If AspJpeg_Obj.OriginalWidth<Img_Reduce_Size or AspJpeg_Obj.OriginalHeight<Img_Reduce_Size then  
637. Img_WaterMark=Errors(3)  
638. Exit Function  
639. End If  
640. If AspJpeg_Obj_New.OriginalWidth>AspJpeg_Obj_New.OriginalHeight Then  
641. AspJpeg_Obj_New.Width=Img_Reduce_Size  
642. Else  
643. AspJpeg_Obj_New.Height=Img_Reduce_Size  
644. End If  
645. If Img_PicIn_X="" then Img_PicIn_X=AspJpeg_Obj.Width-AspJpeg_Obj_New.Width  
646. If Img_PicIn_Y="" then Img_PicIn_Y=AspJpeg_Obj.Height-AspJpeg_Obj_New.Height  
647. AspJpeg_Obj.DrawImage Img_PicIn_X,Img_PicIn_Y,AspJpeg_Obj_New  
648. Set AspJpeg_Obj_New=Nothing  
649. End If  
650. If Img_Frame_Size>0 then  
651. Call Img_Pen(AspJpeg_Obj)  
652. End If  
653. If Img_Font_Content<>"" then  
654. Call Img_Font(AspJpeg_Obj)  
655. End If  
656. 'AspJpeg_Obj.Sharpen 1, 130  
657. AspJpeg_Obj.Save Img_MathPath_To  
658. End Function  
659. '生成框架  
660. Private Function Img_Pen(Obj)  
661. If Img_Frame_Width=0 then Img_Frame_Width=Obj.Width  
662. If Img_Frame_Height=0 then Img_Frame_Height=Obj.Height  
663. Obj.Canvas.Pen.Color = Img_Frame_Color  
664. Obj.Canvas.Pen.Width = Img_Frame_Size  
665. Obj.Canvas.Brush.Solid = Img_Frame_Solid  
666. Obj.Canvas.Bar 1,1,Img_Frame_Width,Img_Frame_Height  
667. End Function  
668. '生成水印字  
669. Private Function Img_Font(Obj)  
670. Obj.Canvas.Font.Color = Img_Font_Color   
671. Obj.Canvas.Font.Family = Img_Font_Family   
672. Obj.Canvas.Font.Quality=Img_Font_Quality  
673. Obj.Canvas.Font.Size=Img_Font_Size  
674. Obj.Canvas.Font.Bold = Img_Font_Bold   
675. Obj.Canvas.Print Img_Font_X,Img_Font_Y,Img_Font_Content  
676. End Function  
677. End Class  
678.  
679. %>