?% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// ? ? 朱煊(zx.asd) '// 版权所? RainbowSoft Studio '// 技术支? rainbowsoft@163.com '// 程序名称: '// 程序版本: '// 单元名称: c_option.asp '// 开始时? 2004.07.25 '// 最后修? '// ? ? 设置模块 '/////////////////////////////////////////////////////////////////////////////// '-------------------------------------------------------------------- Const adOpenForwardOnly=0 Const adOpenKeyset=1 Const adOpenDynamic=2 Const adOpenStatic=3 Const adLockReadOnly=1 Const adLockPessimistic=2 Const adLockOptimistic=3 Const adLockBatchOptimistic=4 Const ForReading=1 Const ForWriting=2 Const ForAppending=8 Const adTypeBinary=1 Const adTypeText=2 Const adModeRead=1 Const adModeReadWrite=3 Const adSaveCreateNotExist=1 Const adSaveCreateOverWrite=2 '-------------------------------------------------------------------- '-------------------------------------------------------------------- Const ZC_BLOG_CLSID="16F66077-938D-46CD-E326-0CE67E6104B0" Const ZC_BLOG_WEBEDIT="fckeditor" Const ZC_TIME_ZONE="+0800" Const ZC_MSG_COUNT=10 Const ZC_ARCHIVE_COUNT=0 Const ZC_PREVIOUS_COUNT=14 Const ZC_DISPLAY_COUNT=10 Const ZC_MUTUALITY_COUNT=10 Const ZC_MANAGE_COUNT=50 Const ZC_RSS2_COUNT=10 Const ZC_SEARCH_COUNT=25 Const ZC_PAGEBAR_COUNT=14 Const ZC_IMAGE_WIDTH=520 Const ZC_REBUILD_FILE_COUNT=50 Const ZC_REBUILD_FILE_INTERVAL=5 Const ZC_AUTO_NEWLINE=True Const ZC_JAPAN_TO_HTML=False Const ZC_USE_NAVIGATE_ARTICLE=True Const ZC_COMMENT_TURNOFF=False Const ZC_TRACKBACK_TURNOFF=False Const ZC_COMMENT_VERIFY_ENABLE=True Const ZC_COMMENT_NOFOLLOW_ENABLE=True Const ZC_RSS_EXPORT_WHOLE=False Const ZC_UBB_LINK_ENABLE=True Const ZC_UBB_FONT_ENABLE=True Const ZC_UBB_CODE_ENABLE=True Const ZC_UBB_FACE_ENABLE=True Const ZC_UBB_IMAGE_ENABLE=True Const ZC_UBB_MEDIA_ENABLE=True Const ZC_UBB_FLASH_ENABLE=True Const ZC_UBB_TYPESET_ENABLE=True Const ZC_UBB_AUTOLINK_ENABLE=True Const ZC_UBB_AUTOKEY_ENABLE=False Const ZC_EMOTICONS_FILENAME="Haha|Hehe|Love|Misdoubt|Music|Nothing_to_say|Sad|Shame|Sleep|Smile|Stop|What|Adore|After_boom|Angry|Cool|Cry|Effort|Faint|Grimace" Const ZC_EMOTICONS_FILESIZE=48 Const ZC_UPLOAD_FILETYPE="jpg|gif|png|jpeg|bmp|psd|wmf|ico|rpm|deb|tar|gz|sit|7z|bz2|zip|rar|xml|xsl|svg|svgz|doc|xls|wps|chm|txt|pdf|mp3|avi|mpg|rm|ra|rmvb|mov|wmv|wma|swf|fla|torrent" Const ZC_UPLOAD_FILESIZE=1048576 Const ZC_DISPLAY_MODE_ALL=1 Const ZC_DISPLAY_MODE_INTRO=2 Const ZC_DISPLAY_MODE_HIDE=3 Const ZC_DISPLAY_MODE_LIST=4 Const ZC_DISPLAY_MODE_ONTOP=5 Const ZC_DISPLAY_MODE_SEARCH=6 Const ZC_USERNAME_MAX=20 Const ZC_PASSWORD_MAX=32 Const ZC_EMAIL_MAX=30 Const ZC_HOMEPAGE_MAX=100 Const ZC_CONTENT_MAX=1000 Const ZC_TB_EXCERPT_MAX=250 Const ZC_RECENT_COMMENT_WORD_MAX=16 Const ZC_COMMENT_REVERSE_ORDER_EXPORT=False Const ZC_GUEST_REVERT_COMMENT_ENABLE=False '{%post%},{%category%},{%user%},{%year%},{%month%},{%day%},{%id%},{%alias%}之间的组?可以?分隔 Const ZC_CUSTOM_DIRECTORY_ENABLE=False Const ZC_CUSTOM_DIRECTORY_REGEX="{%post%}" Const ZC_CUSTOM_DIRECTORY_ANONYMOUS=False Const ZC_MOONSOFT_PLUGIN_ENABLE=False Const ZC_MOONSOFT_PLUGIN_REGEX="{%post%}" Const ZC_MOONSOFT_PLUGIN_ANONYMOUS=False Const ZC_GUESTBOOK_CONTENT="" Const ZC_UPDATE_INFO_URL="http://update.rainbowsoft.org/info/" '-------------------------------------------------------------------- Const ZC_IE_DISPLAY_WAP=False Const ZC_DISPLAY_COUNT_WAP=2 Const ZC_COMMENT_COUNT_WAP=3 Const ZC_PAGEBAR_COUNT_WAP=5 Const ZC_SINGLE_SIZE_WAP=100 Const ZC_SINGLE_PAGEBAR_COUNT_WAP=5 Const ZC_COMMENT_PAGEBAR_COUNT_WAP=5 Const ZC_FILENAME_WAP="wap.asp" '-------------------------------------------------------------------- '{asp html shtml} Const ZC_STATIC_TYPE="html" Const ZC_STATIC_DIRECTORY="post" Const ZC_TEMPLATE_DIRECTORY="template" Const ZC_UPLOAD_DIRECTORY="upload" Const ZC_BLOG_VERSION="1.7 Laputa Build 70216" Const ZC_BLOG_LANGUAGE="zh-CN" '-------------------------------------------------------------------- %> ?% '网站基本设置 Const ZC_DATABASE_PATH="data/#%20183b7213be77a4109d20.mdb" Const ZC_BLOG_HOST="http://www.chahua.com.cn/blog/" '-------------------------------------------------------------------- Const ZC_BLOG_TITLE="北京汇艺新天地插花博? Const ZC_BLOG_SUBTITLE="汇艺插花" Const ZC_BLOG_NAME="插花博客" Const ZC_BLOG_SUB_NAME="北京汇艺新天? Const ZC_BLOG_CSS="default" Const ZC_BLOG_COPYRIGHT="Copyright www.chahua.com.cn Some Rights Reserved" Const ZC_BLOG_MASTER="admin" '-------------------------------------------------------------------- %> ?% '自定义信? Const ZC_MSG001="名称" Const ZC_MSG002="密码" Const ZC_MSG003="用户" Const ZC_MSG004="保存" Const ZC_MSG005="不保? Const ZC_MSG006="保存1? Const ZC_MSG007="保存1? Const ZC_MSG008="保存1? Const ZC_MSG009="管理登录" Const ZC_MSG010="用户?密码不能为空" Const ZC_MSG011="发布" Const ZC_MSG012="分类" Const ZC_MSG013="评论" Const ZC_MSG014="引用" Const ZC_MSG015="查看" Const ZC_MSG016="摘要" Const ZC_MSG017="Please input your website url." Const ZC_MSG018="来宾" Const ZC_MSG019="登录%s验证身份%s登出%s后台管理%s发表评论%s传送引?s查看权限%s索引重建%s文章重建%s管理文章%s编辑文章%s发布文章%s删除文章%s管理分类%s修改分类%s删除分类%s管理评论%s删除评论%s回复评论%s管理引用%s删除引用%s发送引?s管理用户%s修改用户%s创建用户%s删除用户%s附件管理%s附件上传%s附件删除%s站内搜索%sTag管理%sTag编辑%sTag保存%sTag删除%s网站设置管理%s网站设置保存%s插件管理%s查看RSS和ATOM输出%s站内文件管理%s站内文件编辑%s站内文件保存%s站内文件删除%s超级管理%s" Const ZC_MSG020="登出" Const ZC_MSG021="查看权限" Const ZC_MSG022="管理" Const ZC_MSG023="您好,%s" Const ZC_MSG024="发表评论" Const ZC_MSG025="控制面板"'ControlPanel Const ZC_MSG026="网站目录"'Categories Const ZC_MSG027="最新评论及回复"'Comments Const ZC_MSG028="文章归档"'Archives Const ZC_MSG029="站点统计"'Blog Statistics Const ZC_MSG030="网站收藏"'Favorites Const ZC_MSG031="友情链接"'Linkage Const ZC_MSG032="最近发?'Previous Const ZC_MSG033="名称或邮箱不能为? Const ZC_MSG034="名称或邮箱格式不? Const ZC_MSG035="留言不能为空或过? Const ZC_MSG036="?s? Const ZC_MSG037="UBB标签" Const ZC_MSG038="密码不能小于6? Const ZC_MSG039="图标汇集"'Misc Const ZC_MSG040="◎欢迎参与讨论,请在这里发表您的看法、交流您的观点? Const ZC_MSG041="大小" Const ZC_MSG042="分页" Const ZC_MSG043="文章已隐藏,请先登录" Const ZC_MSG044="-" Const ZC_MSG045="错误提示" Const ZC_MSG046="管理" Const ZC_MSG047="文章编辑" Const ZC_MSG048="文章" Const ZC_MSG049="记住?下次回复时不用重新输入个人信? Const ZC_MSG050="日历"'Calendar Const ZC_MSG051="置顶" Const ZC_MSG052="导航"'Navigation Const ZC_MSG053="邮箱" Const ZC_MSG054="网站链接" Const ZC_MSG055="正文" Const ZC_MSG056="留言最长字? Const ZC_MSG057="显示UBB表情>>" Const ZC_MSG058="单击“确定”继续。单击“取消”停止? Const ZC_MSG059="HTML标签" Const ZC_MSG060="标题" Const ZC_MSG061="类型" Const ZC_MSG062="日期" Const ZC_MSG063="删除" Const ZC_MSG064="传送引? Const ZC_MSG065="返回" Const ZC_MSG066="分类管理" Const ZC_MSG067="文章管理" Const ZC_MSG068="评论管理" Const ZC_MSG069="引用管理" Const ZC_MSG070="用户管理" Const ZC_MSG071="附件管理" Const ZC_MSG072="索引重建" Const ZC_MSG073="文件重建" Const ZC_MSG074="文章生成" Const ZC_MSG075="时间" Const ZC_MSG076="ID" Const ZC_MSG077="新建分类" Const ZC_MSG078="编辑" Const ZC_MSG079="排序" Const ZC_MSG080="IP" Const ZC_MSG081="URL" Const ZC_MSG082="文章总数" Const ZC_MSG083="当前样式" Const ZC_MSG084="当前语言" Const ZC_MSG085="Search"'搜索 Const ZC_MSG086="搜索%s,共找到%s个结? Const ZC_MSG087="提交" Const ZC_MSG088="重置" Const ZC_MSG089="验证" Const ZC_MSG090="全局管理" Const ZC_MSG091="BLOG的名? Const ZC_MSG092="BLOG的简? Const ZC_MSG093="网站的标? Const ZC_MSG094="网站的子标题" Const ZC_MSG095="界面样式名称" Const ZC_MSG096="BLOG版权说明(可以放置备案号和统计代码,支持HTML代码,可用'<br/>'标签换行)" Const ZC_MSG097="BLOG所有? Const ZC_MSG098="错误原因" Const ZC_MSG099="未命名文? Const ZC_MSG100="可视编辑" Const ZC_MSG101="UBB编辑" Const ZC_MSG102="选项" Const ZC_MSG103="播放/隐藏 媒体" Const ZC_MSG104="BLOG的地址" Const ZC_MSG105="基础设置" Const ZC_MSG106="高级设置" Const ZC_MSG107="插件管理" Const ZC_MSG108="上传图片、影音及其它类型的文? Const ZC_MSG109="使用Web界面的在线编辑器,即见既所得的编辑日志" Const ZC_MSG110="使用UBB代码编辑日志,同时也支持HTML代码混合输入" Const ZC_MSG111="设置BLOG的标题,更改网站说明,切换界面样式等" Const ZC_MSG112="重建所有日志可能需要很长时?请点?提交'按钮执行,如果你修改了网站相关设置或是更换了模?请使用文件重? Const ZC_MSG113="调整各种高级选项,如评论验证、列表页显示数量、日志静态化类型? Const ZC_MSG114="浏览系统已安装的插件并执行相关插? Const ZC_MSG115="分类不能为空" Const ZC_MSG116="正文不能为空" Const ZC_MSG117="先提交日志才能发送引? Const ZC_MSG118="名称不能为空" Const ZC_MSG119="密码不能为空" Const ZC_MSG120="邮箱不能为空" Const ZC_MSG121="添加新日? Const ZC_MSG122="添加新分? Const ZC_MSG123="添加新用? Const ZC_MSG124="评论总数" Const ZC_MSG125="引用总数" Const ZC_MSG126="摘要:" Const ZC_MSG127="新建用户" Const ZC_MSG128="作?'Authors Const ZC_MSG129="浏览总数" Const ZC_MSG130="浏览" Const ZC_MSG131="自动命名上传文件" Const ZC_MSG132="将日志中所有的关键字自动替换为相应的链? Const ZC_MSG133="添加自动链接的关键字" Const ZC_MSG134="添加Tags" Const ZC_MSG135="新建关键? Const ZC_MSG136="新建Tags" Const ZC_MSG137="链接不能为空" Const ZC_MSG138="Tags" Const ZC_MSG139="显示已使用的Tags" Const ZC_MSG140="自由定义Tags并给日志贴上合适的标签" Const ZC_MSG141="Tags管理" Const ZC_MSG142="自动链接" Const ZC_MSG143="数据导出" Const ZC_MSG144="将Blog上的数据导出为基于ATOM 1.0标准的XML文件" Const ZC_MSG145="引用地址" Const ZC_MSG146="查询是否有同名的日志" Const ZC_MSG147="别名" Const ZC_MSG148="用户注册" Const ZC_MSG149="制作" Const ZC_MSG150="当前版本" Const ZC_MSG151="最后更? Const ZC_MSG152="%n秒钟后将自动跳转入下一个重建页面中..." Const ZC_MSG153="引自" Const ZC_MSG154="最近引? Const ZC_MSG155="« 更早的文? Const ZC_MSG156="之后的文?»" Const ZC_MSG157="任意" Const ZC_MSG158="搜索符合条件的文? Const ZC_MSG159="信息摘要" Const ZC_MSG160="当前用户" Const ZC_MSG161="为了防止SPAM的侵?请输入验证码后点'提交'获得文章的引用通告地址" Const ZC_MSG162="目录总数" Const ZC_MSG163="Tags总数" Const ZC_MSG164="最新动态信? Const ZC_MSG165="个人Access? Const ZC_MSG166="用户总数" Const ZC_MSG167="站内统计摘要" Const ZC_MSG168="新建文章" Const ZC_MSG169="总计耗时%n? Const ZC_MSG170="文件? Const ZC_MSG171="超过此像素单位尺寸的图片自动缩小到该尺寸(?则不使用该功?" Const ZC_MSG172="备份与更? Const ZC_MSG173="全局设置" Const ZC_MSG174="BLOG CLSID" Const ZC_MSG175="BLOG 时区" Const ZC_MSG176="BLOG 页面语言" Const ZC_MSG177="静态文件后缀?(asp,html,shtml,htm)" Const ZC_MSG178="日志存放目录(该目录必需已存?" Const ZC_MSG179="当前Z-Blog程序版本" Const ZC_MSG180="WEB编辑?可设为fckeditor,htmlarea,tinymce,widgEditor?为空值则不启用WEB编辑)" Const ZC_MSG181="单次重建文件数目" Const ZC_MSG182="单次重建文件后的间隔秒数" Const ZC_MSG183="允许上传文件的类?以|做为分隔)" Const ZC_MSG184="上传文件的最大字节数" Const ZC_MSG185="发表评论时启用验证码" Const ZC_MSG186="页面设置" Const ZC_MSG187="最新评论及引用的数? Const ZC_MSG188="文件按月存档的月份的数量(?不限次数)" Const ZC_MSG189="最近发表文章的数量" Const ZC_MSG190="首页及列表页显示文章的数量(标准模式? Const ZC_MSG191="管理页显示记录的数量" Const ZC_MSG192="RSS及ATOM显示文章的数? Const ZC_MSG193="搜索显示文章的数? Const ZC_MSG194="翻页条的条目数量" Const ZC_MSG195="UBB设置及相关转? Const ZC_MSG196="UBB转换超连接标? Const ZC_MSG197="UBB转换字体标签" Const ZC_MSG198="UBB转换代码框标? Const ZC_MSG199="UBB转换表情标签" Const ZC_MSG200="UBB转换图片标签" Const ZC_MSG201="UBB转换多媒体标? Const ZC_MSG202="UBB转换Flash标签" Const ZC_MSG203="UBB转换排版标签" Const ZC_MSG204="UBB自动链接认别" Const ZC_MSG205="UBB自动转换关键?启用关键字转换后文件生成速度将变很慢)" Const ZC_MSG206="自动替换回车符为换行标签(默认启用,除非全用HTML排版可设为False)" Const ZC_MSG207="评论输出No Follow标签" Const ZC_MSG208="日文转义为HTML字符" Const ZC_MSG209="启用单日志页面上下文章导航条" Const ZC_MSG210="文件管理" Const ZC_MSG211="发表评论" Const ZC_MSG212="查看评论" Const ZC_MSG213="首页" Const ZC_MSG214="分类查看" Const ZC_MSG215="WAP设置" Const ZC_MSG216="允许桌面浏览器浏览WAP" Const ZC_MSG217="WAP每页显示文章? Const ZC_MSG218="WAP每页显示评论? Const ZC_MSG219="WAP文章列表分页页码条长? Const ZC_MSG220="WAP单页文章文字? Const ZC_MSG221="WAP文章分页页码条长? Const ZC_MSG222="WAP评论分页页码条长? Const ZC_MSG223="WAP文件? Const ZC_MSG224="要查询的内容" Const ZC_MSG225="重建成功? Const ZC_MSG226="是否启用RSS的全文输? Const ZC_MSG227="?n阶段重建已完? Const ZC_MSG228="删除所选项? Const ZC_MSG229="全? Const ZC_MSG230="相关文章条目数量" Const ZC_MSG231="相关文章" Const ZC_MSG232="点击这里获取该日志的TrackBack引用地址" Const ZC_MSG233="导航? Const ZC_MSG234="表情图片的尺? Const ZC_MSG235="表情图片配置字符? Const ZC_MSG236="已上传文? Const ZC_MSG237="继续上传" Const ZC_MSG238="文件大小" Const ZC_MSG239="回上级目? Const ZC_MSG240="当前路径" Const ZC_MSG241="Tags编辑" Const ZC_MSG242="用户编辑" Const ZC_MSG243="分类编辑" Const ZC_MSG244="留言编辑" Const ZC_MSG245="后台首页" Const ZC_MSG246="文件编辑" Const ZC_MSG247="网站设置" Const ZC_MSG248="后台管理" Const ZC_MSG249="等级" Const ZC_MSG250="正在保存" Const ZC_MSG251="秒后自动保存" Const ZC_MSG252="恢复" Const ZC_MSG253="已恢? Const ZC_MSG254="你确认要恢复? Const ZC_MSG255="等待载入或窗体名填写错误" Const ZC_MSG256="无内? Const ZC_MSG257="保存失败" Const ZC_MSG258="自动保存成功" Const ZC_MSG259="您无权使用自动保存功? Const ZC_MSG260="登录" Const ZC_MSG261="修改时间" Const ZC_MSG262="是否关闭评论功能" Const ZC_MSG263="是否关闭引用功能" Const ZC_MSG264="%s ?%s 回复" Const ZC_MSG265="回复该留言" Const ZC_MSG266="?操作成功" Const ZC_MSG267="× 操作失败" Const ZC_MSG268="?需要进?索引重建'" Const ZC_MSG269="?需要进?文件重建'" Const ZC_MSG270="是否启用月光插件功能生成目录和按月归档的静态首? Const ZC_MSG271="是否开启评论和引用的倒序输出" Const ZC_MSG272="评论编辑" Const ZC_MSG273="?%s ?%s 最后编? Const ZC_MSG274="最近留言" Const ZC_MSG275="留言? Const ZC_MSG276="自定义留言本正文内?可用'<br/>'标签换行" Const ZC_MSG277="所属文章ID:(一般情况下请勿改动此数?设置?则将该留言划归blog的留言?" Const ZC_MSG278="是否开启自定义静态日志目录功?不是高手请勿使用" Const ZC_MSG279="自定义静态日志目录配?可以是{%post%},{%category%},{%user%},{%year%},{%month%},{%day%},{%id%},{%alias%}之间的组?
可以?分隔,系统初始化配置是{%post%})" Const ZC_MSG280="开启匿名功能时自定义静态日志目录配置里必须包含有{%id%}或{%alias%}" Const ZC_MSG281="静态目录配置及文件重建设置" Const ZC_MSG282="确认密码" Const ZC_MSG283="是否允许游客回复留言" Const ZC_MSG284="留言总数" Const ZC_MSG285="«" Const ZC_MSG286="»" Const ZC_MSG287="搜索符合条件的评? Const ZC_MSG288="外站链接访问" Const ZC_MSG289="更新" Const ZC_MSG290="设置获取最新动态信息的网络地址(默认?http://update.rainbowsoft.org/info/',为空值则关闭此功?" Dim ZVA_Article_Level_Name(4) ZVA_Article_Level_Name(1)="草稿文章" ZVA_Article_Level_Name(2)="私人文章" ZVA_Article_Level_Name(3)="锁定文章" ZVA_Article_Level_Name(4)="普通文? Dim ZVA_User_Level_Name(5) ZVA_User_Level_Name(1)="管理? ZVA_User_Level_Name(2)="高级用户" ZVA_User_Level_Name(3)="中级用户" ZVA_User_Level_Name(4)="普通用? ZVA_User_Level_Name(5)="游客" Dim ZVA_Month(12) ZVA_Month(1) ="January"'"一? ZVA_Month(2) ="February"'"二月" ZVA_Month(3) ="March"'"三月" ZVA_Month(4) ="April"'"四月" ZVA_Month(5) ="May"'"五月" ZVA_Month(6) ="June"'"六月" ZVA_Month(7) ="July"'"七月" ZVA_Month(8) ="August"'"八月" ZVA_Month(9) ="September"'"九月" ZVA_Month(10)="October"'"十月" ZVA_Month(11)="November"'"十一? ZVA_Month(12)="December"'"十二? Dim ZVA_Month_Abbr(12) ZVA_Month_Abbr(1) ="Jan" ZVA_Month_Abbr(2) ="Feb" ZVA_Month_Abbr(3) ="Mar" ZVA_Month_Abbr(4) ="Apr" ZVA_Month_Abbr(5) ="May" ZVA_Month_Abbr(6) ="Jun" ZVA_Month_Abbr(7) ="Jul" ZVA_Month_Abbr(8) ="Aug" ZVA_Month_Abbr(9) ="Sep" ZVA_Month_Abbr(10)="Oct" ZVA_Month_Abbr(11)="Nov" ZVA_Month_Abbr(12)="Dec" Dim ZVA_Week_Abbr(7) ZVA_Week_Abbr(1)="Sun" ZVA_Week_Abbr(2)="Mon" ZVA_Week_Abbr(3)="Tue" ZVA_Week_Abbr(4)="Wed" ZVA_Week_Abbr(5)="Thu" ZVA_Week_Abbr(6)="Fri" ZVA_Week_Abbr(7)="Sat" '自定义错误信? Dim ZVA_ErrorMsg(47) ZVA_ErrorMsg(0)="未知错误" ZVA_ErrorMsg(1)="未知命令" ZVA_ErrorMsg(2)="未查询到相关页面" ZVA_ErrorMsg(3)="参数提交错误" ZVA_ErrorMsg(4)="数据库连接错? ZVA_ErrorMsg(5)="非法访问" ZVA_ErrorMsg(6)="没有权限" ZVA_ErrorMsg(7)="用户名或密码错误" ZVA_ErrorMsg(8)="登录失败" ZVA_ErrorMsg(9)="该文章不存在" ZVA_ErrorMsg(10)="系统初始化失? ZVA_ErrorMsg(11)="编辑文章失败" ZVA_ErrorMsg(12)="编辑分类失败" ZVA_ErrorMsg(13)="该分类下有文章,删除失败" ZVA_ErrorMsg(14)="评论发表失败" ZVA_ErrorMsg(15)="名称不能为空或过长及格式不正? ZVA_ErrorMsg(16)="编辑用户失败" ZVA_ErrorMsg(17)="删除用户失败" ZVA_ErrorMsg(18)="删除评论失败" ZVA_ErrorMsg(19)="删除引用失败" ZVA_ErrorMsg(20)="发送引用失? ZVA_ErrorMsg(21)="文件上传失败" ZVA_ErrorMsg(22)="文件删除失败" ZVA_ErrorMsg(23)="系统重建失败" ZVA_ErrorMsg(24)="搜索字符串失? ZVA_ErrorMsg(25)="保存设置失败" ZVA_ErrorMsg(26)="文件类型超出设定范围" ZVA_ErrorMsg(27)="文件大小超出设定范围" ZVA_ErrorMsg(28)="文件已存在,请先删除" ZVA_ErrorMsg(29)="邮箱不能为空或过长及格式不正? ZVA_ErrorMsg(30)="网址不能为空或过长及格式不正? ZVA_ErrorMsg(31)="请勿冒名顶替,如果你是该用?请先登录后再发表评论" ZVA_ErrorMsg(32)="由于设定时间间隔而拒绝操? ZVA_ErrorMsg(33)="编辑关键字失? ZVA_ErrorMsg(34)="删除关键字失? ZVA_ErrorMsg(35)="编辑Tags失败" ZVA_ErrorMsg(36)="删除Tags失败" ZVA_ErrorMsg(37)="编辑文件失败" ZVA_ErrorMsg(38)="验证码输入错? ZVA_ErrorMsg(39)="请不要对Blog提交相同的评? ZVA_ErrorMsg(40)="评论功能已关? ZVA_ErrorMsg(41)="引用功能已关? ZVA_ErrorMsg(42)="编辑评论失败" ZVA_ErrorMsg(43)="校验码错?请勿发布垃圾信息" ZVA_ErrorMsg(44)="非普通文章不能发表评论或引用" ZVA_ErrorMsg(45)="留言本只允许注册用户回复,游客只能留言" ZVA_ErrorMsg(46)="评论内容不能为空或过? ZVA_ErrorMsg(47)="回复功能只对注册用户开?游客只能留言" %> ?% Sub ErrorHandle On Error Resume Next Response.CodePage=65001 Err.Clear End Sub Call ErrorHandle %> ?% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// ? ? 朱煊(zx.asd) '// 版权所? RainbowSoft Studio '// 技术支? rainbowsoft@163.com '// 程序名称: '// 程序版本: '// 单元名称: c_function.asp '// 开始时? 2004.07.28 '// 最后修? '// ? ? 函数模块 '/////////////////////////////////////////////////////////////////////////////// '********************************************************* ' 目的? 显示错误页面 ' 输入? id ' 返回? ? '********************************************************* Dim ShowError_Custom Sub ShowError(id) If IsEmpty(ShowError_Custom)=False Then Execute(ShowError_Custom) Exit Sub End If Response.Redirect ZC_BLOG_HOST & "function/c_error.asp?errorid=" & id & "&number=" & Err.Number & "&description=" & Server.URLEncode(Err.Description) & "&source=" & Server.URLEncode(Err.Source) End Sub '********************************************************* '********************************************************* ' 目的? XML-RPC显示错误页面 '********************************************************* Function RespondError(faultCode,faultString) Dim strXML Dim strError strXML="faultCode$1faultString$2" strError=strXML strError=Replace(strError,"$1",TransferHTML(faultCode,"[html-format]")) strError=Replace(strError,"$2",TransferHTML(faultString,"[html-format]")) Response.Clear Response.BinaryWrite ChrB(&HEF) & ChrB(&HBB) & ChrB(&HBF) Response.Write strError Response.End End Function '********************************************************* '********************************************************* ' 目的? 检查正则式 ' 输入? id ' 返回? 成功为True '********************************************************* Function CheckRegExp(source,para) If para="[username]" Then para="^[.A-Za-z0-9\u4e00-\u9fa5]+$" End If If para="[password]" Then para="^[a-z0-9]+$" End If If para="[email]" Then para="^([0-9a-zA-Z]([-.\w]*[0-9a-zA-Z])*@([0-9a-zA-Z][-\w]*\.)+[a-zA-Z]*)$" End If If para="[homepage]" Then para="^[a-zA-Z]+://[a-zA-z0-9\-\./]+?/*$" End If If para="[nojapan]" Then para="[\u3040-\u30ff]+" End If If para="[guid]" Then para="^\w{8}\-\w{4}\-\w{4}\-\w{4}\-\w{12}$" End If Dim re Set re = New RegExp re.Global = True re.Pattern = para re.IgnoreCase = False CheckRegExp = re.Test(source) End Function '********************************************************* '********************************************************* ' 目的? 检查参? ' 返回? 出错则转到ShowError(3) '********************************************************* Function CheckParameter(byRef source,strType,default) On Error Resume Next If strType="int" Then '数? If IsNull(source) Then source=default ElseIf IsEmpty(source) Then source=default ElseIf IsNumeric(source) Then source=CLng(source) ElseIf source="" Then source=default Else Call ShowError(3) End if If Err.Number<>0 Then Call ShowError(3) CheckParameter=True ElseIf strType="dtm" Then '日期 If IsNull(source) Then source=default ElseIf IsEmpty(source) Then source=default ElseIf IsDate(source) Then source=source Call FormatDateTime(source,vbLongDate) Call FormatDateTime(source,vbShortDate) ElseIf source="" Then source=default Else Call ShowError(3) End if If Err.Number<>0 Then Call ShowError(3) CheckParameter=True ElseIf strType="sql" Then 'SQL If IsNull(source) Or Trim(source)="" Or IsEmpty(source) Then source=default Else source=CStr(Replace(source,Chr(39),Chr(39)&Chr(39))) End If ElseIf strType="bool" Then 'Boolean source=CBool(source) If Err.Number<>0 Then Err.Clear If IsEmpty(source)=True Then source=True Else source=False End If End If Else Call ShowError(0) End If End Function '********************************************************* '********************************************************* ' 目的? 检查引? ' 返回? ? '********************************************************* Sub CheckReference(strDestination) Exit Sub Dim strReferer strReferer=CStr(Request.ServerVariables("HTTP_REFERER")) If Instr(strReferer,ZC_BLOG_HOST)=0 Then ShowError(5) End If End Sub '********************************************************* '********************************************************* ' 目的? 搜索字符? ' 返回? ' 备注: 不区分大小写 '********************************************************* Function Search(strText,strQuestion) Dim s Dim i Dim j s=strText i=Instr(1,s,strQuestion,vbTextCompare) If i>0 Then s=Left(s,i+Len(strQuestion)+100) s=Right(s,Len(strQuestion)+200) Else s="" End If If s<>"" Then i=1 Do While InStr(i,s,strQuestion,vbTextCompare)>0 j=InStr(i,s,strQuestion,vbTextCompare) If Len(s)-j-Len(strQuestion)<0 Then s=Left(s,j-1) & "" & strQuestion & "" Exit Do Else s=Left(s,j-1) & "" & strQuestion & "" & Right(s,Len(s)-j-Len(strQuestion)+1) End If i=j+Len("" & strQuestion & "")-1 If i>=Len(s) Then Exit Do Loop End If If s="" Then Search=strText Else Search=s End If End Function '********************************************************* '********************************************************* ' 目的? 检查引? ' 输入? SQL值(引用? ' 返回? '********************************************************* Function FilterSQL(strSQL) FilterSQL=CStr(Replace(strSQL,chr(39),chr(39)&chr(39))) End Function '********************************************************* '********************************************************* ' 目的? 检查引? ' 输入? ' 输入? 要替换的字符代号 ' 返回? '********************************************************* Function TransferHTML(source,para) Dim objRegExp '先换"&" If Instr(para,"[&]")>0 Then source=Replace(source,"&","&") If Instr(para,"[<]")>0 Then source=Replace(source,"<","<") If Instr(para,"[>]")>0 Then source=Replace(source,">",">") If Instr(para,"[""]")>0 Then source=Replace(source,"""",""") If Instr(para,"[space]")>0 Then source=Replace(source," "," ") If Instr(para,"[enter]")>0 Then source=Replace(source,vbCrLf,"
") source=Replace(source,vbLf,"
") End If If Instr(para,"[vbCrlf]")>0 And ZC_AUTO_NEWLINE Then Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True objRegExp.Pattern="(()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|()|())(\x20*(\r\n|\n))" source= objRegExp.Replace(source,"$1") objRegExp.Pattern="(\r\n|\n)" source= objRegExp.Replace(source,"
") source=Replace(source,"","") source=Replace(source,"","") source=Replace(source,"","") source=Replace(source,"","") End If If Instr(para,"[vbTab]")>0 Then source=Replace(source,vbTab,"  ") If Instr(para,"[upload]")>0 Then source=Replace(source,"src=""upload/","src="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/") source=Replace(source,"href=""upload/","href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/") source=Replace(source,"value=""upload/","value="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/") source=Replace(source,"href=""http://upload/","href="""& ZC_BLOG_HOST & ZC_UPLOAD_DIRECTORY & "/") End If If Instr(para,"[no-asp]")>0 Then source=Replace(source,"<"&"%","<"&"%") source=Replace(source,"%"&">","%"&">") End If If ZC_COMMENT_NOFOLLOW_ENABLE And Instr(para,"[nofollow]")>0 Then source=Replace(source,"0 Then Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True objRegExp.Pattern="<[^>]*>" source= objRegExp.Replace(source,"") End If If Instr(para,"[filename]")>0 Then source=Replace(source,"/","") source=Replace(source,"\","") source=Replace(source,":","") source=Replace(source,"?","") source=Replace(source,"*","") source=Replace(source,"""","") source=Replace(source,"<","") source=Replace(source,">","") source=Replace(source,"|","") source=Replace(source," ","") End If If Instr(para,"[normalname]")>0 Then source=Replace(source,"$","") source=Replace(source,"(","") source=Replace(source,")","") source=Replace(source,"*","") source=Replace(source,"+","") source=Replace(source,",","") source=Replace(source,"[","") source=Replace(source,"]","") source=Replace(source,"{","") source=Replace(source,"}","") source=Replace(source,"?","") source=Replace(source,"\","") source=Replace(source,"^","") source=Replace(source,"|","") source=Replace(source,":","") source=Replace(source,"""","") End If If Instr(para,"[textarea]")>0 Then 'Set objRegExp=New RegExp 'objRegExp.IgnoreCase =True 'objRegExp.Global=True 'objRegExp.Pattern="(&)([#a-z0-9]{2,10})(;)" 'source= objRegExp.Replace(source,"&$2$3") source=Replace(source,"&","&") source=Replace(source,"%","%") source=Replace(source,"<","<") source=Replace(source,">",">") End If If ZC_JAPAN_TO_HTML And Instr(para,"[japan-html]")>0 Then source=Replace(source,"?,"ガ") source=Replace(source,"?,"ギ") source=Replace(source,"?,"ア") source=Replace(source,"?,"ゲ") source=Replace(source,"?,"ゴ") source=Replace(source,"?,"ザ") source=Replace(source,"?,"ジ") source=Replace(source,"?,"ズ") source=Replace(source,"?,"ゼ") source=Replace(source,"?,"ゾ") source=Replace(source,"ダ","ダ") source=Replace(source,"?,"ヂ") source=Replace(source,"?,"ヅ") source=Replace(source,"?,"デ") source=Replace(source,"?,"ド") source=Replace(source,"?,"バ") source=Replace(source,"?,"パ") source=Replace(source,"?,"ビ") source=Replace(source,"?,"ピ") source=Replace(source,"?,"ブ") source=Replace(source,"?,"ブ") source=Replace(source,"?,"プ") source=Replace(source,"?,"ベ") source=Replace(source,"?,"ペ") source=Replace(source,"?,"ボ") source=Replace(source,"?,"ポ") source=Replace(source,"?,"ヴ") End If If ZC_JAPAN_TO_HTML And Instr(para,"[html-japan]")>0 Then source=Replace(source,"ガ","?) source=Replace(source,"ギ","?) source=Replace(source,"ア","?) source=Replace(source,"ゲ","?) source=Replace(source,"ゴ","?) source=Replace(source,"ザ","?) source=Replace(source,"ジ","?) source=Replace(source,"ズ","?) source=Replace(source,"ゼ","?) source=Replace(source,"ゾ","?) source=Replace(source,"ダ","ダ") source=Replace(source,"ヂ","?) source=Replace(source,"ヅ","?) source=Replace(source,"デ","?) source=Replace(source,"ド","?) source=Replace(source,"バ","?) source=Replace(source,"パ","?) source=Replace(source,"ビ","?) source=Replace(source,"ピ","?) source=Replace(source,"ブ","?) source=Replace(source,"ブ","?) source=Replace(source,"プ","?) source=Replace(source,"ベ","?) source=Replace(source,"ペ","?) source=Replace(source,"ボ","?) source=Replace(source,"ポ","?) source=Replace(source,"ヴ","?) End If If Instr(para,"[html-format]")>0 Then source=Replace(source,"&","&") source=Replace(source,"<","<") source=Replace(source,">",">") source=Replace(source,"""",""") End If If Instr(para,"[wapnohtml]")>0 Then source=Replace(source,"
",vbCrLf) source=Replace(source,"
",vbCrLf) Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True objRegExp.Pattern="(<[^>]*)|([^<]*>)" source= objRegExp.Replace(source,"") objRegExp.Pattern="(\r\n|\n)" source= objRegExp.Replace(source,"
") End If If Instr(para,"[nbsp-br]")>0 Then Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True objRegExp.Pattern="<$|<b$|<br$|<br/$" source= objRegExp.Replace(source,"") objRegExp.Pattern="^br/>|^r/>|^/>|^>" source= objRegExp.Replace(source,"") objRegExp.Pattern="<br/>" source= objRegExp.Replace(source,"
") objRegExp.Pattern="&nbsp;" source= objRegExp.Replace(source," ") End If TransferHTML=source End Function '********************************************************* '********************************************************* ' 目的? 301 Moved ' 输入? ' 返回? '********************************************************* Sub RedirectBy301(strURL) Response.Clear Response.Status="301 Moved Permanently" Response.AddHeader "Location",strURL Response.End End Sub '********************************************************* '********************************************************* ' 目的? Random Number Create ' 输入? ' 返回? '********************************************************* Sub CreateVerifyNumber() Dim i,j,s,t Randomize Dim aryVerifyNumber(10000) For j=0 To 10000 s="" For i = 0 To 4 t = Int(Rnd * 10) s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1) Next aryVerifyNumber(j)=s Next Application.Lock Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber Application.UnLock End Sub '********************************************************* '********************************************************* ' 目的? Random Number Get ' 输入? ' 返回? '********************************************************* Function GetVerifyNumber() Randomize Dim i,j,s,t Dim aryVerifyNumber Application.Lock aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER") Application.UnLock If IsEmpty(aryVerifyNumber) Then Call CreateVerifyNumber() Application.Lock aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER") Application.UnLock End If For i=0 To 10000 If (aryVerifyNumber(i)<>"") And (Len(aryVerifyNumber(i))=5) Then GetVerifyNumber=aryVerifyNumber(i) Exit For End If Next aryVerifyNumber(i)=aryVerifyNumber(i)&"-" If i=5000 Then For j=5001 To 10000 s="" For i = 0 To 4 t = Int(Rnd * 10) s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1) Next aryVerifyNumber(j)=s Next End If If i=10000 Then For j=0 To 5000 s="" For i = 0 To 4 t = Int(Rnd * 10) s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1) Next aryVerifyNumber(j)=s Next End If Application.Lock Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber Application.UnLock End Function '********************************************************* '********************************************************* ' 目的? Random Number Check ' 输入? ' 返回? '********************************************************* Function CheckVerifyNumber(strNumber) Dim i,j,s,t Dim aryVerifyNumber Application.Lock aryVerifyNumber=Application(ZC_BLOG_CLSID & "VERIFY_NUMBER") Application.UnLock If IsEmpty(aryVerifyNumber) Then Exit Function For j=0 To 10000 If aryVerifyNumber(j)=strNumber & "-" Then Randomize s="" For i = 0 To 4 t = Int(Rnd * 10) s= s & Mid("0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ",t + 1, 1) Next aryVerifyNumber(j)=s Application.Lock Application(ZC_BLOG_CLSID & "VERIFY_NUMBER")=aryVerifyNumber Application.UnLock CheckVerifyNumber=True Exit Function End If Next End Function '********************************************************* '********************************************************* ' 目的? UBB ' 输入? ' 输入? ' 返回? '********************************************************* Function UBBCode(strContent,strType) Dim objRegExp Set objRegExp=new RegExp objRegExp.IgnoreCase =True objRegExp.Global=True If ZC_UBB_LINK_ENABLE And Instr(strType,"[link]")>0 Then objRegExp.Pattern="(\[URL\])(([a-zA-Z0-9]+?):\/\/\S+?)(\[\/URL\])" strContent= objRegExp.Replace(strContent,"
$2") objRegExp.Pattern="(\[URL\])(.+?)(\[\/URL\])" strContent= objRegExp.Replace(strContent,"$2") objRegExp.Pattern="(\[URL=)(([a-zA-Z0-9]+?):\/\/\S+?)(\])(.+?)(\[\/URL\])" strContent= objRegExp.Replace(strContent,"$5") objRegExp.Pattern="(\[URL=)(\S+?)(\])(\S+?)(\[\/URL\])" strContent= objRegExp.Replace(strContent,"$4") objRegExp.Pattern="(\[EMAIL\])(\S+\@\S+?)(\[\/EMAIL\])" strContent= objRegExp.Replace(strContent,"$2") objRegExp.Pattern="(\[EMAIL=)(\S+\@\S+?)(\])(.+?)(\[\/EMAIL\])" strContent= objRegExp.Replace(strContent,"$4") End If If ZC_UBB_FONT_ENABLE And Instr(strType,"[font]")>0 Then objRegExp.Pattern="(\[I\])([\u0000-\uffff]+?)(\[\/I\])" strContent=objRegExp.Replace(strContent,"$2") objRegExp.Pattern="(\[B\])([\u0000-\uffff]+?)(\[\/B\])" strContent=objRegExp.Replace(strContent,"$2") objRegExp.Pattern="(\[U\])([\u0000-\uffff]+?)(\[\/U\])" strContent=objRegExp.Replace(strContent,"$2") objRegExp.Pattern="(\[S\])([\u0000-\uffff]+?)(\[\/S\])" strContent=objRegExp.Replace(strContent,"$2") objRegExp.Pattern="(\[QUOTE\])([\u0000-\uffff]+?)(\[\/QUOTE\])" strContent=objRegExp.Replace(strContent,"
$2"&vbCrlf&"
") objRegExp.Pattern="(\[QUOTE=)(.+?)(\])([\u0000-\uffff]+?)(\[\/QUOTE\])" strContent= objRegExp.Replace(strContent,"
"&ZC_MSG153&" $2
$4"&vbCrlf&"
") objRegExp.Pattern="(\[REVERT=)(.+?)(\])([\u0000-\uffff]+?)(\[\/REVERT\])" strContent= objRegExp.Replace(strContent,"
$2
$4
") End If If ZC_UBB_CODE_ENABLE And Instr(strType,"[code]")>0 Then Dim strCode Dim Match, Matches strContent =Replace(strContent,vbLf,"") '[CODELITE] objRegExp.Pattern="(\[CODE_LITE\])(.+?)(\[\/CODE_LITE\])" Set Matches = objRegExp.Execute(strContent) For Each Match in Matches strCode=Match strCode = TransferHTML(strCode,"[<][>][space][vbTab]") strCode=Replace(strCode,vbCr,"
") strContent =Replace(strContent,Match,strCode) objRegExp.Global=False objRegExp.Pattern="(\[CODE_LITE\]()?)(.+?)(\[\/CODE_LITE\])" strContent=objRegExp.Replace(strContent,"

$3

") objRegExp.Global=True Next Set Matches = Nothing '[CODE] objRegExp.Pattern="(\[CODE\])(.+?)(\[\/CODE\])" Set Matches = objRegExp.Execute(strContent) For Each Match in Matches strCode=Match strCode = TransferHTML(strCode,"[<][>][space][vbTab]") strCode = Replace(strCode,vbCr,Chr(8)&Chr(11)&Chr(9)&Chr(12)) strContent =Replace(strContent,Match,strCode) objRegExp.Global=False objRegExp.Pattern="(\[CODE\])(.+?)(\[\/CODE\])" strContent=objRegExp.Replace(strContent,"") objRegExp.Global=True Next Set Matches = Nothing strContent =Replace(strContent,vbCr,vbCrLf) strContent =Replace(strContent,Chr(8)&Chr(11)&Chr(9)&Chr(12),vbCr) End If If ZC_UBB_FACE_ENABLE And Instr(strType,"[face]")>0 Then objRegExp.Pattern="(\[F\])(.+?)(\[\/F\])" strContent= objRegExp.Replace(strContent,"") End If If ZC_UBB_IMAGE_ENABLE And Instr(strType,"[image]")>0 Then '[img] objRegExp.Pattern="(\[IMG=)([0-9]*),([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG=)([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG=)([0-9]*)(\])(.+?)(\[\/IMG\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG\])(.+?)(\[\/IMG\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_LEFT=)([0-9]*),([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG_LEFT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_LEFT=)([0-9]*),([^\n\[]*)(\])(.+?)(\[\/IMG_LEFT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_LEFT=)([0-9]*)(\])(.+?)(\[\/IMG_LEFT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_LEFT\])(.+?)(\[\/IMG_LEFT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_RIGHT=)([0-9]*),([0-9]*),(.*)(\])(.+?)(\[\/IMG_RIGHT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_RIGHT=)([0-9]*),(.*)(\])(.+?)(\[\/IMG_RIGHT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_RIGHT=)([0-9]*)(\])(.+?)(\[\/IMG_RIGHT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[IMG_RIGHT\])(.+?)(\[\/IMG_RIGHT\])" strContent= objRegExp.Replace(strContent,"") End If If ZC_UBB_FLASH_ENABLE And Instr(strType,"[flash]")>0 Then '[flash] objRegExp.Pattern="(\[FLASH=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/FLASH\])" strContent= objRegExp.Replace(strContent,"") End If If ZC_UBB_TYPESET_ENABLE And Instr(strType,"[typeset]")>0 Then objRegExp.Pattern="(\[ALIGN-CENTER\])([\u0000-\uffff]+?)(\[\/ALIGN-CENTER\])" strContent=objRegExp.Replace(strContent,"
$2
") objRegExp.Pattern="(\[ALIGN-LELT\])([\u0000-\uffff]+?)(\[\/ALIGN-LELT\])" strContent=objRegExp.Replace(strContent,"
$2
") objRegExp.Pattern="(\[ALIGN-RIGHT\])([\u0000-\uffff]+?)(\[\/ALIGN-RIGHT\])" strContent=objRegExp.Replace(strContent,"
$2
") objRegExp.Pattern="(\[HR\])([\u0000-\uffff]?)(\[\/HR\])" strContent=objRegExp.Replace(strContent,"
") objRegExp.Pattern="(\[FONT-FACE=)([a-z\x20]*)(\])([\u0000-\uffff]+?)(\[\/FONT-FACE\])" strContent=objRegExp.Replace(strContent,"$4") objRegExp.Pattern="(\[FACE=)([a-z\x20]*)(\])([\u0000-\uffff]+?)(\[\/FACE\])" strContent=objRegExp.Replace(strContent,"$4") objRegExp.Pattern="(\[FONT-SIZE=)([1-7]*)(\])([\u0000-\uffff]+?)(\[\/FONT-SIZE\])" strContent=objRegExp.Replace(strContent,"$4") objRegExp.Pattern="(\[SIZE=)([1-7]*)(\])([\u0000-\uffff]+?)(\[\/SIZE\])" strContent=objRegExp.Replace(strContent,"$4") objRegExp.Pattern="(\[FONT-COLOR=)([#0-9a-z]*)(\])([\u0000-\uffff]+?)(\[\/FONT-COLOR\])" strContent=objRegExp.Replace(strContent,"$4") objRegExp.Pattern="(\[COLOR=)([#0-9a-z]*)(\])([\u0000-\uffff]+?)(\[\/COLOR\])" strContent=objRegExp.Replace(strContent,"$4") End If If ZC_UBB_MEDIA_ENABLE And Instr(strType,"[media]")>0 Then '[WMA] objRegExp.Pattern="(\[WMA=)([a-z]*)(\])(.+?)(\[\/WMA\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[WMA\])(.+?)(\[\/WMA\])" strContent= objRegExp.Replace(strContent,"") '[WMV] objRegExp.Pattern="(\[WMV=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/WMV\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[WMV\])(.+?)(\[\/WMV\])" strContent= objRegExp.Replace(strContent,"") '[RMV] objRegExp.Pattern="(\[RM=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/RM\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[RM\])(.+?)(\[\/RM\])" strContent= objRegExp.Replace(strContent,"") '[RA] objRegExp.Pattern="(\[RA=)([a-z]*)(\])(.+?)(\[\/RA\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[RA\])(.+?)(\[\/RA\])" strContent= objRegExp.Replace(strContent,"") '[QT] objRegExp.Pattern="(\[QT=)([0-9]*),([0-9]*),([a-z]*)(\])(.+?)(\[\/QT\])" strContent= objRegExp.Replace(strContent,"") objRegExp.Pattern="(\[QT\])(.+?)(\[\/QT\])" strContent= objRegExp.Replace(strContent,"") '[MEDIA] objRegExp.Pattern="(\[MEDIA=)([a-z]*),([0-9]*),([0-9]*)(\])(.+?)(\[\/MEDIA\])" strContent= objRegExp.Replace(strContent,"
"& ZC_MSG103 &"
") objRegExp.Pattern="(\[MEDIA=)([0-9]*),([0-9]*)(\])(.+?)(\[\/MEDIA\])" strContent= objRegExp.Replace(strContent,"
"& ZC_MSG103 &"
") objRegExp.Pattern="(\[MEDIA\])(.+?)(\[\/MEDIA\])" strContent= objRegExp.Replace(strContent,"
"& ZC_MSG103 &"
") End If If ZC_UBB_AUTOLINK_ENABLE And Instr(strType,"[autolink]")>0 Then objRegExp.Pattern="(^|\r\n|\n)((http|https|ftp|mailto|gopher|news|telnet|mms|rtsp|ed2k|tencent|nfcall|dic|pig2pig|callto|exeem|ymsgr|thunder|p4p|pplive|synacast|ppstream|feed|wangwang|qqtv|rssfeed|msnim|chrome|file|ppg|thunder):{1}\/{0,2}[^<>\f\n\r\t\v]+?)(\r\n|\n|$)" strContent=objRegExp.Replace(strContent,vbCrlf & "$2" & vbCrlf) objRegExp.Pattern="(^|\r\n|\n)((http|https|ftp|mailto|gopher|news|telnet|mms|rtsp|ed2k|tencent|nfcall|dic|pig2pig|callto|exeem|ymsgr|thunder|p4p|pplive|synacast|ppstream|feed|wangwang|qqtv|rssfeed|msnim|chrome|file|ppg|thunder):{1}\/{0,2}[^<>\f\n\r\t\v]+?)(\r\n|\n|$)" strContent=objRegExp.Replace(strContent,vbCrlf & "$2" & vbCrlf) End If If ZC_UBB_AUTOKEY_ENABLE And Instr(strType,"[key]")>0 Then Dim i,j If IsArray(KeyWords) Then For i=Lbound(KeyWords,2) To Ubound(KeyWords,2) objRegExp.Pattern="((<.*)("&KeyWords(1,i)&")(.*>))|(())" Set Matches = objRegExp.Execute(strContent) For Each Match in Matches strContent=Replace(strContent,Match,vbVerticalTab & vbTab & vbVerticalTab) Next strContent=Replace(strContent,KeyWords(1,i),""& KeyWords(1,i) &"") For Each Match in Matches strContent=Replace(strContent,vbVerticalTab & vbTab & vbVerticalTab,Match,1,1) Next Set Matches = Nothing Next End If End If If ZC_UBB_LINK_ENABLE And Instr(strType,"[link-antispam]")>0 Then Dim Match2, Matches2 ,strCode2 objRegExp.Pattern="(href="".+?"")" Set Matches2 = objRegExp.Execute(strContent) For Each Match2 in Matches2 strCode2=Match2 strCode2=Left(strCode2,Len(strCode2)-1) strCode2=Right(strCode2,Len(strCode2)-6) strCode2=URLEncodeForAntiSpam(strCode2) strContent =Replace(strContent,Match2,"href=""" & strCode2 & """") Next Set Matches2 = Nothing End If Set objRegExp=Nothing UBBCode=strContent End Function '********************************************************* '********************************************************* ' 目的? Save Text to File ' 输入? ' 输入? ' 返回? '********************************************************* Function SaveToFile(strFullName,strContent,strCharset,bolRemoveBOM) On Error Resume Next Dim objStream Set objStream = Server.CreateObject("ADODB.Stream") With objStream .Type = adTypeText .Mode = adModeReadWrite .Open .Charset = strCharset .Position = objStream.Size .WriteText = strContent .SaveToFile strFullName,adSaveCreateOverWrite .Close End With Set objStream = Nothing If bolRemoveBOM Then If strContent<>"" And ZC_STATIC_TYPE="shtml" Then Call RemoveBOM(strFullName) End If End If Err.Clear End Function '********************************************************* '********************************************************* ' 目的? Load Text form File ' 输入? ' 输入? ' 返回? '********************************************************* Function LoadFromFile(strFullName,strCharset) On Error Resume Next Dim objStream Set objStream = Server.CreateObject("ADODB.Stream") With objStream .Type = adTypeText .Mode = adModeReadWrite .Open .Charset = strCharset .Position = objStream.Size .LoadFromFile strFullName LoadFromFile=.ReadText .Close End With Set objStream = Nothing Err.Clear End Function '********************************************************* '********************************************************* ' 目的? Remove BOM from UTF-8 '********************************************************* Function RemoveBOM(strFullName) On Error Resume Next Dim objStream Dim strContent Set objStream = Server.CreateObject("ADODB.Stream") With objStream .Type = adTypeBinary .Mode = adModeReadWrite .Open .Position = objStream.Size .LoadFromFile strFullName .Position = 3 strContent=.Read .Close End With Set objStream = NoThing Set objStream = Server.CreateObject("ADODB.Stream") With objStream .Type = adTypeBinary .Mode = adModeReadWrite .Open .Position = objStream.Size .Write = strContent .SaveToFile strFullName,adSaveCreateOverWrite .Close End With Set objStream = Nothing Err.Clear End Function '********************************************************* '********************************************************* ' 目的? Save Value For Setting '********************************************************* Function SaveValueForSetting(ByRef strContent,bolConst,strTypeVar,strItem,strValue) Dim i,j,s,t Dim strConst Dim objRegExp If bolConst=True Then strConst="Const" Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True strValue=TransferHTML(strValue,"[no-asp]") If strTypeVar="String" Then strValue=Replace(strValue,"""","""""") strValue=""""& strValue &"""" objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(\r\n|\n|$)" If objRegExp.Test(strContent)=True Then strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$8") SaveValueForSetting=True Exit Function End If End If If strTypeVar="Boolean" Then strValue=Trim(strValue) If LCase(strValue)="true" Then strValue="True" Else strValue="False" End If If objRegExp.Test(strContent)=True Then objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(\r\n|\n|$)" strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9") SaveValueForSetting=True Exit Function End If End If If strTypeVar="Numeric" Then strValue=Trim(strValue) If IsNumeric(strValue)=False Then strValue=0 End If If objRegExp.Test(strContent)=True Then objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(\r\n|\n|$)" strContent=objRegExp.Replace(strContent,"$1$2"& strValue &"$9") SaveValueForSetting=True Exit Function End If End If SaveValueForSetting=False End Function '********************************************************* '********************************************************* ' 目的? Load Value For Setting '********************************************************* Function LoadValueForSetting(strContent,bolConst,strTypeVar,strItem,ByRef strValue) Dim i,j,s,t Dim strConst Dim objRegExp Dim Matches,Match If bolConst=True Then strConst="Const" Set objRegExp=New RegExp objRegExp.IgnoreCase =True objRegExp.Global=True If strTypeVar="String" Then objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))(.+?)(\r\n|\n|$)" Set Matches = objRegExp.Execute(strContent) If Matches.Count=1 Then t=Matches(0).Value t=Replace(t,VbCrlf,"") t=Replace(t,Vblf,"") objRegExp.Pattern="( *)""(.*)""( *)($)" Set Matches = objRegExp.Execute(t) If Matches.Count>0 Then s=Trim(Matches(0).Value) s=Mid(s,2,Len(s)-2) s=Replace(s,"""""","""") strValue=s LoadValueForSetting=True Exit Function End If End If End If If strTypeVar="Boolean" Then objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([a-z]+)( *)(\r\n|\n|$)" Set Matches = objRegExp.Execute(strContent) If Matches.Count=1 Then t=Matches(0).Value t=Replace(t,VbCrlf,"") t=Replace(t,Vblf,"") objRegExp.Pattern="( *)((True)|(False))( *)($)" Set Matches = objRegExp.Execute(t) If Matches.Count>0 Then s=Trim(Matches(0).Value) s=LCase(Matches(0).Value) If InStr(s,"true")>0 Then strValue=True ElseIf InStr(s,"false")>0 Then strValue=False End If LoadValueForSetting=True Exit Function End If End If End If If strTypeVar="Numeric" Then objRegExp.Pattern="(^|\r\n|\n)(( *)" & strConst & "( *)" & strItem & "( *)=( *))([0-9.]+)( *)(\r\n|\n|$)" Set Matches = objRegExp.Execute(strContent) If Matches.Count=1 Then t=Matches(0).Value t=Replace(t,VbCrlf,"") t=Replace(t,Vblf,"") objRegExp.Pattern="( *)([0-9.]+)( *)($)" Set Matches = objRegExp.Execute(t) If Matches.Count>0 Then s=Trim(Matches(0).Value) If IsNumeric(s)=True Then strValue=s LoadValueForSetting=True Exit Function End If End If End If End If LoadValueForSetting=False End Function '********************************************************* '********************************************************* ' 目的? '********************************************************* Function IsObjInstalled(strClassString) On Error Resume Next IsObjInstalled = False Err = 0 Dim xTestObj Set xTestObj = Server.CreateObject(strClassString) If 0 = Err Then IsObjInstalled = True Set xTestObj = Nothing Err = 0 End Function '********************************************************* '********************************************************* ' 目的? '********************************************************* Function URLEncodeForAntiSpam(strUrl) Dim i,s For i =1 To Len(strUrl) s=s & Mid(strUrl,i,1) & CStr(Int((10 * Rnd))) Next URLEncodeForAntiSpam=ZC_BLOG_HOST & "function/c_urlredirect.asp?url=" & Server.URLEncode(s) End Function '********************************************************* '********************************************************* ' 目的? '********************************************************* Function URLDecodeForAntiSpam(strUrl) Dim i,s For i =1 To Len(strUrl) Step 2 s=s & Mid(strUrl,i,1) Next URLDecodeForAntiSpam=s End Function '********************************************************* '********************************************************* ' 目的? unescape ' 输入? ' 输入? 要替换的字符 ' 返回? '********************************************************* %> ?% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// ? ? 朱煊(zx.asd) '// 版权所? RainbowSoft Studio '// 技术支? rainbowsoft@163.com '// 程序名称: '// 程序版本: '// 单元名称: c_system_lib.asp '// 开始时? 2004.07.25 '// 最后修? 2007-1-4 '// ? ? 库模? '/////////////////////////////////////////////////////////////////////////////// '********************************************************* ' 目的? 定义TCategory? ' 输入? ? ' 返回? ? '********************************************************* Class TCategory Public ID Public Name Public Intro Public Order Public Count Public Alias Public Property Get Url If ZC_MOONSOFT_PLUGIN_ENABLE=True Then Url = ZC_BLOG_HOST & Directory & FileName If ZC_MOONSOFT_PLUGIN_ENABLE And ZC_MOONSOFT_PLUGIN_ANONYMOUS Then Url = ZC_BLOG_HOST & Directory End If Else Url = ZC_BLOG_HOST & "catalog.asp?"& "cate=" & ID End If End Property Public Property Get RssUrl RssUrl = ZC_BLOG_HOST & "sydication.asp?cate=" & ID End Property Public Property Get HtmlName HtmlName=TransferHTML(Name,"[html-format]") End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Private FDirectory Public Property Let Directory(strDirectory) FDirectory=strDirectory End Property Public Property Get Directory If IsEmpty(FDirectory)=True Then If ZC_MOONSOFT_PLUGIN_ENABLE=True Then Directory=ParseCustomDirectory(ZC_MOONSOFT_PLUGIN_REGEX,ZC_STATIC_DIRECTORY,StaticName,"","","","","","") Else Directory=ZC_STATIC_DIRECTORY End If Else Directory = FDirectory End If Directory=Replace(Directory,"\","/") If Right(ZC_BLOG_HOST & Directory,1)<>"/" Then Directory=Directory & "/" End If End Property Public Property Get StaticName If IsNull(Alias) Or IsEmpty(Alias) Or Alias="" Then StaticName = "cat_" & ID Else StaticName = Alias End If End Property Public Property Get FileName FileName = StaticName If ZC_MOONSOFT_PLUGIN_ENABLE And ZC_MOONSOFT_PLUGIN_ANONYMOUS Then FileName = "default" End If FileName = FileName & "." & ZC_STATIC_TYPE End Property Public Function Post() Call CheckParameter(ID,"int",0) Call CheckParameter(Order,"int",0) 'ID可以? Name=FilterSQL(Name) Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) If Len(Name)=0 Then Post=False:Exit Function If ID=0 Then objConn.Execute("INSERT INTO [blog_Category]([cate_Name],[cate_Order],[cate_Intro]) VALUES ('"&Name&"',"&Order&",'"&Alias&"')") Dim objRS Set objRS=objConn.Execute("SELECT MAX([cate_ID]) FROM [blog_Category]") If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS(0) End If Set objRS=Nothing Else objConn.Execute("UPDATE [blog_Category] set [cate_Name]='"&Name&"',[cate_Order]="&Order&",[cate_Intro]='"&Alias&"' WHERE [cate_ID] =" & ID) End If Post=True End Function Public Function LoadInfoByID(cate_ID) Call CheckParameter(cate_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [cate_ID],[cate_Name],[cate_Intro],[cate_Order],[cate_Count] FROM [blog_Category] WHERE [cate_ID]=" & cate_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("cate_ID") Name=objRS("cate_Name") Alias=objRS("cate_Intro") Order=objRS("cate_Order") Count=objRS("cate_Count") LoadInfoByID=True End If objRS.Close Set objRS=Nothing End Function Public Function LoadInfoByArray(aryCateInfo) If IsArray(aryCateInfo)=True Then ID=aryCateInfo(0) Name=aryCateInfo(1) Alias=aryCateInfo(2) Order=aryCateInfo(3) Count=aryCateInfo(4) End If LoadInfoByArray=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function Dim objRS Set objRS=objConn.Execute("SELECT [log_ID] FROM [blog_Article] WHERE [log_CateID]=" & ID) If (Not objRS.bof) And (Not objRS.eof) Then ShowError(13) objConn.Execute("DELETE FROM [blog_Category] WHERE [cate_ID] =" & ID) Call DelFile() Del=True End Function Public Function DelFile() On Error Resume Next Dim fso, TxtFile Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & Directory & FileName) Then Set TxtFile = fso.GetFile(BlogPath & Directory & FileName) TxtFile.Delete End If Set fso=Nothing DelFile=True Err.Clear End Function Private Sub Class_Initialize() ID=0 End Sub End Class '********************************************************* '********************************************************* ' 目的? 定义TArticle? ' 输入? ? ' 返回? ? '********************************************************* Class TArticle Public ID Public CateID Public AuthorID Public Level Public Title Public Intro Public Content Public PostTime Public Tag Public Alias Public CommNums Public ViewNums Public TrackBackNums Private IP Public Istop Public Template_Article_Trackback Public Template_Article_Comment Public Template_Article_Commentpost Public Template_Article_Tag Public Template_Article_Navbar_L Public Template_Article_Navbar_R Public Template_Article_Commentpost_Verify Public Template_Article_Mutuality Public Template_Article_Single Public Template_Article_Multi Public Template_Article_Istop Public Template_Article_Search Public html Public htmlWAP Public Template_Article_Multi_WAP Public Template_Article_Single_WAP Private Ftemplate_Wap Private Ftemplate Public Property Let template(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template template = Ftemplate End Property Public Property Let template_Wap(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template_Wap template_Wap = Ftemplate_Wap End Property Private FDirectory Public Property Let Directory(strDirectory) FDirectory=strDirectory End Property Public Property Get Directory If IsEmpty(FDirectory)=True Then If ZC_CUSTOM_DIRECTORY_ENABLE=True Then Directory=ParseCustomDirectory(ZC_CUSTOM_DIRECTORY_REGEX,ZC_STATIC_DIRECTORY,Categorys(CateID).StaticName,Users(AuthorID).StaticName,Year(PostTime),Month(PostTime),Day(PostTime),ID,StaticName) Else Directory=ZC_STATIC_DIRECTORY End If Else Directory = FDirectory End If Directory=Replace(Directory,"\","/") If Right(ZC_BLOG_HOST & Directory,1)<>"/" Then Directory=Directory & "/" End If End Property Public Property Get Url If Level=2 Then Url = ZC_BLOG_HOST & "view.asp?id=" & ID Else Url = ZC_BLOG_HOST & Directory & FileName If ZC_CUSTOM_DIRECTORY_ENABLE And ZC_CUSTOM_DIRECTORY_ANONYMOUS Then Url = ZC_BLOG_HOST & Directory End If End If End Property Public Property Get StaticName If IsNull(Alias) Or IsEmpty(Alias) Or Alias="" Then StaticName = ID Else StaticName = Alias End If End Property Public Property Get FileName FileName = StaticName If ZC_CUSTOM_DIRECTORY_ENABLE And ZC_CUSTOM_DIRECTORY_ANONYMOUS Then FileName = "default" End If FileName = FileName & "." & ZC_STATIC_TYPE End Property Private FTrackBackKey Public Property Get TrackBackKey If IsNull(FTrackBackKey) Or IsEmpty(FTrackBackKey) Or FTrackBackKey="" Then FTrackBackKey=Left(MD5(ZC_BLOG_HOST & ZC_BLOG_CLSID & CStr(ID) & CStr(TrackBackNums)),8) End If TrackBackKey=FTrackBackKey End Property Private FCommentKey Public Property Get CommentKey If IsNull(FCommentKey) Or IsEmpty(FCommentKey) Or FCommentKey="" Then FCommentKey=Left(MD5(ZC_BLOG_HOST & ZC_BLOG_CLSID & CStr(ID)),8) End If CommentKey=FCommentKey End Property Public Property Get TrackBack TrackBack = ZC_BLOG_HOST & "cmd.asp?act=tb&id="& ID &"&key=" & TrackBackKey End Property Public Property Get PreTrackBack PreTrackBack = ZC_BLOG_HOST & "cmd.asp?act=gettburl&id=" & ID End Property Public Property Get TrackBackUrl TrackBackUrl = TrackBack End Property Public Property Get CommentUrl CommentUrl = Url & "#comment" End Property Public Property Get WfwComment WfwComment = ZC_BLOG_HOST End Property Public Property Get WfwCommentRss WfwCommentRss = ZC_BLOG_HOST & "sydication.asp?cmt=" & ID End Property Public Property Get CommentPostUrl CommentPostUrl = ZC_BLOG_HOST & "cmd.asp?act=cmt&key=" & CommentKey End Property Public Property Get HtmlContent HtmlContent=TransferHTML(UBBCode(Content,"[face][link][autolink][font][code][image][typeset][media][flash][key]"),"[html-japan][vbCrlf][upload]") End Property Public Property Get HtmlTitle HtmlTitle=TransferHTML(Title,"[html-japan][html-format]") End Property Public Property Get HtmlIntro HtmlIntro=TransferHTML(UBBCode(Intro,"[face][link][autolink][font][code][image][typeset][media][flash][key]"),"[html-japan][vbCrlf][upload]") End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Public Property Get TagToName Dim t,i,s If Tag<>"" Then s=Tag s=Replace(s,"}","") t=Split(s,"{") For i=LBound(t) To UBound(t) If t(i)<>"" Then If IsEmpty(FirstTagIntro) Then FirstTagIntro=Tags(t(i)).Intro t(i)=Tags(t(i)).Name End If Next s=Trim(Join(t)) & " " If s=" " Then s="" TagToName=s End If End Property Public FirstTagIntro Public Function LoadInfobyID(log_ID) Call CheckParameter(log_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE [log_ID]=" & log_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("log_ID") Tag=objRS("log_Tag") CateID=objRS("log_CateID") Title=objRS("log_Title") Intro=objRS("log_Intro") Content=objRS("log_Content") Level=objRS("log_Level") AuthorID=objRS("log_AuthorID") PostTime=objRS("log_PostTime") CommNums=objRS("log_CommNums") ViewNums=objRS("log_ViewNums") TrackBackNums=objRS("log_TrackBackNums") Alias=objRS("log_Url") Istop=objRS("log_Istop") PostTime = Year(PostTime) & "-" & Month(PostTime) & "-" & Day(PostTime) & " " & Hour(PostTime) & ":" & Minute(PostTime) & ":" & Second(PostTime) Else Exit Function End If objRS.Close Set objRS=Nothing LoadInfobyID=True End Function Public Function LoadInfoByArray(aryArticleInfo) '[log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url] 'Array(objRS("log_ID"),objRS("log_Tag"),objRS("log_CateID"),objRS("log_Title"),objRS("log_Intro"),objRS("log_Content"),objRS("log_Level"),objRS("log_AuthorID"),objRS("log_PostTime"),objRS("log_CommNums"),objRS("log_ViewNums"),objRS("log_TrackBackNums"),objRS("log_Url")) If IsArray(aryArticleInfo)=True Then ID=aryArticleInfo(0) Tag=aryArticleInfo(1) CateID=aryArticleInfo(2) Title=aryArticleInfo(3) Intro=aryArticleInfo(4) Content=aryArticleInfo(5) Level=aryArticleInfo(6) AuthorID=aryArticleInfo(7) PostTime=aryArticleInfo(8) CommNums=aryArticleInfo(9) ViewNums=aryArticleInfo(10) TrackBackNums=aryArticleInfo(11) Alias=aryArticleInfo(12) Istop=aryArticleInfo(13) PostTime = Year(PostTime) & "-" & Month(PostTime) & "-" & Day(PostTime) & " " & Hour(PostTime) & ":" & Minute(PostTime) & ":" & Second(PostTime) End If LoadInfoByArray=True End Function Public Function Export(intType) Call Export_CMTandTB Call Export_Mutuality Call Export_NavBar Call Export_CommentPost Call Export_Tag Application.Lock Template_Article_Single=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-SINGLE") Template_Article_Multi=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-MULTI") Template_Article_Istop=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-ISTOP") Template_Article_Multi_WAP=Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE-MULTI") Template_Article_Single_WAP =Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_SINGLE") Application.UnLock Template_Article_Single=Replace(Template_Article_Single,"<#template:article_trackback#>",Template_Article_Trackback) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_comment#>",Template_Article_Comment) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_commentpost#>",Template_Article_Commentpost) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_tag#>",Template_Article_Tag) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_l#>",Template_Article_Navbar_L) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_r#>",Template_Article_Navbar_R) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_mutuality#>",Template_Article_Mutuality) Template_Article_Multi=Replace(Template_Article_Multi,"<#template:article_tag#>",Template_Article_Tag) Template_Article_Istop=Replace(Template_Article_Istop,"<#template:article_tag#>",Template_Article_Tag) Dim aryTemplateTagsName(47) Dim aryTemplateTagsValue(47) Dim i,j aryTemplateTagsName(1)="<#article/id#>" aryTemplateTagsValue(1)=ID aryTemplateTagsName(2)="<#article/level#>" aryTemplateTagsValue(2)=Level aryTemplateTagsName(3)="<#article/title#>" If intType=ZC_DISPLAY_MODE_SEARCH Then aryTemplateTagsValue(3)=Search(Title,Request.QueryString("q")) Else aryTemplateTagsValue(3)=HtmlTitle End If aryTemplateTagsName(4)="<#article/intro#>" If intType=ZC_DISPLAY_MODE_SEARCH Then aryTemplateTagsValue(4)=Search(TransferHTML(Intro & Content,"[html-format]"),Request.QueryString("q")) Else If Level=2 Then aryTemplateTagsValue(4)=ZC_MSG043 Else aryTemplateTagsValue(4)=HtmlIntro End If End If aryTemplateTagsName(5)="<#article/content#>" aryTemplateTagsValue(5)=HtmlContent If intType=ZC_DISPLAY_MODE_SEARCH Then aryTemplateTagsValue(5)=aryTemplateTagsValue(4) End If aryTemplateTagsName(6)="<#article/posttime#>" aryTemplateTagsValue(6)=PostTime aryTemplateTagsName(7)="<#article/commnums#>" aryTemplateTagsValue(7)=Commnums aryTemplateTagsName(8)="<#article/viewnums#>" aryTemplateTagsValue(8)=Viewnums aryTemplateTagsName(9)="<#article/trackbacknums#>" aryTemplateTagsValue(9)=Trackbacknums aryTemplateTagsName(10)="<#article/trackback_url#>" aryTemplateTagsValue(10)=TrackBack aryTemplateTagsName(11)="<#article/url#>" aryTemplateTagsValue(11)=HtmlUrl aryTemplateTagsName(12)="<#article/category/id#>" aryTemplateTagsValue(12)=Categorys(CateID).ID aryTemplateTagsName(13)="<#article/category/name#>" aryTemplateTagsValue(13)=Categorys(CateID).HtmlName aryTemplateTagsName(15)="<#article/category/order#>" aryTemplateTagsValue(15)=Categorys(CateID).Order aryTemplateTagsName(16)="<#article/category/count#>" aryTemplateTagsValue(16)=Categorys(CateID).Count aryTemplateTagsName(17)="<#article/category/url#>" aryTemplateTagsValue(17)=Categorys(CateID).HtmlUrl aryTemplateTagsName(18)="<#article/author/id#>" aryTemplateTagsValue(18)=Users(AuthorID).ID aryTemplateTagsName(19)="<#article/author/name#>" aryTemplateTagsValue(19)=Users(AuthorID).Name aryTemplateTagsName(20)="<#article/author/level#>" aryTemplateTagsValue(20)=ZVA_User_Level_Name(Users(AuthorID).Level) aryTemplateTagsName(21)="<#article/author/email#>" aryTemplateTagsValue(21)=Users(AuthorID).Email aryTemplateTagsName(22)="<#article/author/homepage#>" aryTemplateTagsValue(22)=Users(AuthorID).HomePage aryTemplateTagsName(23)="<#article/author/count#>" aryTemplateTagsValue(23)=Users(AuthorID).Count aryTemplateTagsName(24)="<#article/author/url#>" aryTemplateTagsValue(24)=Users(AuthorID).HtmlUrl aryTemplateTagsName(25)="<#article/posttime/longdate#>" aryTemplateTagsValue(25)=FormatDateTime(PostTime,vbLongDate) aryTemplateTagsName(26)="<#article/posttime/shortdate#>" aryTemplateTagsValue(26)=FormatDateTime(PostTime,vbShortDate) aryTemplateTagsName(27)="<#article/posttime/longtime#>" aryTemplateTagsValue(27)=FormatDateTime(PostTime,vbLongTime) aryTemplateTagsName(28)="<#article/posttime/shorttime#>" aryTemplateTagsValue(28)=FormatDateTime(PostTime,vbShortTime) aryTemplateTagsName(29)="<#article/posttime/year#>" aryTemplateTagsValue(29)=Year(PostTime) aryTemplateTagsName(30)="<#article/posttime/month#>" aryTemplateTagsValue(30)=Month(PostTime) aryTemplateTagsName(31)="<#article/posttime/monthname#>" aryTemplateTagsValue(31)=ZVA_Month_Abbr(Month(PostTime)) aryTemplateTagsName(32)="<#article/posttime/day#>" aryTemplateTagsValue(32)=Day(PostTime) aryTemplateTagsName(33)="<#article/posttime/weekday#>" aryTemplateTagsValue(33)=Weekday(PostTime) aryTemplateTagsName(34)="<#article/posttime/weekdayname#>" aryTemplateTagsValue(34)=ZVA_Week_Abbr(Weekday(PostTime)) aryTemplateTagsName(35)="<#article/posttime/hour#>" aryTemplateTagsValue(35)=Hour(PostTime) aryTemplateTagsName(36)="<#article/posttime/minute#>" aryTemplateTagsValue(36)=Minute(PostTime) aryTemplateTagsName(37)="<#article/posttime/second#>" aryTemplateTagsValue(37)=Second(PostTime) aryTemplateTagsName(38)="<#article/commentrss#>" aryTemplateTagsValue(38)=WfwCommentRss aryTemplateTagsName(39)="<#article/commentposturl#>" aryTemplateTagsValue(39)=CommentPostUrl aryTemplateTagsName(40)="<#article/pretrackback_url#>" aryTemplateTagsValue(40)=PreTrackBack aryTemplateTagsName(41)="<#article/trackbackkey#>" aryTemplateTagsValue(41)=TrackBackKey aryTemplateTagsName(42)="<#article/commentkey#>" aryTemplateTagsValue(42)=CommentKey aryTemplateTagsName(43)="<#article/staticname#>" aryTemplateTagsValue(43)=StaticName aryTemplateTagsName(44)="<#article/category/staticname#>" aryTemplateTagsValue(44)=Categorys(CateID).StaticName aryTemplateTagsName(45)="<#article/author/staticname#>" aryTemplateTagsValue(45)=Users(AuthorID).StaticName aryTemplateTagsName(46)="<#article/tagtoname#>" aryTemplateTagsValue(46)=TagToName aryTemplateTagsName(47)="<#article/firsttagintro#>" aryTemplateTagsValue(47)=FirstTagIntro j=47 For i=1 to j Template_Article_Istop=Replace(Template_Article_Istop,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Template_Article_Multi=Replace(Template_Article_Multi,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Template_Article_Single=Replace(Template_Article_Single,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Template_Article_Multi_WAP = Replace(Template_Article_Multi_WAP, aryTemplateTagsName(i), aryTemplateTagsValue(i)) Template_Article_Single_WAP = Replace(Template_Article_Single_WAP, aryTemplateTagsName(i), aryTemplateTagsValue(i)) Ftemplate = Replace(Ftemplate, aryTemplateTagsName(i), aryTemplateTagsValue(i)) Next If intType=ZC_DISPLAY_MODE_SEARCH Then Template_Article_Search=Template_Article_Multi End If Export=True End Function Public Function Export_Tag 'Tag Dim t,i,s,j If Tag<>"" Then Tag=Replace(Tag,"}","") t=Split(Tag,"{") For i=LBound(t) To UBound(t) If t(i)<>"" Then Application.Lock s=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TAG") Application.UnLock Template_Article_Tag=Template_Article_Tag & Tags(t(i)).MakeTemplate(s) End If Next End If Export_Tag=True End Function Function Export_CMTandTB() If CommNums + TrackBackNums > 0 Then Dim strC_Count,strC,strT_Count,strT Dim objComment Dim objTrackBack Dim i Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="SELECT [comm_ID],[log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_PostTime],[comm_IP],[comm_Agent] FROM [blog_Comment] WHERE [blog_Comment].[log_ID]=" & ID &" UNION ALL SELECT [tb_ID],[log_ID],'',[tb_Title],[tb_Excerpt],[tb_Blog],[tb_URL],[tb_PostTime],[tb_IP],[tb_Agent] from [blog_TrackBack] WHERE [blog_TrackBack].[log_ID]="& ID & " ORDER BY [comm_ID],[comm_PostTime]" objRS.Open() If (not objRS.bof) And (not objRS.eof) Then ReDim aryArticleExportMsgTB(objRS.RecordCount) For i=1 To objRS.RecordCount If IsNumeric(objRS("comm_AuthorID")) Then Set objComment=New TComment objComment.LoadInfoByArray(Array(objRS("comm_ID"),objRS("log_ID"),objRS("comm_AuthorID"),objRS("comm_Author"),objRS("comm_Content"),objRS("comm_Email"),objRS("comm_HomePage"),objRS("comm_PostTime"),"","")) strC_Count=strC_Count+1 Application.Lock strC=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENT") Application.UnLock objComment.Count=strC_Count strC=objComment.MakeTemplate(strC) If ZC_COMMENT_REVERSE_ORDER_EXPORT=True Then Template_Article_Comment=strC & Template_Article_Comment Else Template_Article_Comment=Template_Article_Comment & strC End If Set objComment=Nothing Else Set objTrackBack=New TTrackBack objTrackBack.LoadInfoByArray(Array(objRS("comm_ID"),objRS("log_ID"),objRS("comm_HomePage"),objRS("comm_Author"),objRS("comm_Email"),objRS("comm_Content"),objRS("comm_PostTime"),"","")) strT_Count=strT_Count+1 Application.Lock strT=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TRACKBACK") Application.UnLock objTrackBack.Count=strT_Count strT=objTrackBack.MakeTemplate(strT) If ZC_COMMENT_REVERSE_ORDER_EXPORT=True Then Template_Article_Trackback=strT & Template_Article_Trackback Else Template_Article_Trackback=Template_Article_Trackback & strT End If Set objTrackBack=Nothing End If objRS.MoveNext If objRS.eof Then Exit For Next End if objRS.Close() Set objRS=Nothing End If Template_Article_Comment=Template_Article_Comment & "
" Export_CMTandTB=True End Function Function Export_NavBar() If ZC_USE_NAVIGATE_ARTICLE=False Then Template_Article_Navbar_L="" Template_Article_Navbar_R="" Export_NavBar=True Exit Function End If Dim s,t Dim strName Dim strUrl Dim objNavArticle Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE ([log_Level]>2) AND ([log_PostTime]<#" & PostTime & "#) ORDER BY [log_PostTime] DESC") If (Not objRS.bof) And (Not objRS.eof) Then Set objNavArticle=New TArticle If objNavArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13))) Then strName=objNavArticle.Title strUrl=objNavArticle.Url End If Set objNavArticle=Nothing Application.Lock s=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_L") Application.UnLock s=Replace(s,"<#article/nav_l/url#>",strUrl) s=Replace(s,"<#article/nav_l/name#>",strName) Template_Article_Navbar_L=s End If Set objRS=Nothing Set objRS=objConn.Execute("SELECT TOP 1 [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE ([log_Level]>2) AND ([log_PostTime]>#" & PostTime & "#) ORDER BY [log_PostTime] ASC") If (Not objRS.bof) And (Not objRS.eof) Then Set objNavArticle=New TArticle If objNavArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13))) Then strName=objNavArticle.Title strUrl=objNavArticle.Url End If Set objNavArticle=Nothing Application.Lock t=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_R") Application.UnLock t=Replace(t,"<#article/nav_r/url#>",strUrl) t=Replace(t,"<#article/nav_r/name#>",strName) Template_Article_Navbar_R=t End If Set objRS=Nothing Export_NavBar=True End Function Function Export_CommentPost() If Level<4 Then Exit Function Application.Lock Template_Article_Commentpost=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST") Application.UnLock If ZC_COMMENT_VERIFY_ENABLE=True Then Application.Lock Template_Article_Commentpost_Verify=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST-VERIFY") Application.UnLock End If Template_Article_Commentpost=Replace(Template_Article_Commentpost,"<#template:article_commentpost-verify#>",Template_Article_Commentpost_Verify) End Function '相关文章的生? Function Export_Mutuality() If Tag<>"" Then Dim strCC_Count,strCC_ID,strCC_Name,strCC_Url,strCC_PostTime,strCC_Title Dim strCC Dim i Dim j Dim objRS Dim strSQL Set objRS=Server.CreateObject("ADODB.Recordset") strSQL="SELECT TOP "& ZC_MUTUALITY_COUNT &" [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE ([log_Level]>2) AND [log_ID]<"& ID strSQL = strSQL & " AND (" Dim aryTAGs Tag=Replace(Tag,"}","") aryTAGs=Split(Tag,"{") For j = LBound(aryTAGs) To UBound(aryTAGs) If aryTAGs(j)<>"" Then strSQL = strSQL & "([log_Tag] Like '%{"&aryTAGs(j)&"}%')" If j=UBound(aryTAGs) Then Exit For If aryTAGs(j)<>"" Then strSQL = strSQL & " OR " End If Next strSQL = strSQL & ")" strSQL = strSQL + " ORDER BY [log_PostTime] DESC " Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source=strSQL objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then Dim objArticle For i=1 To ZC_MUTUALITY_COUNT '相关文章数目,可自行设定 Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS("log_ID"),objRS("log_Tag"),objRS("log_CateID"),objRS("log_Title"),"","",objRS("log_Level"),objRS("log_AuthorID"),objRS("log_PostTime"),objRS("log_CommNums"),objRS("log_ViewNums"),objRS("log_TrackBackNums"),objRS("log_Url"),objRS("log_Istop"))) Then strCC_Count=strCC_Count+1 strCC_ID=objArticle.ID strCC_Url=objArticle.Url strCC_PostTime=objArticle.PostTime strCC_Title=objArticle.Title Application.Lock strCC=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_Mutuality") Application.UnLock strCC=Replace(strCC,"<#article/mutuality/id#>",strCC_ID) strCC=Replace(strCC,"<#article/mutuality/url#>",strCC_Url) strCC=Replace(strCC,"<#article/mutuality/posttime#>",strCC_PostTime) strCC=Replace(strCC,"<#article/mutuality/name#>",strCC_Title) Template_Article_Mutuality=Template_Article_Mutuality & strCC End If objRS.MoveNext If objRS.eof Then Exit For Set objArticle=Nothing Next End if objRS.Close() Set objRS=Nothing End If Export_Mutuality=True End Function Public Function Post() Call CheckParameter(ID,"int",0) Call CheckParameter(CateID,"int",0) Call CheckParameter(AuthorID,"int",0) Call CheckParameter(Level,"int",0) Call CheckParameter(PostTime,"dtm",Empty) Call CheckParameter(Istop,"bool",False) 'ID可以? If (CateID=0) Then Post=False:Exit Function If (AuthorID=0) Then Post=False:Exit Function If IsEmpty(PostTime) Then Post=False:Exit Function Title=FilterSQL(Title) Intro=FilterSQL(Intro) Content=FilterSQL(Content) Tag=FilterSQL(Tag) IP=FilterSQL(IP) Title=TransferHTML(Title,"[japan-html]") Intro=TransferHTML(Intro,"[japan-html]") Content=TransferHTML(Content,"[japan-html]") Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) '检查“别名”是否有重名 If Alias<>"" Then Dim objRSsub Set objRSsub=objConn.Execute("SELECT [log_ID] FROM [blog_Article] WHERE [log_ID]<>"& ID &" AND [log_Url]='"& Alias &"'" ) If (Not objRSsub.bof) And (Not objRSsub.eof) Then Randomize Alias=Alias & "_" & CStr(Int((9 * Rnd) + 1)) & CStr(Int((9 * Rnd) + 1)) & CStr(Int((9 * Rnd) + 1)) & CStr(Int((9 * Rnd) + 1)) End If Set objRSsub=Nothing End If If Len(Title)=0 Then Post=False:Exit Function If Len(Content)=0 Then Post=False:Exit Function If Len(Intro)=0 Then Intro=Left(Content,ZC_TB_EXCERPT_MAX) & "..." If ID=0 Then objConn.Execute("INSERT INTO [blog_Article]([log_CateID],[log_AuthorID],[log_Level],[log_Title],[log_Intro],[log_Content],[log_PostTime],[log_IP],[log_Tag],[log_Url],[log_Istop]) VALUES ("&CateID&","&AuthorID&","&Level&",'"&Title&"','"&Intro&"','"&Content&"','"&PostTime&"','"&IP&"','"&Tag&"','"&Alias&"',"&Istop&")") Dim objRS Set objRS=objConn.Execute("SELECT MAX([log_ID]) FROM [blog_Article]") If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS(0) End If Set objRS=Nothing Else objConn.Execute("UPDATE [blog_Article] SET [log_CateID]="&CateID&",[log_AuthorID]="&AuthorID&",[log_Level]="&Level&",[log_Title]='"&Title&"',[log_Intro]='"&Intro&"',[log_Content]='"&Content&"',[log_PostTime]='"&PostTime&"',[log_IP]='"&IP&"',[log_Tag]='"&Tag&"',[log_Url]='"&Alias&"',[log_Istop]="&Istop&" WHERE [log_ID] =" & ID) End If Post=True End Function Public Function DelFile() On Error Resume Next Dim fso, TxtFile Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & Directory & FileName) Then Set TxtFile = fso.GetFile(BlogPath & Directory & FileName) TxtFile.Delete End If Set fso=Nothing Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & "/cache/" & ID & ".html") Then Set TxtFile = fso.GetFile(BlogPath & "/cache/" & ID & ".html") TxtFile.Delete End If Set fso=Nothing DelFile=True Err.Clear End Function Public Function Del() Call DelFile() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_Article] WHERE [log_ID] =" & ID) objConn.Execute("DELETE FROM [blog_Comment] WHERE [log_ID] =" & ID) objConn.Execute("DELETE FROM [blog_TrackBack] WHERE [log_ID] =" & ID) Del=True End Function Public Function Statistic() Dim objRS Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_Comment] WHERE [log_ID] =" & ID) If (Not objRS.bof) And (Not objRS.eof) Then CommNums=objRS(0) End If objConn.Execute("UPDATE [blog_Article] SET [log_CommNums]="& CommNums &" WHERE [log_ID] =" & ID) Set objRS=Nothing Set objRS=objConn.Execute("SELECT COUNT([log_ID]) FROM [blog_TrackBack] WHERE [log_ID] =" & ID) If (Not objRS.bof) And (Not objRS.eof) Then TrackBackNums=objRS(0) End If objConn.Execute("UPDATE [blog_Article] SET [log_TrackBackNums]="& TrackBackNums &" WHERE [log_ID] =" & ID) Set objRS=Nothing Statistic=True End Function Function Build() Dim aryTemplateTagsName Dim aryTemplateTagsValue Dim i,j htmlWAP = Template_Article_Single_WAP If IsEmpty(html) Then html=template html=Replace(html,"<#template:article-single#>",Template_Article_Single) Application.Lock aryTemplateTagsName=Application(ZC_BLOG_CLSID & "TemplateTagsName") aryTemplateTagsValue=Application(ZC_BLOG_CLSID & "TemplateTagsValue") Application.UnLock aryTemplateTagsName(0)="BlogTitle" aryTemplateTagsValue(0)=Title j=UBound(aryTemplateTagsName) For i=0 to j html=Replace(html,"<#" & aryTemplateTagsName(i) & "#>",aryTemplateTagsValue(i)) htmlWAP = Replace(htmlWAP, "<#" & aryTemplateTagsName(i) & "#>", aryTemplateTagsValue(i)) Next Build=True End Function Function SetVar(TemplateTag,TemplateValue) If IsEmpty(html) Then html=template html=Replace(html,"<#" & TemplateTag & "#>",TemplateValue) End Function Function Save() If Not(Level>2) Then Save=True:Exit Function Dim objStream html=TransferHTML(html,"[no-asp]") If ZC_STATIC_TYPE="asp" Then html="<"&"%@ CODEPAGE=65001 %"&">" & html End If If ZC_CUSTOM_DIRECTORY_ENABLE=True Then Call CreatDirectoryByCustomDirectory(Directory) End If Call SaveToFile(BlogPath & Directory & FileName,html,"utf-8",False) Save=True End Function Function SaveCache() If Not(Level>1) Then SaveCache=True:Exit Function Dim strList If Istop Then strList=Template_Article_Istop Else strList=Template_Article_Multi End If strList=TransferHTML(strList,"[no-asp]") Call SaveToFile(BlogPath & "/cache/" & ID & ".html",strList,"utf-8",False) SaveCache=True End Function Function LoadCache() Dim objStream Template_Article_Multi=LoadFromFile(BlogPath & "/CACHE/" & ID & ".html","utf-8") LoadCache=True End Function Private Sub Class_Initialize() PostTime=Now() ID=0 CateID=0 AuthorID=0 Level=4'默认为普? Title=ZC_MSG099 IP=Request.Servervariables("REMOTE_ADDR") Ftemplate_Wap=Empty Ftemplate=Empty End Sub End Class '********************************************************* '********************************************************* ' 目的? 定义TArticleList? ' 输入? ? ' 返回? ? '********************************************************* Class TArticleList Public Title Public FileName Public AllList Public AuthList Public CateList Public TagsList Public aryArticle Public aryArticleList() Public Template_PageBar Public Template_Article_Multi Public Template_PageBar_Next Public Template_PageBar_Previous Public Template_Calendar Public TemplateTags_ArticleList_Author_ID Public TemplateTags_ArticleList_Tags_ID Public TemplateTags_ArticleList_Category_ID Public TemplateTags_ArticleList_Date_ShortDate Public TemplateTags_ArticleList_Date_Year Public TemplateTags_ArticleList_Date_Month Public TemplateTags_ArticleList_Date_Day Public TemplateTags_ArticleList_Page_Now Public TemplateTags_ArticleList_Page_All Public html Private Ftemplate Public Property Let template(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template template = Ftemplate End Property Private FDirectory Public Property Let Directory(strDirectory) FDirectory=strDirectory End Property Public Property Get Directory If IsEmpty(FDirectory)=True Then Directory=ZC_STATIC_DIRECTORY Else Directory = FDirectory End If Directory=Replace(Directory,"\","/") If Right(ZC_BLOG_HOST & Directory,1)<>"/" Then Directory=Directory & "/" End If End Property Public Function Export(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Dim i,j,k,l Dim objRS Dim intPageCount Dim objArticle Call CheckParameter(intPage,"int",1) Call CheckParameter(intCateId,"int",Empty) Call CheckParameter(intAuthorId,"int",Empty) Call CheckParameter(dtmYearMonth,"dtm",Empty) Title=ZC_BLOG_SUBTITLE Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn '////////////////////////// 'ontop objRS.Source="SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Istop]=True) AND ([log_Level]>1)" objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT intPageCount=objRS.PageCount objRS.AbsolutePage = 1 For i = 1 To objRS.PageSize ReDim Preserve aryArticleList(i) Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13))) Then If objArticle.Export(intType)= True Then aryArticleList(i)=objArticle.Template_Article_Istop End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() k=Join(aryArticleList) Erase aryArticleList '////////////////////////// objRS.Source="SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Istop]=False) AND ([log_Level]>1)" If Not IsEmpty(intCateId) Then objRS.Source=objRS.Source & "AND([log_CateID]="&intCateId&")" On Error Resume Next Title=Categorys(intCateId).Name TemplateTags_ArticleList_Category_ID=Categorys(intCateId).ID Err.Clear End if If Not IsEmpty(intAuthorId) Then objRS.Source=objRS.Source & "AND([log_AuthorID]="&intAuthorId&")" On Error Resume Next Title=Users(intAuthorId).Name TemplateTags_ArticleList_Author_ID=Users(intAuthorId).ID Err.Clear End if If IsDate(dtmYearMonth) Then Dim y Dim m Dim d Dim ny Dim nm If IsDate(dtmYearMonth) Then 'dtmYearMonth=CDate(dtmYearMonth) Else Call showError(3) End If y=Year(dtmYearMonth) m=Month(dtmYearMonth) d=Day(dtmYearMonth) TemplateTags_ArticleList_Date_ShortDate=dtmYearMonth TemplateTags_ArticleList_Date_Year=y TemplateTags_ArticleList_Date_Month=m TemplateTags_ArticleList_Date_Day=d ny=y nm=m+1 If m=12 Then ny=ny+1:nm=1 If InstrRev(CStr(dtmYearMonth),"-")>=7 Then objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&") AND(Day([log_PostTime])="&d&")" Else objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&")" End If Template_Calendar="" Title=Year(dtmYearMonth) & " " & ZVA_Month(Month(dtmYearMonth)) End If If Not IsEmpty(strTagsName) Then On Error Resume Next Dim Tag For Each Tag in Tags If IsObject(Tag) Then If UCase(Tag.Name)=UCase(strTagsName) Then objRS.Source=objRS.Source & "AND([log_Tag] LIKE '%{" & Tag.ID & "}%')" TemplateTags_ArticleList_Tags_ID=Tag.ID End If End If Next Err.Clear Title=strTagsName End If objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT intPageCount=objRS.PageCount objRS.AbsolutePage = intPage For i = 1 To objRS.PageSize ReDim Preserve aryArticleList(i) Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13))) Then If objArticle.Export(intType)= True Then aryArticleList(i)=objArticle.Template_Article_Multi End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() Set objRS=Nothing Template_Article_Multi=k & Join(aryArticleList) TemplateTags_ArticleList_Page_Now=intPage TemplateTags_ArticleList_Page_All=intPageCount Call ExportBar(intPage,intPageCount,intCateId,intAuthorId,dtmYearMonth,strTagsName) Export=True End Function Public Function ExportByCache(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Dim strType Dim i,j,s,t,k,l Dim intAllPage Dim intTagsID Dim objArticle Call CheckParameter(intPage,"int",1) Call CheckParameter(intCateId,"int",Empty) Call CheckParameter(intAuthorId,"int",Empty) Call CheckParameter(dtmYearMonth,"dtm",Empty) i=InStr(1,TagsList,vbTab & strTagsName & vbVerticalTab,vbBinaryCompare) If i>0 Then j=Left(TagsList,i-1) i=InStrRev(j,vbTab) intTagsID=Right(j,Len(j)-i) Call CheckParameter(intTagsID,"int",Empty) End If '////////////////////////// 'ontop If True Then strType="Istop" & "Page1" & "[" s="Istop" & "Page" i=InStrRev(AllList,s) If i>0 Then j=InStr(i,AllList,"[",vbBinaryCompare) s=Mid(AllList,i+Len(s),j-i-Len(s)) intAllPage=CInt(s) End If i=InStr(1,AllList,strType,vbBinaryCompare) If i>0 Then i=Len(strType)+i j=InStr(i,AllList,"]",vbBinaryCompare) s=Mid(AllList,i,j-i) aryArticle=Split(s,";") End If If IsArray(aryArticle) Then Redim aryArticleList(UBound(aryArticle)) For i=LBound(aryArticle) To UBound(aryArticle)-1 Set objArticle = New TArticle objArticle.ID=aryArticle(i) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing Next k=Join(aryArticleList) Erase aryArticleList ReDim aryArticle(0) End If End If '//////////////////////////// strType="All" & "Page" & CStr(intPage) & "[" s="All" & "Page" Title=ZC_BLOG_SUBTITLE i=InStrRev(AllList,s) If i>0 Then j=InStr(i,AllList,"[",vbBinaryCompare) s=Mid(AllList,i+Len(s),j-i-Len(s)) intAllPage=CInt(s) End If i=InStr(1,AllList,strType,vbBinaryCompare) If i>0 Then i=Len(strType)+i j=InStr(i,AllList,"]",vbBinaryCompare) s=Mid(AllList,i,j-i) aryArticle=Split(s,";") End If If IsArray(aryArticle) Then Redim aryArticleList(UBound(aryArticle)) For i=LBound(aryArticle) To UBound(aryArticle)-1 Set objArticle = New TArticle objArticle.ID=aryArticle(i) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing Next Template_Article_Multi=k & Join(aryArticleList) End If TemplateTags_ArticleList_Page_Now=intPage TemplateTags_ArticleList_Page_All=intAllPage Call ExportBar(intPage,intAllPage,intCateId,intAuthorId,dtmYearMonth,strTagsName) ExportByCache=True End Function Public Function ExportByMixed(intPage,intCateId,intAuthorId,dtmYearMonth,strTagsName,intType) Dim strType Dim i,j,k,l,s Dim objRS Dim intPageCount Dim objArticle Dim intAllPage Call CheckParameter(intPage,"int",1) Call CheckParameter(intCateId,"int",Empty) Call CheckParameter(intAuthorId,"int",Empty) Call CheckParameter(dtmYearMonth,"dtm",Empty) Title=ZC_BLOG_SUBTITLE Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn '////////////////////////// 'ontop If True Then strType="Istop" & "Page1" & "[" s="Istop" & "Page" i=InStrRev(AllList,s) If i>0 Then j=InStr(i,AllList,"[",vbBinaryCompare) s=Mid(AllList,i+Len(s),j-i-Len(s)) intAllPage=CInt(s) End If i=InStr(1,AllList,strType,vbBinaryCompare) If i>0 Then i=Len(strType)+i j=InStr(i,AllList,"]",vbBinaryCompare) s=Mid(AllList,i,j-i) aryArticle=Split(s,";") End If If IsArray(aryArticle) Then Redim aryArticleList(UBound(aryArticle)) For i=LBound(aryArticle) To UBound(aryArticle)-1 Set objArticle = New TArticle objArticle.ID=aryArticle(i) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing Next k=Join(aryArticleList) Erase aryArticleList ReDim aryArticle(0) End If End If '//////////////////////////// objRS.Source="SELECT [log_ID] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Istop]=False) AND ([log_Level]>1)" If Not IsEmpty(intCateId) Then objRS.Source=objRS.Source & "AND([log_CateID]="&intCateId&")" On Error Resume Next Title=Categorys(intCateId).Name TemplateTags_ArticleList_Category_ID=Categorys(intCateId).ID Err.Clear End if If Not IsEmpty(intAuthorId) Then objRS.Source=objRS.Source & "AND([log_AuthorID]="&intAuthorId&")" On Error Resume Next Title=Users(intAuthorId).Name TemplateTags_ArticleList_Author_ID=Users(intAuthorId).ID Err.Clear End If If IsDate(dtmYearMonth) Then Dim y Dim m Dim d Dim ny Dim nm If IsDate(dtmYearMonth) Then ' dtmYearMonth=CDate(dtmYearMonth) Else Call showError(3) End If y=Year(dtmYearMonth) m=Month(dtmYearMonth) d=Day(dtmYearMonth) TemplateTags_ArticleList_Date_ShortDate=dtmYearMonth TemplateTags_ArticleList_Date_Year=y TemplateTags_ArticleList_Date_Month=m TemplateTags_ArticleList_Date_Day=d ny=y nm=m+1 If m=12 Then ny=ny+1:nm=1 If InstrRev(CStr(dtmYearMonth),"-")>=7 Then objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&") AND(Day([log_PostTime])="&d&")" Else objRS.Source=objRS.Source & "AND(Year([log_PostTime])="&y&") AND(Month([log_PostTime])="&m&")" End If Template_Calendar="" Title=Year(dtmYearMonth) & " " & ZVA_Month(Month(dtmYearMonth)) End If If Not IsEmpty(strTagsName) Then On Error Resume Next Dim Tag For Each Tag in Tags If IsObject(Tag) Then If UCase(Tag.Name)=UCase(strTagsName) Then objRS.Source=objRS.Source & "AND([log_Tag] LIKE '%{" & Tag.ID & "}%')" TemplateTags_ArticleList_Tags_ID=Tag.ID End If End If Next Err.Clear Title=strTagsName End If objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_DISPLAY_COUNT intPageCount=objRS.PageCount objRS.AbsolutePage = intPage For i = 1 To objRS.PageSize ReDim Preserve aryArticleList(i) Set objArticle = New TArticle objArticle.ID=objRS(0) If objArticle.LoadCache Then aryArticleList(i)=objArticle.Template_Article_Multi End if Set objArticle = Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() Set objRS=Nothing Template_Article_Multi=k & Join(aryArticleList) TemplateTags_ArticleList_Page_Now=intPage TemplateTags_ArticleList_Page_All=intPageCount Call ExportBar(intPage,intPageCount,intCateId,intAuthorId,dtmYearMonth,strTagsName) ExportByMixed=True End Function Public Function Build() Dim aryTemplateTagsName Dim aryTemplateTagsValue Dim i,j If IsEmpty(html) Then html=template html=Replace(html,"<#template:article-multi#>",Template_Article_Multi) html=Replace(html,"<#template:pagebar#>",Template_PageBar) html=Replace(html,"<#template:pagebar_next#>",Template_PageBar_Next) html=Replace(html,"<#template:pagebar_previous#>",Template_PageBar_Previous) html=Replace(html,"<#articlelist/author/id#>",TemplateTags_ArticleList_Author_ID) html=Replace(html,"<#articlelist/tags/id#>",TemplateTags_ArticleList_Tags_ID) html=Replace(html,"<#articlelist/category/id#>",TemplateTags_ArticleList_Category_ID) html=Replace(html,"<#articlelist/date/year#>",TemplateTags_ArticleList_Date_Year) html=Replace(html,"<#articlelist/date/month#>",TemplateTags_ArticleList_Date_Month) html=Replace(html,"<#articlelist/date/day#>",TemplateTags_ArticleList_Date_Day) html=Replace(html,"<#articlelist/date/shortdate#>",TemplateTags_ArticleList_Date_ShortDate) html=Replace(html,"<#articlelist/page/now#>",TemplateTags_ArticleList_Page_Now) html=Replace(html,"<#articlelist/page/all#>",TemplateTags_ArticleList_Page_All) Application.Lock aryTemplateTagsName=Application(ZC_BLOG_CLSID & "TemplateTagsName") aryTemplateTagsValue=Application(ZC_BLOG_CLSID & "TemplateTagsValue") Application.UnLock aryTemplateTagsName(0)="BlogTitle" aryTemplateTagsValue(0)=Title j=UBound(aryTemplateTagsName) For i=0 to j html=Replace(html,"<#" & aryTemplateTagsName(i) & "#>",aryTemplateTagsValue(i)) Next If IsEmpty(Template_Calendar) Or Len(Template_Calendar)=0 Then For i=1 to j If aryTemplateTagsName(i)="CACHE_INCLUDE_CALENDAR" Then Template_Calendar=aryTemplateTagsValue(i) End If Next End If html=Replace(html,"<#CACHE_INCLUDE_CALENDAR_NOW#>",Template_Calendar) Build=True End Function Function Save() html=TransferHTML(html,"[no-asp]") If ZC_STATIC_TYPE="asp" Then html="<"&"%@ CODEPAGE=65001 %"&">" & html End If If ZC_MOONSOFT_PLUGIN_ENABLE=True Then Call CreatDirectoryByCustomDirectory(Directory) End If Call SaveToFile(BlogPath & Directory & FileName,html,"utf-8",False) Save=True End Function Function SetVar(TemplateTag,TemplateValue) If IsEmpty(html) Then html=template html=Replace(html,"<#" & TemplateTag & "#>",TemplateValue) End Function Public Function Search(strQuestion) Dim i Dim j Dim s Dim objRS Dim intPageCount Dim objArticle strQuestion=Trim(strQuestion) If Len(strQuestion)=0 Then Search=True:Exit Function If CheckRegExp(strQuestion,"[nojapan]") Then Exit Function strQuestion=FilterSQL(strQuestion) Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="SELECT [log_ID],[log_Tag],[log_CateID],[log_Title],[log_Intro],[log_Content],[log_Level],[log_AuthorID],[log_PostTime],[log_CommNums],[log_ViewNums],[log_TrackBackNums],[log_Url],[log_Istop] FROM [blog_Article] WHERE ([log_ID]>0) AND ([log_Level]>2)" objRS.Source=objRS.Source & "AND (InStr(1,LCase([log_Title]),LCase('" & strQuestion &"'),0)<>0) OR (InStr(1,LCase([log_Intro]),LCase('" & strQuestion &"'),0)<>0) OR (InStr(1,LCase([log_Content]),LCase('" & strQuestion &"'),0)<>0) " objRS.Source=objRS.Source & "ORDER BY [log_PostTime] DESC,[log_ID] DESC" objRS.Open() s=Replace(Replace(ZC_MSG086,"%s","" & TransferHTML(Replace(strQuestion,Chr(39)&Chr(39),Chr(39)),"[html-format]") & "",vbTextCompare,1),"%s","" & objRS.RecordCount & "") If (Not objRS.bof) And (Not objRS.eof) Then objRS.PageSize = ZC_SEARCH_COUNT intPageCount=objRS.PageCount objRS.AbsolutePage = 1 For i = 1 To objRS.PageSize ReDim Preserve aryArticleList(i) Set objArticle=New TArticle If objArticle.LoadInfoByArray(Array(objRS(0),objRS(1),objRS(2),objRS(3),objRS(4),objRS(5),objRS(6),objRS(7),objRS(8),objRS(9),objRS(10),objRS(11),objRS(12),objRS(13))) Then If objArticle.Export(ZC_DISPLAY_MODE_SEARCH)= True Then aryArticleList(i)=objArticle.Template_Article_Search End If End If Set objArticle=Nothing objRS.MoveNext If objRS.EOF Then Exit For Next End If objRS.Close() Set objRS=Nothing Template_Article_Multi=Join(aryArticleList) Search=True End Function Public Function ExportBar(intNowPage,intAllPage,intCateId,intAuthorId,dtmYearMonth,strTagsName) Dim i Dim s Dim t Dim strPageBar If Not IsEmpty(intCateId) Then t=t & "cate=" & intCateId & "&" If Not IsEmpty(dtmYearMonth) Then t=t & "date=" & Year(dtmYearMonth) & "-" & Month(dtmYearMonth) If InstrRev(CStr(dtmYearMonth),"-")>=7 Then t=t & "-" & Day(dtmYearMonth) End If t=t & "&" End If If Not IsEmpty(intAuthorId) Then t=t & "auth=" & intAuthorId & "&" If Not (strTagsName="") Then t=t & "tags=" & Server.URLEncode(strTagsName) & "&" If intAllPage>0 Then Dim a,b s=ZC_BLOG_HOST & "catalog.asp?"& t &"page=1" Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG285) Template_PageBar=Template_PageBar & strPageBar If intAllPage>ZC_PAGEBAR_COUNT Then a=intNowPage b=intNowPage+ZC_PAGEBAR_COUNT If a>ZC_PAGEBAR_COUNT Then a=a-1:b=b-1 If b>intAllPage Then b=intAllPage:a=intAllPage-ZC_PAGEBAR_COUNT Else a=1:b=intAllPage End If For i=a to b s=ZC_BLOG_HOST & "catalog.asp?"& t &"page="& i Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock If i=intNowPage then Template_PageBar=Template_PageBar & "" & i & "" Else strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",i) Template_PageBar=Template_PageBar & strPageBar End If Next s=ZC_BLOG_HOST & "catalog.asp?"& t &"page="& intAllPage Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG286) Template_PageBar=Template_PageBar & strPageBar If intNowPage=1 Then Template_PageBar_Previous="" Else Template_PageBar_Previous=""&ZC_MSG156&"" End If If intNowPage=intAllPage Then Template_PageBar_Next="" Else Template_PageBar_Next=""&ZC_MSG155&"" End If End If ExportBar=True End Function Public Function LoadCache() Dim strContent strContent="" strContent=LoadFromFile(BlogPath & "/CACHE/cache_list_"&ZC_BLOG_CLSID&".html","utf-8") AllList=strContent LoadCache=True End Function Private Sub Class_Initialize() Redim Article(ZC_DISPLAY_COUNT) End Sub End Class '********************************************************* '********************************************************* ' 目的? 定义TUser? ' 输入? ? ' 返回? ? '********************************************************* Class TUser Public ID Public Level Public Name Public Password Public Alias Public Sex Public Email Public MSN Public QQ Public HomePage Public Intro Public Count Public LastVisitTime Public LastVisitIP Public Property Get Url Url = ZC_BLOG_HOST & "catalog.asp?"& "auth=" & ID End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Public Property Get RssUrl RssUrl = ZC_BLOG_HOST & "sydication.asp?user=" & ID End Property Private FLoginType Public Property Let LoginType(strLoginType) If (strLoginType="Form") Or (strLoginType="QueryString") Or (strLoginType="Self") Then FLoginType=strLoginType Else FLoginType="Cookies" End If End Property Public Property Get LoginType If IsEmpty(FLoginType)=True Then LoginType="Cookies" Else LoginType = FLoginType End If End Property Public Property Get StaticName If IsNull(Alias) Or IsEmpty(Alias) Or Alias="" Then StaticName = "user_" & ID Else StaticName = Alias End If End Property Public Function Verify() Dim strUserName Dim strPassWord If LoginType="Cookies" Then strPassWord=Request.Cookies("password") If (strPassWord="") Then Exit Function strUserName=vbsunescape(Request.Cookies("username")) If (strUserName="") Then Exit Function ElseIf LoginType="Form" Then strPassWord=Request.Form("password") If (strPassWord="") Then Exit Function strUserName=Request.Form("username") If (strUserName="") Then Exit Function ElseIf LoginType="QueryString" Then strPassWord=Request.QueryString("password") If (strPassWord="") Then Exit Function strUserName=Request.QueryString("username") If (strUserName="") Then Exit Function ElseIf LoginType="Self" Then strPassWord=Password If (strPassWord="") Then Exit Function strUserName=Name If (strUserName="") Then Exit Function Else Exit Function End If strUserName=FilterSQL(strUserName) strPassWord=FilterSQL(strPassWord) '校检 If Len(strUserName) >ZC_USERNAME_MAX Then Call ShowError(7) If Len(strPassWord)<>ZC_PASSWORD_MAX Then Call ShowError(7) If Not CheckRegExp(strUserName,"[username]") Then Call ShowError(7) If Not CheckRegExp(strPassWord,"[password]") Then Call ShowError(7) Dim objRS Set objRS=objConn.Execute("SELECT [mem_ID],[mem_Level],[mem_Password] FROM [blog_Member] WHERE [mem_Name]='"&strUserName & "'" ) If (Not objRS.Bof) And (Not objRS.Eof) Then If StrComp(strPassWord,objRS("mem_Password"))=0 Then ID=objRS("mem_ID") LoadInfobyID(ID) Verify=True Else If LoginType="Cookies" Then Response.Cookies("password")="" End If Else If LoginType="Cookies" Then Response.Cookies("password")="" End If objRS.Close Set objRS=Nothing End Function Function LoadInfobyID(user_ID) Call CheckParameter(user_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [mem_ID],[mem_Name],[mem_Level],[mem_Password],[mem_Email],[mem_HomePage],[mem_PostLogs],[mem_Intro] FROM [blog_Member] WHERE [mem_ID]=" & user_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("mem_ID") Name=objRS("mem_Name") Level=objRS("mem_Level") Password=objRS("mem_Password") Email=objRS("mem_Email") HomePage=objRS("mem_HomePage") Count=objRS("mem_PostLogs") Alias=objRS("mem_Intro") If IsNull(Email) Or IsEmpty(Email) Or Len(Email)=0 Then Email="a@b.com" If IsNull(HomePage) Then HomePage="" If IsNull(Alias) Then Alias="" LoadInfobyID=True End If objRS.Close Set objRS=Nothing End Function Public Function LoadInfoByArray(aryUserInfo) If IsArray(aryUserInfo)=True Then ID=aryUserInfo(0) Name=aryUserInfo(1) Level=aryUserInfo(2) Password=aryUserInfo(3) Email=aryUserInfo(4) HomePage=aryUserInfo(5) Count=aryUserInfo(6) Alias=aryUserInfo(7) End If If IsNull(Email) Or IsEmpty(Email) Or Len(Email)=0 Then Email="a@b.com" If IsNull(HomePage) Then HomePage="" If IsNull(Alias) Then Alias="" LoadInfoByArray=True End Function Function Edit(currentUser) Call CheckParameter(ID,"int",0) Call CheckParameter(Level,"int",0) If ((Level<1) Or (Level>5)) Then Call ShowError(16) If (Name="") Then Call ShowError(7) If Len(Name) >ZC_USERNAME_MAX Then Call ShowError(7) If Not CheckRegExp(Name,"[username]") Then Call ShowError(7) Email=FilterSQL(Email) HomePage=FilterSQL(HomePage) Email=TransferHTML(Email,"[html-format]") HomePage=TransferHTML(HomePage,"[html-format]") Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) If Len(Email)=0 Then Call ShowError(29) If Len(Email)>ZC_EMAIL_MAX Then Call ShowError(29) If Len(HomePage)>ZC_HOMEPAGE_MAX Then Call ShowError(29) If Not CheckRegExp(Email,"[email]") Then Call ShowError(29) IF Len(HomePage)>0 Then If Not CheckRegExp(HomePage,"[homepage]") Then Call ShowError(30) End If If ID=0 Then If Level <= currentUser.Level Then ShowError(6) If Len(PassWord)<>ZC_PASSWORD_MAX Then Call ShowError(7) If Not CheckRegExp(PassWord,"[password]") Then Call ShowError(7) objConn.Execute("INSERT INTO [blog_Member]([mem_Level],[mem_Name],[mem_PassWord],[mem_Email],[mem_HomePage],[mem_Intro]) VALUES ("&Level&",'"&Name&"','"&PassWord&"','"&Email&"','"&HomePage&"','"&Alias&"')") Edit=True Else If (ID=currentUser.ID) And (Level <> currentUser.Level) Then ShowError(6) If (ID<>currentUser.ID) And (Level <= currentUser.Level) Then ShowError(6) Dim targetUser Set targetUser=New TUser If targetUser.LoadInfobyID(ID) Then If Len(PassWord)=0 Then PassWord=targetUser.PassWord If Len(PassWord)<>ZC_PASSWORD_MAX Then Call ShowError(6) If Not CheckRegExp(PassWord,"[password]") Then Call ShowError(7) Else Exit Function End If objConn.Execute("UPDATE [blog_Member] SET [mem_Level]="&Level&",[mem_Name]='"&Name&"',[mem_PassWord]='"&PassWord&"',[mem_Email]='"&Email&"',[mem_HomePage]='"&HomePage&"',[mem_Intro]='"&Alias&"' WHERE [mem_ID]="&ID) If Name <> targetUser.Name Then objConn.Execute("UPDATE [blog_Comment] SET [comm_Author]='"&Name&"' WHERE [comm_AuthorID]="&ID) End If If Email <> targetUser.Email Then objConn.Execute("UPDATE [blog_Comment] SET [comm_Email]='"&Email&"' WHERE [comm_AuthorID]="&ID) End If Edit=True If (ID=currentUser.ID) Then Response.Cookies("username")=Name Response.Cookies("password")=PassWord End If End If End Function Function Register(currentUser) Call CheckParameter(ID,"int",0) Call CheckParameter(Level,"int",0) If (Level<>4) Then Call ShowError(16) If (Name="") Then Call ShowError(7) If Len(Name) >ZC_USERNAME_MAX Then Call ShowError(7) If Not CheckRegExp(Name,"[username]") Then Call ShowError(7) Email=FilterSQL(Email) HomePage=FilterSQL(HomePage) Email=TransferHTML(Email,"[html-format]") HomePage=TransferHTML(HomePage,"[html-format]") Alias=TransferHTML(Alias,"[filename]") Alias=FilterSQL(Alias) If Len(Email)=0 Then Call ShowError(29) If Len(Email)>ZC_EMAIL_MAX Then Call ShowError(29) If Len(HomePage)>ZC_HOMEPAGE_MAX Then Call ShowError(29) If Not CheckRegExp(Email,"[email]") Then Call ShowError(30) IF Len(HomePage)>0 Then If Not CheckRegExp(HomePage,"[homepage]") Then Call ShowError(30) End If If ID=0 Then If Level <= 1 Then ShowError(6) If Len(PassWord)<>ZC_PASSWORD_MAX Then Call ShowError(7) If Not CheckRegExp(PassWord,"[password]") Then Call ShowError(7) objConn.Execute("INSERT INTO [blog_Member]([mem_Level],[mem_Name],[mem_PassWord],[mem_Email],[mem_HomePage],[mem_Intro]) VALUES ("&Level&",'"&Name&"','"&PassWord&"','"&Email&"','"&HomePage&"','"&Alias&"')") Register=True End If End Function Function Del(currentUser) Dim objRS Dim objUpLoadFile Call CheckParameter(ID,"int",0) Call CheckParameter(Level,"int",0) Dim targetUser Set targetUser=New TUser If targetUser.LoadInfobyID(ID) Then If targetUser.Level<= currentUser.Level Then ShowError(6) If currentUser.ID = targetUser.ID Then ShowError(17) Else Exit Function End If objConn.Execute("DELETE FROM [blog_Article] WHERE [log_AuthorID] =" & ID) objConn.Execute("DELETE FROM [blog_Comment] WHERE [comm_AuthorID] =" & ID) objConn.Execute("DELETE FROM [blog_Member] WHERE [mem_ID] =" & ID) Set objRS=objConn.Execute("SELECT * FROM [blog_UpLoad] WHERE [ul_AuthorID] =" & ID) If (Not objRS.bof) And (Not objRS.eof) Then Do While Not objRS.eof Set objUpLoadFile=New TUpLoadFile If objUpLoadFile.LoadInfoByID(objRS("ul_ID")) Then objUpLoadFile.Del Set objUpLoadFile=Nothing objRS.MoveNext Loop End If objRS.Close Set objRS=Nothing objConn.Execute("DELETE FROM [blog_UpLoad] WHERE [ul_AuthorID] =" & ID) Del=True End Function Private Sub Class_Initialize() Level=5 ID=0 Name=ZC_MSG018 Sex=0 Email="" MSN="" QQ="" HomePage="" Intro="" End Sub End Class '********************************************************* '********************************************************* ' 目的? 定义TComment? ' 输入? ? ' 返回? ? '********************************************************* Class TComment Public ID Public log_ID Public AuthorID Public Author Public Content Public Email Public HomePage Public PostTime Public IP Public Agent Public Count Public Property Get HomePageForAntiSpam HomePageForAntiSpam=URLEncodeForAntiSpam(HomePage) End Property Public Property Get SafeEmail If (Email="") Or IsEmpty(Email) Or IsNull(Email) Then Email="null@null.com" SafeEmail=Replace(Email,"@","[AT]") End Property Public Property Get EmailMD5 If (Email="") Or IsEmpty(Email) Or IsNull(Email) Then EmailMD5="" Else EmailMD5=MD5(Email) End If End Property Public Property Get FirstContact If Len(HomePage)>0 Then FirstContact=HomePageForAntiSpam Else FirstContact="mailto:" & SafeEmail End If End Property Public Property Get HtmlContent 'HtmlContent=TransferHTML(UBBCode(Content,"[font][face]"),"[enter][nofollow]") HtmlContent=TransferHTML(UBBCode(Content,"[link][link-antispam][font][face]"),"[enter][nofollow]") End Property Public Function Post() IP=Request.ServerVariables("REMOTE_ADDR") Agent=Request.ServerVariables("HTTP_USER_AGENT") If Len(HomePage)>0 Then If InStr(HomePage,"http://")=0 Then HomePage="http://" & HomePage End If '检查参? Call CheckParameter(log_ID,"int",0) Call CheckParameter(AuthorID,"int",0) Call CheckParameter(PostTime,"dtm",Now) Author=FilterSQL(Author) Content=FilterSQL(Content) Email=FilterSQL(Email) HomePage=FilterSQL(HomePage) PostTime=FilterSQL(PostTime) IP=FilterSQL(IP) Agent=FilterSQL(Agent) 'log_ID不能? If Len(Author)=0 Then Call ShowError(15) If Len(Content)=0 Then Call ShowError(46) If Len(Content)>ZC_CONTENT_MAX Then Call ShowError(46) Author=TransferHTML(Author,"[html-format]") Email=TransferHTML(Email,"[html-format]") HomePage=TransferHTML(HomePage,"[html-format]") Content=TransferHTML(Content,"[html-format]") If Len(Author)>ZC_USERNAME_MAX Then Call ShowError(15) If Len(Email)>ZC_EMAIL_MAX Then Call ShowError(29) If Len(HomePage)>ZC_HOMEPAGE_MAX Then Call ShowError(30) If Not CheckRegExp(Author,"[username]") Then Call ShowError(15) IF Len(Email)>0 Then If Not CheckRegExp(Email,"[email]") Then Call ShowError(29) End If IF Len(HomePage)>0 Then If Not CheckRegExp(HomePage,"[homepage]") Then Call ShowError(30) End If Dim objRS Dim strSpamIP Dim strSpamContent Set objRS=objConn.Execute("SELECT [comm_IP],[comm_Content] FROM [blog_Comment] WHERE [comm_ID]= ( SELECT MAX(comm_ID) FROM [blog_Comment] )") If (Not objRS.bof) And (Not objRS.eof) Then strSpamIP=objRS("comm_IP") strSpamContent=objRS("comm_Content") End If objRS.Close Set objRS=Nothing If (ID=0) And (strSpamIP=IP) And (strSpamContent=Content) Then Call ShowError(39) End If If ID=0 Then objConn.Execute("INSERT INTO [blog_Comment]([log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_IP],[comm_PostTime],[comm_Agent]) VALUES ("&log_ID&","&AuthorID&",'"&Author&"','"&Content&"','"&Email&"','"&HomePage&"','"&IP&"','"&PostTime&"','"&Agent&"')") Set objRS=objConn.Execute("SELECT MAX([comm_ID]) FROM [blog_Comment]") If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS(0) End If Set objRS=Nothing Else objConn.Execute("UPDATE [blog_Comment] SET [log_ID]="&log_ID&", [comm_AuthorID]="&AuthorID&",[comm_Author]='"&Author&"',[comm_Content]='"&Content&"',[comm_Email]='"&Email&"',[comm_HomePage]='"&HomePage&"',[comm_IP]='"&IP&"',[comm_PostTime]='"&PostTime&"',[comm_Agent]='"&Agent&"' WHERE [comm_ID] =" & ID) End If Post=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_Comment] WHERE [comm_ID] =" & ID) Del=True End Function Public Function LoadInfoByID(comm_ID) Call CheckParameter(comm_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [comm_ID],[log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_PostTime],[comm_IP],[comm_Agent] FROM [blog_Comment] WHERE [comm_ID]=" & comm_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("comm_ID") log_ID=objRS("log_ID") AuthorID=objRS("comm_AuthorID") Author=objRS("comm_Author") Content=objRS("comm_Content") Email=objRS("comm_Email") HomePage=objRS("comm_HomePage") PostTime=objRS("comm_PostTime") IP=objRS("comm_IP") Agent=objRS("comm_Agent") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(HomePage) Then HomePage="" End Function Public Function LoadInfoByArray(aryCommInfo) If IsArray(aryCommInfo)=True Then ID=aryCommInfo(0) log_ID=aryCommInfo(1) AuthorID=aryCommInfo(2) Author=aryCommInfo(3) Content=aryCommInfo(4) Email=aryCommInfo(5) HomePage=aryCommInfo(6) PostTime=aryCommInfo(7) IP=aryCommInfo(8) Agent=aryCommInfo(9) End If If IsNull(HomePage) Then HomePage="" LoadInfoByArray=True End Function Public Function MakeTemplate(strC) strC=Replace(strC,"<#article/comment/id#>",ID) strC=Replace(strC,"<#article/comment/name#>",Author) strC=Replace(strC,"<#article/comment/url#>",HomePage) strC=Replace(strC,"<#article/comment/urlencoder#>",HomePageForAntiSpam) strC=Replace(strC,"<#article/comment/email#>",SafeEmail) strC=Replace(strC,"<#article/comment/posttime#>",PostTime) strC=Replace(strC,"<#article/comment/content#>",HtmlContent) strC=Replace(strC,"<#article/comment/count#>",Count) strC=Replace(strC,"<#article/comment/authorid#>",AuthorID) strC=Replace(strC,"<#article/comment/firstcontact#>",FirstContact) strC=Replace(strC,"<#article/comment/emailmd5#>",EmailMD5) MakeTemplate=strC End Function End Class '********************************************************* '********************************************************* ' 目的? 定义TTrackBack? ' 输入? ? ' 返回? ? '********************************************************* Class TTrackBack Public ID Public log_ID Public URL Public Title Public Blog Public Excerpt Public PostTime Public IP Public Agent Public Count Public Property Get UrlForAntiSpam UrlForAntiSpam=URLEncodeForAntiSpam(Url) End Property Public Property Get HtmlExcerpt HtmlExcerpt=TransferHTML(Excerpt,"[enter]") End Property Private Function ReturnTbXML(strMsg) Dim strXML strXML="%e%m" If strMsg="undiscovered" Then'未发现相应ID strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) ElseIf strMsg="repetition" Then'重复PING strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) Elseif strMsg="invalid parameter" Then'非法参数 strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) Elseif strMsg="none data" Then'无数? strXML=Replace(strXML,"%e","1") strXML=Replace(strXML,"%m",strMsg) Else'PING 成功 strXML=Replace(strXML,"%e","0") strXML=Replace(strXML,"%m",strMsg) End If 'Response.ContentType = "text/html" Response.ContentType = "text/xml" Response.Clear Response.Write strXML End Function Public Function Post() Dim objRS 'Call ReturnTbXML("undiscovered"):Exit Function Call CheckParameter(log_ID,"int",0) If IsDate(PostTime)=False Then PostTime=Now() IP=Request.ServerVariables("REMOTE_ADDR") Agent=Request.ServerVariables("HTTP_USER_AGENT") IP=FilterSQL(IP) Agent=FilterSQL(Agent) URL=FilterSQL(URL) Title=FilterSQL(Title) Blog=FilterSQL(Blog) Excerpt=FilterSQL(Excerpt) Blog=TransferHTML(Blog,"[html-format]") Title=TransferHTML(Title,"[html-format]") Excerpt=TransferHTML(Excerpt,"[html-format][nohtml]") URL=TransferHTML(URL,"[html-format]") 'log_ID不能? If (log_ID=0) Then Call ReturnTbXML("invalid parameter"):Post=False:Exit Function If Len(URL)=0 Then Call ReturnTbXML("none data"):Post=False:Exit Function If Len(URL)>ZC_HOMEPAGE_MAX Then Call ReturnTbXML("url is long"):Post=False:Exit Function If Len(Blog)>ZC_EMAIL_MAX Then Call ReturnTbXML("name is long"):Post=False:Exit Function If Len(Blog)=0 Then Blog="Unknow" If Len(Excerpt)=0 Then Excerpt="" If Len(Excerpt)>ZC_TB_EXCERPT_MAX Then Excerpt=Left(Excerpt,ZC_TB_EXCERPT_MAX)&"..." If Len(Title)>ZC_HOMEPAGE_MAX Then Call ReturnTbXML("title is long"):Post=False:Exit Function If Len(Title)=0 Then Title=URL '检查ID是否存在 'Set objRS=objConn.Execute("SELECT * FROM [blog_Article] WHERE [log_ID]=" & log_ID) 'If (Not objRS.bof) And (Not objRS.eof) Then 'Else ' objRS.close ' Call returnTbXML("undiscovered") ' Exit Function 'End If 'objRS.Close 'Set objRS=Nothing '检查是否已TB? Set objRS=objConn.Execute("SELECT * FROM [blog_TrackBack] WHERE [log_ID]=" & log_ID & " and [tb_url]='" & URL & "'") If (Not objRS.bof) And (Not objRS.eof) Then objRS.close Call returnTbXML("repetition") Exit Function End If objRS.Close Set objRS=Nothing '接收TB If ID=0 Then objConn.Execute("INSERT INTO [blog_TrackBack]([log_ID],[tb_URL],[tb_Title],[tb_Blog],[tb_Excerpt],[tb_PostTime],[tb_IP],[tb_Agent]) VALUES ("&log_ID&",'"&URL&"','"&Title&"','"&Blog&"','"&Excerpt&"','"&PostTime&"','"&IP&"','"&Agent&"')") Else objConn.Execute("UPDATE [blog_TrackBack] SET [log_ID]="&log_ID&", [tb_URL]='"&URL&"',[tb_Excerpt]='"&Excerpt&"',[tb_Title]='"&Title&"',[tb_Blog]='"&Blog&"',[tb_IP]='"&IP&"',[tb_PostTime]='"&PostTime&"',[tb_Agent]='"&Agent&"' WHERE [tb_ID] =" & ID) End If Call returnTbXML("succeed") Post=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_TrackBack] WHERE [tb_ID] =" & ID) Del=True End Function Function Send(strAddress) Dim strSendTB strSendTB = "title=" & Server.URLEncode(Title) & "&url=" & Server.URLEncode(URL) & "&excerpt=" & Server.URLEncode(Excerpt) & "&blog_name=" & Server.URLEncode(Blog) Dim objPing Set objPing = Server.CreateObject("MSXML2.ServerXMLHTTP") objPing.open "POST",strAddress,False objPing.setRequestHeader "Content-Type", "application/x-www-form-urlencoded" objPing.send strSendTB 'Response.ContentType = "text/xml" 'Response.Clear 'Response.Write objPing.responseXML.xml Set objPing = Nothing Send=True End Function Public Function LoadInfoByID(tb_ID) Call CheckParameter(tb_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [tb_ID],[log_ID],[tb_URL],[tb_Title],[tb_Blog],[tb_Excerpt],[tb_PostTime],[tb_IP],[tb_Agent] FROM [blog_TrackBack] WHERE [tb_ID]=" & tb_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("tb_ID") log_ID=objRS("log_ID") URL=objRS("tb_URL") Title=objRS("tb_Title") Blog=objRS("tb_Blog") Excerpt=objRS("tb_Excerpt") PostTime=objRS("tb_PostTime") IP=objRS("tb_IP") Agent=objRS("tb_Agent") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(Excerpt) Then Excerpt="" End Function Public Function LoadInfoByArray(aryTbInfo) If IsArray(aryTbInfo)=True Then ID=aryTbInfo(0) log_ID=aryTbInfo(1) URL=aryTbInfo(2) Title=aryTbInfo(3) Blog=aryTbInfo(4) Excerpt=aryTbInfo(5) PostTime=aryTbInfo(6) IP=aryTbInfo(7) Agent=aryTbInfo(8) End If If IsNull(Excerpt) Then Excerpt="" LoadInfoByArray=True End Function Public Function MakeTemplate(strT) strT=Replace(strT,"<#article/trackback/id#>",ID) strT=Replace(strT,"<#article/trackback/name#>",Blog) strT=Replace(strT,"<#article/trackback/url#>",UrlForAntiSpam) strT=Replace(strT,"<#article/trackback/title#>",Title) strT=Replace(strT,"<#article/trackback/posttime#>",PostTime) strT=Replace(strT,"<#article/trackback/content#>",HtmlExcerpt) strT=Replace(strT,"<#article/trackback/count#>",Count) MakeTemplate=strT End Function End Class '********************************************************* '********************************************************* ' 目的? 定义TUpLoadFile? ' 输入? ? ' 返回? ? '********************************************************* Class TUpLoadFile Public ID Public AuthorID Public FileSize Public FileName Public PostTime Public Stream Private FUploadType Public Property Let UploadType(strUploadType) If (strUploadType="Stream") Then FUploadType=strUploadType Else FUploadType="Form" End If End Property Public Property Get UploadType If IsEmpty(FUploadType)=True Then UploadType="Form" Else UploadType = FUploadType End If End Property Public Function LoadInfoByID(ul_ID) Call CheckParameter(ul_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [ul_ID],[ul_AuthorID],[ul_FileSize],[ul_FileName],[ul_PostTime] FROM [blog_UpLoad] WHERE [ul_ID]=" & ul_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("ul_ID") AuthorID=objRS("ul_AuthorID") FileSize=objRS("ul_FileSize") FileName=objRS("ul_FileName") PostTime=objRS("ul_PostTime") LoadInfobyID=True End If objRS.Close Set objRS=Nothing End Function Public Function LoadInfoByArray(aryULInfo) If IsArray(aryULInfo)=True Then ID=aryULInfo(0) AuthorID=aryULInfo(1) FileSize=aryULInfo(2) FileName=aryULInfo(3) PostTime=aryULInfo(4) End If LoadInfoByArray=True End Function Private Function UpLoad_Form() Dim i,j Dim x,y,z Dim intFormSize Dim binFormData Dim strFileName intFormSize = Request.TotalBytes binFormData = Request.BinaryRead(intFormSize) If Instr(CStr(Request.ServerVariables("HTTP_USER_AGENT")),"Opera")>0 Then i=0 i=InstrB(binFormData,ChrB(13)&ChrB(10)&ChrB(13)&ChrB(10)) If i>0 Then i=i+3 j=InstrB(binFormData,ChrB(13)&ChrB(10)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)) Else i=InstrB(binFormData,ChrB(13)&ChrB(10)&ChrB(13)&ChrB(10)) i=i+3 j=InStrB(binFormData,ChrB(13)&ChrB(10)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)&ChrB(45)) End If If Len(Request.QueryString("filename"))>0 Then strFileName=Request.QueryString("filename") Else x=InstrB(binFormData,ChrB(&H66)&ChrB(&H69)&ChrB(&H6C)&ChrB(&H65)&ChrB(&H6E)&ChrB(&H61)&ChrB(&H6D)&ChrB(&H65)&ChrB(&H3D)&ChrB(&H22)) y=InstrB(x+11,binFormData,ChrB(&H22)) For z=1 to y-x-10 strFileName=strFileName & Chr(AscB(MidB(binFormData,x+z+9,1))) Next End If Dim objStreamUp Set objStreamUp = Server.CreateObject("ADODB.Stream") With objStreamUp .Type = adTypeBinary .Mode = adModeReadWrite .Open .Position = 0 .Write binFormData .Position = i Stream=.Read(j-i-1) .Close End With FileName=strFileName FileSize=LenB(Stream) End Function Private Function UpLoad_Stream() FileSize=LenB(Stream) End Function Public Function UpLoad(bolAutoName) If UploadType="Form" Then Call UpLoad_Form() ElseIf UploadType="Stream" Then Call UpLoad_Stream() End If If InStrRev(FileName,"\")>0 Then FileName=Mid(FileName,InStrRev(FileName,"\")+1) End If If InStrRev(FileName,"/")>0 Then FileName=Mid(FileName,InStrRev(FileName,"\")+1) End If FileName=TransferHTML(FileName,"[filename]") '超出类型限制 If Not CheckRegExp(LCase(FileName),"\.("& ZC_UPLOAD_FILETYPE &")$") Then Call ShowError(26) '超出大小限制 If FileSize>ZC_UPLOAD_FILESIZE Then Call ShowError(27) FileName=FilterSQL(FileName) If bolAutoName=True Then Randomize FileName=Year(Now) & Right("0"&Month(Now),2) & Right("0"&Day(Now),2) & Right("0"&Hour(Now),2) & Right("0"&Minute(Now),2) & Right("0"&Second(Now),2) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Int(9 * Rnd) & Right(FileName,Len(FileName)-InStrRev(FileName,".")+1) End If Dim objRS Set objRS=objConn.Execute("SELECT * FROM [blog_UpLoad] WHERE [ul_FileName] = '" & FileName & "'") If (Not objRS.bof) And (Not objRS.eof) Then '不能重名 Call ShowError(28) Else PostTime=Now() objConn.Execute("INSERT INTO [blog_UpLoad]([ul_AuthorID],[ul_FileSize],[ul_FileName],[ul_PostTime]) VALUES ("& AuthorID &","& FileSize &",'"& FileName &"','"& PostTime &"')") Dim objStreamFile Set objStreamFile = Server.CreateObject("ADODB.Stream") objStreamFile.Type = adTypeBinary objStreamFile.Mode = adModeReadWrite objStreamFile.Open objStreamFile.Write Stream objStreamFile.SaveToFile BlogPath & "/"& ZC_UPLOAD_DIRECTORY &"/" & FileName,adSaveCreateOverWrite objStreamFile.Close End If UpLoad=True End Function Public Function Del() Call CheckParameter(ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT * FROM [blog_UpLoad] WHERE [ul_ID] = " & ID) If (Not objRS.bof) And (Not objRS.eof) Then Dim fso Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & "/"& ZC_UPLOAD_DIRECTORY &"/" & objRS("ul_FileName")) Then fso.DeleteFile(BlogPath & "/"& ZC_UPLOAD_DIRECTORY &"/" & objRS("ul_FileName")) End If objConn.Execute("DELETE FROM [blog_UpLoad] WHERE [ul_ID] =" & ID) Else Exit Function End If objRS.Close Set objRS=Nothing Del=True End Function End Class '********************************************************* '********************************************************* ' 目的? 定义TTag? ' 输入? ? ' 返回? ? '********************************************************* Class TTag Public ID Public Name Public Intro Public Order Public Count Public Property Get EncodeName EncodeName = Server.URLEncode(Name) End Property Public Property Get Url Url = ZC_BLOG_HOST & "catalog.asp?"& "tags=" & Server.URLEncode(Name) End Property Public Property Get HtmlUrl HtmlUrl=TransferHTML(Url,"[html-format]") End Property Public Property Get HtmlIntro HtmlIntro=TransferHTML(Intro,"[html-format]") End Property Public Property Get HtmlName HtmlName=TransferHTML(Name,"[html-format]") End Property Public Property Get RssUrl RssUrl = ZC_BLOG_HOST & "sydication.asp?tags=" & ID End Property Public Function Post() Call CheckParameter(ID,"int",0) Call CheckParameter(Order,"int",0) Name=FilterSQL(Name) Name=TransferHTML(Name,"[normalname]") If Len(Name)=0 Then Post=False:Exit Function Intro=FilterSQL(Intro) Intro=TransferHTML(Intro,"[html-format]") If ID=0 Then objConn.Execute("INSERT INTO [blog_Tag]([tag_Name],[tag_Order],[tag_Intro]) VALUES ('"&Name&"',"&Order&",'"&Intro&"')") Else objConn.Execute("UPDATE [blog_Tag] SET [tag_Name]='"&Name&"',[tag_Order]="&Order&",[tag_Intro]='"&Intro&"' WHERE [tag_ID] =" & ID) End If Post=True End Function Public Function LoadInfoByID(tag_ID) Call CheckParameter(tag_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [tag_ID],[tag_Name],[tag_Intro],[tag_Order],[tag_Count] FROM [blog_Tag] WHERE [tag_ID]=" & tag_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("tag_ID") Name=objRS("tag_Name") Intro=objRS("tag_Intro") Order=objRS("tag_Order") Count=objRS("tag_Count") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(Intro) Then Intro="" End Function Public Function LoadInfoByArray(aryTagInfo) If IsArray(aryTagInfo)=True Then ID=aryTagInfo(0) Name=aryTagInfo(1) Intro=aryTagInfo(2) Order=aryTagInfo(3) Count=aryTagInfo(4) End If If IsNull(Intro) Then Intro="" LoadInfoByArray=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function Dim s Dim i Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="" objRS.Open("SELECT [log_ID],[log_tag] FROM [blog_Article] WHERE [log_Tag] LIKE '%{" & ID & "}%'") If (Not objRS.bof) And (Not objRS.eof) Then Do While Not objRS.eof i=objRS("log_ID") s=objRS("log_tag") s=Replace(s,"{"& ID &"}","") objConn.Execute("UPDATE [blog_Article] SET [log_tag]='"& s &"' WHERE [log_ID] =" & i) objRS.MoveNext Loop End If objRS.Close objConn.Execute("DELETE FROM [blog_Tag] WHERE [tag_ID] =" & ID) Del=True End Function Public Function MakeTemplate(s) s=Replace(s,"<#article/tag/id#>",ID) s=Replace(s,"<#article/tag/name#>",HtmlName) s=Replace(s,"<#article/tag/intro#>",HtmlIntro) s=Replace(s,"<#article/tag/count#>",Count) s=Replace(s,"<#article/tag/url#>",HtmlUrl) s=Replace(s,"<#article/tag/encodename#>",EncodeName) MakeTemplate=s End Function End Class '********************************************************* '********************************************************* ' 目的? 定义TKeyWord? ' 输入? ? ' 返回? ? '********************************************************* Class TKeyWord Public ID Public Name Public Intro Public Url Public Function Post() Call CheckParameter(ID,"int",0) Name=FilterSQL(Name) Name=TransferHTML(Name,"[normalname]") If Len(Name)=0 Then Post=False:Exit Function Intro=FilterSQL(Intro) Intro=TransferHTML(Intro,"[html-format]") Url=FilterSQL(Url) If Len(Url)=0 Then Post=False:Exit Function If Not CheckRegExp(Url,"[homepage]") Then Call ShowError(30) If ID=0 Then objConn.Execute("INSERT INTO [blog_Keyword]([key_Name],[key_URL],[key_Intro]) VALUES ('"&Name&"','"&Url&"','"&Intro&"')") Else objConn.Execute("UPDATE [blog_Keyword] SET [key_Name]='"&Name&"',[key_URL]='"&Url&"',[key_Intro]='"&Intro&"' WHERE [key_ID] =" & ID) End If Post=True End Function Public Function LoadInfoByID(key_ID) Call CheckParameter(key_ID,"int",0) Dim objRS Set objRS=objConn.Execute("SELECT [key_ID],[key_Name],[key_Intro],[key_Url] FROM [blog_Keyword] WHERE [key_ID]=" & key_ID) If (Not objRS.bof) And (Not objRS.eof) Then ID=objRS("key_ID") Name=objRS("key_Name") Intro=objRS("key_Intro") Url=objRS("key_Url") LoadInfoByID=True End If objRS.Close Set objRS=Nothing If IsNull(Intro) Then Intro="" End Function Public Function LoadInfoByArray(aryKeyWordInfo) If IsArray(aryKeywordInfo)=True Then ID=aryKeyWordInfo(0) Name=aryKeyWordInfo(1) Intro=aryKeyWordInfo(2) Url=aryKeyWordInfo(3) End If If IsNull(Intro) Then Intro="" LoadInfoByArray=True End Function Public Function Del() Call CheckParameter(ID,"int",0) If (ID=0) Then Del=False:Exit Function objConn.Execute("DELETE FROM [blog_Keyword] WHERE [key_ID] =" & ID) Del=True End Function End Class '********************************************************* '********************************************************* ' 目的? 定义TGuestBook? ' 输入? ? ' 返回? ? '********************************************************* Class TGuestBook Public Template_Article_Single Public Template_Article_Comment Public Template_Article_Commentpost Public Template_PageBar Public Template_Article_Commentpost_Verify Public html Private Ftemplate Public Property Let template(strFileName) Application.Lock Ftemplate=Application(ZC_BLOG_CLSID & "TEMPLATE_" & strFileName) Application.UnLock End Property Public Property Get template template = Ftemplate End Property Public Function Export(intPage) Dim i,j,strC_Count,objComment,strC If IsNumeric(intPage)=False Then intPage=1 Call CheckParameter(intPage,"int",1) Template_Article_Single=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-GUESTBOOK") If (Template_Article_Single="") Then Template_Article_Single=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-SINGLE") End If Template_Article_Commentpost=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST") If ZC_COMMENT_VERIFY_ENABLE=True Then Template_Article_Commentpost_Verify=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST-VERIFY") End If Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="" objRS.Open("SELECT COUNT([comm_ID])AS allComment FROM [blog_Comment] WHERE [blog_Comment].[log_ID]=0") If (Not objRS.bof) And (Not objRS.eof) Then strC_Count=objRS("allComment") End If objRS.Close Set objRS=Nothing Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="SELECT [comm_ID],[log_ID],[comm_AuthorID],[comm_Author],[comm_Content],[comm_Email],[comm_HomePage],[comm_PostTime],[comm_IP],[comm_Agent] FROM [blog_Comment] WHERE [blog_Comment].[log_ID]=0 ORDER BY [comm_PostTime] DESC" objRS.Open() objRS.PageSize=ZC_MSG_COUNT If objRS.PageCount>0 Then objRS.AbsolutePage = intPage If (not objRS.bof) And (not objRS.eof) Then For i=1 To objRS.PageSize Set objComment=New TComment objComment.LoadInfoByArray(Array(objRS("comm_ID"),objRS("log_ID"),objRS("comm_AuthorID"),objRS("comm_Author"),objRS("comm_Content"),objRS("comm_Email"),objRS("comm_HomePage"),objRS("comm_PostTime"),"","")) Application.Lock strC=Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENT") Application.UnLock objComment.Count=strC_Count-i-(ZC_MSG_COUNT * (intPage-1))+1 strC=objComment.MakeTemplate(strC) If ZC_COMMENT_REVERSE_ORDER_EXPORT=True Then Template_Article_Comment=Template_Article_Comment & strC Else Template_Article_Comment=strC & Template_Article_Comment End If Set objComment=Nothing objRS.MoveNext If objRS.eof Then Exit For Next End If j=objRS.PageCount If j>0 Then Dim a,b,s,t,intNowPage,strPageBar s=ZC_BLOG_HOST & "guestbook.asp" t="" intNowPage=intPage Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG285) Template_PageBar=Template_PageBar & strPageBar If j>ZC_PAGEBAR_COUNT Then a=intNowPage b=intNowPage+ZC_PAGEBAR_COUNT If a>ZC_PAGEBAR_COUNT Then a=a-1:b=b-1 If b>j Then b=j:a=j-ZC_PAGEBAR_COUNT Else a=1:b=j End If For i=a to b s=ZC_BLOG_HOST & "guestbook.asp?"& t &"page="& i If i=1 Then s=ZC_BLOG_HOST & "guestbook.asp" End If Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock If i=intNowPage then Template_PageBar=Template_PageBar & "" & i & "" Else strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",i) Template_PageBar=Template_PageBar & strPageBar End If Next s=ZC_BLOG_HOST & "guestbook.asp?"& t &"page="& j If j=1 Then s=ZC_BLOG_HOST & "guestbook.asp" End If Application.Lock strPageBar=Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR") Application.UnLock strPageBar=Replace(strPageBar,"<#pagebar/page/url#>",s) strPageBar=Replace(strPageBar,"<#pagebar/page/number#>",ZC_MSG286) Template_PageBar=Template_PageBar & strPageBar End If objRS.Close Set objRS=Nothing Template_Article_Comment=Template_Article_Comment & "
" Template_Article_Commentpost=Replace(Template_Article_Commentpost,"<#template:article_commentpost-verify#>",Template_Article_Commentpost_Verify) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_trackback#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_comment#>",Template_Article_Comment) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_commentpost#>",Template_Article_Commentpost) Template_Article_Single=Replace(Template_Article_Single,"<#template:article_tag#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_l#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_navbar_r#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:article_mutuality#>","") Template_Article_Single=Replace(Template_Article_Single,"<#template:pagebar#>",Template_PageBar) Dim aryTemplateTagsName(47) Dim aryTemplateTagsValue(47) Dim PostTime PostTime=Now() aryTemplateTagsName(1)="<#article/id#>" aryTemplateTagsValue(1)=0 aryTemplateTagsName(2)="<#article/level#>" aryTemplateTagsValue(2)=4 aryTemplateTagsName(3)="<#article/title#>" aryTemplateTagsValue(3)=ZC_MSG275 aryTemplateTagsName(4)="<#article/intro#>" aryTemplateTagsValue(4)=ZC_GUESTBOOK_CONTENT aryTemplateTagsName(5)="<#article/content#>" aryTemplateTagsValue(5)=ZC_GUESTBOOK_CONTENT & "
" & "
" & ZC_MSG042 & ":" & Template_PageBar aryTemplateTagsName(6)="<#article/posttime#>" aryTemplateTagsValue(6)=PostTime aryTemplateTagsName(7)="<#article/commnums#>" aryTemplateTagsValue(7)=strC_Count aryTemplateTagsName(8)="<#article/viewnums#>" aryTemplateTagsValue(8)=0 aryTemplateTagsName(9)="<#article/trackbacknums#>" aryTemplateTagsValue(9)=0 aryTemplateTagsName(10)="<#article/trackback_url#>" aryTemplateTagsValue(10)="" aryTemplateTagsName(11)="<#article/url#>" aryTemplateTagsValue(11)=ZC_BLOG_HOST & "guestbook.asp" aryTemplateTagsName(12)="<#article/category/id#>" aryTemplateTagsValue(12)=0 aryTemplateTagsName(13)="<#article/category/name#>" aryTemplateTagsValue(13)=ZC_BLOG_NAME aryTemplateTagsName(15)="<#article/category/order#>" aryTemplateTagsValue(15)=0 aryTemplateTagsName(16)="<#article/category/count#>" aryTemplateTagsValue(16)=0 aryTemplateTagsName(17)="<#article/category/url#>" aryTemplateTagsValue(17)="" aryTemplateTagsName(18)="<#article/author/id#>" aryTemplateTagsValue(18)=0 aryTemplateTagsName(19)="<#article/author/name#>" aryTemplateTagsValue(19)=ZC_BLOG_MASTER aryTemplateTagsName(20)="<#article/author/level#>" aryTemplateTagsValue(20)=4 aryTemplateTagsName(21)="<#article/author/email#>" aryTemplateTagsValue(21)="" aryTemplateTagsName(22)="<#article/author/homepage#>" aryTemplateTagsValue(22)="" aryTemplateTagsName(23)="<#article/author/count#>" aryTemplateTagsValue(23)=0 aryTemplateTagsName(24)="<#article/author/url#>" aryTemplateTagsValue(24)="" aryTemplateTagsName(25)="<#article/posttime/longdate#>" aryTemplateTagsValue(25)=FormatDateTime(PostTime,vbLongDate) aryTemplateTagsName(26)="<#article/posttime/shortdate#>" aryTemplateTagsValue(26)=FormatDateTime(PostTime,vbShortDate) aryTemplateTagsName(27)="<#article/posttime/longtime#>" aryTemplateTagsValue(27)=FormatDateTime(PostTime,vbLongTime) aryTemplateTagsName(28)="<#article/posttime/shorttime#>" aryTemplateTagsValue(28)=FormatDateTime(PostTime,vbShortTime) aryTemplateTagsName(29)="<#article/posttime/year#>" aryTemplateTagsValue(29)=Year(PostTime) aryTemplateTagsName(30)="<#article/posttime/month#>" aryTemplateTagsValue(30)=Month(PostTime) aryTemplateTagsName(31)="<#article/posttime/monthname#>" aryTemplateTagsValue(31)=ZVA_Month_Abbr(Month(PostTime)) aryTemplateTagsName(32)="<#article/posttime/day#>" aryTemplateTagsValue(32)=Day(PostTime) aryTemplateTagsName(33)="<#article/posttime/weekday#>" aryTemplateTagsValue(33)=Weekday(PostTime) aryTemplateTagsName(34)="<#article/posttime/weekdayname#>" aryTemplateTagsValue(34)=ZVA_Week_Abbr(Weekday(PostTime)) aryTemplateTagsName(35)="<#article/posttime/hour#>" aryTemplateTagsValue(35)=Hour(PostTime) aryTemplateTagsName(36)="<#article/posttime/minute#>" aryTemplateTagsValue(36)=Minute(PostTime) aryTemplateTagsName(37)="<#article/posttime/second#>" aryTemplateTagsValue(37)=Second(PostTime) aryTemplateTagsName(38)="<#article/commentrss#>" aryTemplateTagsValue(38)="" aryTemplateTagsName(39)="<#article/commentposturl#>" aryTemplateTagsValue(39)=ZC_BLOG_HOST & "cmd.asp?act=cmt&key=" & Left(MD5(ZC_BLOG_HOST & ZC_BLOG_CLSID & CStr(0) & CStr(Day(Now))),8) aryTemplateTagsName(40)="<#article/pretrackback_url#>" aryTemplateTagsValue(40)="" aryTemplateTagsName(41)="<#article/trackbackkey#>" aryTemplateTagsValue(41)="00000" aryTemplateTagsName(42)="<#article/commentkey#>" aryTemplateTagsValue(42)="00000" aryTemplateTagsName(43)="<#article/staticname#>" aryTemplateTagsValue(43)="" aryTemplateTagsName(44)="<#article/category/staticname#>" aryTemplateTagsValue(44)="" aryTemplateTagsName(45)="<#article/author/staticname#>" aryTemplateTagsValue(45)="" aryTemplateTagsName(46)="<#article/tagtoname#>" aryTemplateTagsValue(46)="" aryTemplateTagsName(47)="<#article/firsttagintro#>" aryTemplateTagsValue(47)="" j=47 For i=1 to j Template_Article_Single=Replace(Template_Article_Single,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Ftemplate=Replace(Ftemplate,aryTemplateTagsName(i),aryTemplateTagsValue(i)) Next Dim aryTemplateTagsName2 Dim aryTemplateTagsValue2 html=Replace(template,"<#template:article-single#>",Template_Article_Single) html=Replace(html,"<#template:article-guestbook#>",Template_Article_Single) Application.Lock aryTemplateTagsName2=Application(ZC_BLOG_CLSID & "TemplateTagsName") aryTemplateTagsValue2=Application(ZC_BLOG_CLSID & "TemplateTagsValue") Application.UnLock aryTemplateTagsName2(0)="BlogTitle" aryTemplateTagsValue2(0)=ZC_MSG275 j=UBound(aryTemplateTagsName2) For i=0 to j html=Replace(html,"<#" & aryTemplateTagsName2(i) & "#>",aryTemplateTagsValue2(i)) Next Export=True End Function End Class '********************************************************* %> ?% '/////////////////////////////////////////////////////////////////////////////// '// Z-Blog '// ? ? 朱煊(zx.asd) '// 版权所? RainbowSoft Studio '// 技术支? rainbowsoft@163.com '// 程序名称: '// 程序版本: '// 单元名称: c_system_base.asp '// 开始时? 2005.02.11 '// 最后修? '// ? ? '/////////////////////////////////////////////////////////////////////////////// '定义全局变量 Dim objConn Dim BlogTitle Dim BlogUser Dim BlogPath BlogPath=Server.MapPath("c_system_base.asp") BlogPath=Left(BlogPath,Len(BlogPath)-Len("c_system_base.asp")) Dim StarTime Dim EndTime StarTime = Timer() Dim Categorys() Dim Users() Dim Tags() Dim KeyWords '********************************************************* ' 目的? System 初始? '********************************************************* Sub System_Initialize() On Error Resume Next If OpenConnect()=False Then If Err.Number<>0 Then Err.Clear Call ShowError(4) End If Set BlogUser =New TUser BlogUser.Verify() Call GetCategory() Call GetUser() Call GetTags() Call GetKeyWords() Call LoadGlobeCache If Err.Number<>0 Then Call ShowError(10) End Sub '********************************************************* '********************************************************* ' 目的? System 释放 '********************************************************* Sub System_Terminate() Call CloseConnect() End Sub '********************************************************* '********************************************************* ' 目的? 数据库连? '********************************************************* Function OpenConnect() GetReallyDirectory() '判定是否为子目录调用 Dim strDbPath strDbPath=BlogPath & ZC_DATABASE_PATH Set objConn = Server.CreateObject("ADODB.Connection") objConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strDbPath OpenConnect=True End Function '********************************************************* '********************************************************* ' 目的? DB Disable Connect '********************************************************* Function CloseConnect() objConn.Close Set objConn=Nothing CloseConnect=True End Function '********************************************************* '********************************************************* ' 目的? 时间计长 '********************************************************* Function RunTime() EndTime=Timer() RunTime = CLng(FormatNumber((EndTime-StarTime)*1000,3)) End Function '********************************************************* '********************************************************* ' 目的? 分类读取 '********************************************************* Function GetCategory() Dim i,j,k,l Dim aryAllData Dim arySingleData() Erase Categorys Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [cate_ID] FROM [blog_Category] ORDER BY [cate_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then i=objRS("cate_ID") ReDim Categorys(i) End If objRS.Close Set objRS=Nothing Set objRS=objConn.Execute("SELECT [cate_ID],[cate_Name],[cate_Intro],[cate_Order],[cate_Count] FROM [blog_Category] ORDER BY [cate_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then aryAllData=objRS.GetRows(objRS.RecordCount) objRS.Close Set objRS=Nothing k=UBound(aryAllData,1) l=UBound(aryAllData,2) For i=0 To l Set Categorys(aryAllData(0,i))=New TCategory Categorys(aryAllData(0,i)).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i))) Next End If GetCategory=True End Function '********************************************************* '********************************************************* ' 目的? 用户读取 '********************************************************* Function GetUser() Dim i,j,k,l Dim aryAllData Dim arySingleData() Erase Users Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [mem_ID] FROM [blog_Member] ORDER BY [mem_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then i=objRS("mem_ID") ReDim Users(i) End If objRS.Close Set objRS=Nothing Set objRS=objConn.Execute("SELECT [mem_ID],[mem_Name],[mem_Level],[mem_Password],[mem_Email],[mem_HomePage],[mem_PostLogs],[mem_Intro] FROM [blog_Member] ORDER BY [mem_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then aryAllData=objRS.GetRows(objRS.RecordCount) objRS.Close Set objRS=Nothing k=UBound(aryAllData,1) l=UBound(aryAllData,2) For i=0 To l Set Users(aryAllData(0,i))=New TUser Users(aryAllData(0,i)).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i),aryAllData(5,i),aryAllData(6,i),aryAllData(7,i))) Next End If Getuser=True End Function '********************************************************* '********************************************************* ' 目的? Tags读取 '********************************************************* Function GetTags() Dim i,j,k,l Dim aryAllData Dim arySingleData() Erase Tags Dim objRS Set objRS=objConn.Execute("SELECT TOP 1 [tag_ID] FROM [blog_Tag] ORDER BY [tag_ID] DESC") If (Not objRS.bof) And (Not objRS.eof) Then i=objRS("tag_ID") ReDim Tags(i) End If Set objRS=objConn.Execute("SELECT [tag_ID],[tag_Name],[tag_Intro],[tag_Order],[tag_Count] FROM [blog_Tag] ORDER BY [tag_ID] ASC") If (Not objRS.bof) And (Not objRS.eof) Then aryAllData=objRS.GetRows(objRS.RecordCount) objRS.Close Set objRS=Nothing k=UBound(aryAllData,1) l=UBound(aryAllData,2) For i=0 To l Set Tags(aryAllData(0,i))=New TTag Tags(aryAllData(0,i)).LoadInfoByArray(Array(aryAllData(0,i),aryAllData(1,i),aryAllData(2,i),aryAllData(3,i),aryAllData(4,i))) Next End If GetTags=True End Function '********************************************************* '********************************************************* ' 目的? KeyWords读取 '********************************************************* Function GetKeyWords() 'Dim objRS 'Set objRS=objConn.Execute("SELECT [key_ID],[key_Name],[key_URL] FROM [blog_Keyword] ORDER BY [key_ID] ASC") 'If (Not objRS.bof) And (Not objRS.eof) Then ' KeyWords=objRS.GetRows 'End If 'objRS.Close 'Set objRS=Nothing GetKeyWords=True End Function '********************************************************* '********************************************************* ' 目的? 读取权限 ' 备注: 权限最高为1 最低为5 不是则非? ' "Root"一定只能为1 ' 权限配置方式可以变? '********************************************************* Function GetRights(strAction) Select Case strAction Case "Root" GetRights=1 Case "login" GetRights=5 Case "verify" GetRights=5 Case "logout" GetRights=5 Case "admin" GetRights=4 Case "cmt","CommentRev" GetRights=5 Case "tb" GetRights=5 Case "vrs" GetRights=5 Case "rss" GetRights=5 Case "gettburl" GetRights=5 Case "ArticleMng" GetRights=3 Case "ArticleEdt" GetRights=3 Case "ArticlePst" GetRights=3 Case "ArticleDel" GetRights=3 Case "ArticleBud" GetRights=3 Case "CategoryMng" GetRights=2 Case "CategoryEdt" GetRights=2 Case "CategoryPst" GetRights=2 Case "CategoryDel" GetRights=2 Case "TagMng" GetRights=1 Case "TagEdt" GetRights=1 Case "TagPst" GetRights=1 Case "TagDel" GetRights=1 'Case "KeyWordMng" ' GetRights=1 'Case "KeyWordEdt" ' GetRights=1 'Case "KeyWordPst" ' GetRights=1 'Case "KeyWordDel" ' GetRights=1 Case "GuestBookMng" GetRights=2 Case "CommentMng" GetRights=4 Case "CommentDel" GetRights=4 Case "CommentEdt" GetRights=4 Case "CommentSav" GetRights=4 Case "CommentDelBatch" GetRights=4 Case "TrackBackMng" GetRights=3 Case "TrackBackDel" GetRights=3 Case "TrackBackDelBatch" GetRights=3 Case "TrackBackSnd" GetRights=3 Case "UserMng" GetRights=4 Case "UserEdt" GetRights=4 Case "UserDel" GetRights=1 Case "UserCrt" GetRights=1 Case "BlogReBuild" GetRights=3 Case "FileReBuild" GetRights=1 Case "AskFileReBuild" GetRights=1 Case "FileMng" GetRights=2 Case "FileSnd" GetRights=2 Case "FileUpload" GetRights=2 Case "FileDel" GetRights=2 Case "FileDelBatch" GetRights=2 Case "Search" GetRights=5 'Case "BlogMng" ' GetRights=4 Case "SettingMng" GetRights=1 Case "SettingSav" GetRights=1 Case "PlugInMng" GetRights=4 Case "SiteInfo" GetRights=4 Case "SiteFileMng" GetRights=1 Case "SiteFileEdt" GetRights=1 'Case "SiteFileFnd" ' GetRights=1 Case "SiteFilePst" GetRights=1 Case "SiteFileDel" GetRights=1 Case "Update" GetRights=1 Case Else Call ShowError(1) End Select End Function '********************************************************* '********************************************************* ' 目的? 检查权? '********************************************************* Function CheckRights(strAction) If BlogUser.Level>GetRights(strAction) Then CheckRights=False Else CheckRights=True End If End Function '********************************************************* '********************************************************* ' 目的? Make Calendar '********************************************************* Function MakeCalendar(dtmYearMonth) Dim strCalendar Dim y Dim m Dim d Dim firw Dim lasw Dim ny Dim nm Dim i Dim j Dim k Dim b Dim s Dim t Call CheckParameter(dtmYearMonth,"dtm",Date()) y=year(dtmYearMonth) m=month(dtmYearMonth) ny=y nm=m+1 If m=12 Then ny=ny+1:nm=1 firw=Weekday(Cdate(y&"-"&m&"-1")) For i=28 to 32 If IsDate(y&"-"&m&"-"&i) Then lasw=Weekday(Cdate(y&"-"&m&"-"&i)) Else Exit For End If Next d=i-1 k=1 If firw>5 Then b=42 Else b=35 If (d=28) And (firw=1) Then b=28 If (firw>5) And (d<31) Then b=35 '////////////////////////////////////////////////////////// ' 逻辑处理 Dim aryDateLink(32) Dim aryDateID(32) Dim aryDateArticle(32) Dim objRS Set objRS=Server.CreateObject("ADODB.Recordset") objRS.CursorType = adOpenKeyset objRS.LockType = adLockReadOnly objRS.ActiveConnection=objConn objRS.Source="" objRS.Open("select [log_ID],[log_CateID],[log_AuthorID],[log_Level],[log_PostTime],[log_Url],[log_Istop] from [blog_Article] where ([log_Level]>2) And ([log_PostTime] BETWEEN #"&y&"-"&m&"-1# AND #"&ny&"-"&nm&"-1#)") If (Not objRS.bof) And (Not objRS.eof) Then For i=1 To objRS.RecordCount j=CInt(Day(CDate(objRS("log_PostTime")))) aryDateLink(j)=True aryDateID(j)=objRS("log_ID") Set aryDateArticle(j)=New TArticle aryDateArticle(j).LoadInfobyArray Array(objRS("log_ID"),"",objRS("log_CateID"),"","","",objRS("log_Level"),objRS("log_AuthorID"),objRS("log_PostTime"),"","","",objRS("log_Url"),"") objRS.MoveNext If objRS.eof Then Exit For Next End If objRS.Close Set objRS=Nothing '////////////////////////////////////////////////////////// s="catalog.asp?date="&y&"-"&(m-1) t="catalog.asp?date="&y&"-"&(m+1) If m=1 Then s="catalog.asp?date="&(y-1)&"-12" If m=12 Then t="catalog.asp?date="&(y+1)&"-1" strCalendar=strCalendar & "
" strCalendar=strCalendar & "

<< "&y&"-"&m&" >>

" strCalendar=strCalendar & "

"&ZVA_Week_Abbr(1)&"

"&ZVA_Week_Abbr(2)&"

"&ZVA_Week_Abbr(3)&"

"&ZVA_Week_Abbr(4)&"

"&ZVA_Week_Abbr(5)&"

"&ZVA_Week_Abbr(6)&"

"&ZVA_Week_Abbr(7)&"

" j=0 For i=1 to b If (j=>firw-1) and (k="&(k)&"

" Else strCalendar=strCalendar & "

"&(k)&"

" End If k=k+1 Else strCalendar=strCalendar & "

" End If j=j+1 Next strCalendar=strCalendar & "
" MakeCalendar=strCalendar End Function '********************************************************* '********************************************************* ' 目的? 加载指定目录的文件列? '********************************************************* Function LoadIncludeFiles(strDir) On Error Resume Next Dim aryFileList() ReDim aryFileList(0) Dim fso, f, f1, fc, s, i Set fso = CreateObject("Scripting.FileSystemObject") Set f = fso.GetFolder(BlogPath & strDir) Set fc = f.Files i=0 For Each f1 in fc i=i+1 ReDim Preserve aryFileList(i) aryFileList(i)=f1.name Next LoadIncludeFiles=aryFileList Err.Clear End Function '********************************************************* '********************************************************* ' 目的? Load 全局 Cache '********************************************************* Function LoadGlobeCache() On Error Resume Next Dim bolReLoadCache Application.Lock bolReLoadCache=Application(ZC_BLOG_CLSID & "SIGNAL_RELOADCACHE") Application.UnLock If IsEmpty(bolReLoadCache)=True Then bolReLoadCache=False Else If bolReLoadCache=False Then Exit Function End If If bolReLoadCache=True Then bolReLoadCache=False End If End If Call GetReallyDirectory Application.Lock Application(ZC_BLOG_CLSID & "SIGNAL_RELOADCACHE")=bolReLoadCache Application.UnLock Dim i,j '加载模板 Dim objStream Dim strContent '加载WAP Application.Lock Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE_COMMENT")=LoadFromFile(BlogPath & "WAP/wap_article_comment.html","utf-8") Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE-MULTI")=LoadFromFile(BlogPath & "WAP/wap_article-multi.html","utf-8") Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_SINGLE")=LoadFromFile(BlogPath & "WAP/wap_single.html","utf-8") Application.UnLock '读取Template目录下的所有文件并写入Cache Dim aryFileList Dim aryFileNameTemplate() Dim aryFileNameTemplate_Variable() aryFileList=LoadIncludeFiles(ZC_TEMPLATE_DIRECTORY) If IsArray(aryFileList) Then j=UBound(aryFileList) ReDim aryFileNameTemplate(j) ReDim aryFileNameTemplate_Variable(j) For i=1 to j aryFileNameTemplate(i)=ZC_TEMPLATE_DIRECTORY & "/" & aryFileList(i) aryFileNameTemplate_Variable(i)="TEMPLATE_" & UCase(Left(aryFileList(i),InStr(aryFileList(i),".")-1)) If InStr(aryFileList(i),".")=0 Then aryFileNameTemplate_Variable(i)="TEMPLATE_" & UCase(aryFileList(i)) End If strContent="" strContent=LoadFromFile(BlogPath & "" & aryFileNameTemplate(i),"utf-8") Application.Lock Application(ZC_BLOG_CLSID & aryFileNameTemplate_Variable(i))=strContent Application.UnLock Next End If '加载标签 Dim a,b,c,d Dim t() Dim s() a=0 b=17 c=1 d=300 '读取Include目录下的所有文件并写入Cache 'Dim aryFileList Dim aryFileNameInclude() Dim aryFileNameInclude_Variable() aryFileList=LoadIncludeFiles("INCLUDE") If IsArray(aryFileList) Then a=UBound(aryFileList) ReDim aryFileNameInclude(a) ReDim aryFileNameInclude_Variable(a) ReDim s(a) ReDim Preserve aryTemplateTagsName(a) ReDim Preserve aryTemplateTagsValue(a) For i=1 to a aryFileNameInclude(i)="/INCLUDE/" & aryFileList(i) aryFileNameInclude_Variable(i)="CACHE_INCLUDE_" & UCase(Left(aryFileList(i),InStr(aryFileList(i),".")-1)) If InStr(aryFileList(i),".")=0 Then aryFileNameInclude_Variable(i)="CACHE_INCLUDE_" & UCase(aryFileList(i)) End If s(i)=aryFileNameInclude_Variable(i) strContent="" strContent=LoadFromFile(BlogPath & "" & aryFileNameInclude(i),"utf-8") strContent=Replace(strContent,"<"&"%=ZC_BLOG_HOST%"&">",ZC_BLOG_HOST) aryTemplateTagsName(i)=s(i) aryTemplateTagsValue(i)=strContent Next End If ReDim Preserve aryTemplateTagsName(a+d) ReDim Preserve aryTemplateTagsValue(a+d) For j=1 to d i=Right("000" & CStr(j),3) aryTemplateTagsName(a+j)="ZC_MSG" & i Call Execute("aryTemplateTagsValue(a+j)=ZC_MSG" & i) Next ReDim t(b) t(1)="ZC_BLOG_VERSION" t(2)="ZC_BLOG_LANGUAGE" t(3)="ZC_BLOG_HOST" t(4)="ZC_BLOG_TITLE" t(5)="ZC_BLOG_SUBTITLE" t(6)="ZC_BLOG_NAME" t(7)="ZC_BLOG_SUB_NAME" t(8)="ZC_BLOG_CSS" t(9)="ZC_BLOG_COPYRIGHT" t(10)="ZC_BLOG_MASTER" t(11)="ZC_CONTENT_MAX" t(12)="ZC_EMOTICONS_FILENAME" t(13)="ZC_EMOTICONS_FILESIZE" t(14)="ZC_GUESTBOOK_CONTENT" t(15)="ZC_BLOG_CLSID" t(16)="ZC_TIME_ZONE" t(17)="ZC_IMAGE_WIDTH" ReDim Preserve aryTemplateTagsName(a+d+b) ReDim Preserve aryTemplateTagsValue(a+d+b) For j=1 to b aryTemplateTagsName(a+d+j)=t(j) Call Execute("aryTemplateTagsValue(a+d+j)="& t(j)) Next ReDim Preserve aryTemplateTagsName(a+d+b+c) ReDim Preserve aryTemplateTagsValue(a+d+b+c) aryTemplateTagsName(a+d+b+c)="BLOG_CREATE_TIME" aryTemplateTagsValue(a+d+b+c)=Now Application.Lock Application(ZC_BLOG_CLSID & "TemplateTagsName")=aryTemplateTagsName Application(ZC_BLOG_CLSID & "TemplateTagsValue")=aryTemplateTagsValue Application.UnLock Err.Clear LoadGlobeCache=True End Function '********************************************************* '********************************************************* ' 目的? Clear Cache '********************************************************* Function ClearGlobeCache() Application.Lock Application(ZC_BLOG_CLSID & "SIGNAL_RELOADCACHE")=True Application(ZC_BLOG_CLSID & "CACHE_ARTICLE_VIEWCOUNT")=Empty Application(ZC_BLOG_CLSID & "TemplateTagsName")=Empty Application(ZC_BLOG_CLSID & "TemplateTagsValue")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENT")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_COMMENTPOST-VERIFY")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TAG")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_TRACKBACK")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-MULTI")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-SINGLE")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-GUESTBOOK")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_PAGEBAR")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_L")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_NVABAR_R")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE_MUTUALITY")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_B_ARTICLE-ISTOP")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_CATALOG")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_DEFAULT")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_SEARCH")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_SINGLE")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_TAGS")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE_COMMENT")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_ARTICLE-MULTI")=Empty Application(ZC_BLOG_CLSID & "TEMPLATE_WAP_SINGLE")=Empty Application.UnLock ClearGlobeCache=True End Function '********************************************************* '********************************************************* ' 目的? Parse Tag 并格式化 '********************************************************* Function ParseTag(strTag) Dim s Dim t Dim i Dim Tag Dim b Dim objTag strTag=Trim(strTag) strTag=TransferHTML(strTag,"[normalname]") t=Split(strTag," ") GetTags() For i=LBound(t) To UBound(t) b=False For Each Tag in Tags If IsObject(Tag) Then If UCase(Tag.Name)=UCase(t(i)) Then b=True End If End If Next If b=False Then Set objTag=New TTag objTag.ID=0 objTag.Name=t(i) objTag.Order=0 objTag.Intro="" objTag.Post Set objTag=Nothing End If Next GetTags() For i=LBound(t) To UBound(t) For Each Tag in Tags If IsObject(Tag) Then If UCase(Tag.Name)=UCase(t(i)) Then t(i)="{"&Tag.ID&"}" End If End If Next Next s=Join(t) s=Replace(s," ","") ParseTag=s End Function '********************************************************* '********************************************************* ' 目的? 得到实际上的真实目录 '********************************************************* Function GetReallyDirectory() On Error Resume Next Dim fso Set fso = CreateObject("Scripting.FileSystemObject") If fso.FileExists(BlogPath & "\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath ElseIf fso.FileExists(BlogPath & "\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\" ElseIf fso.FileExists(BlogPath & "\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\" ElseIf fso.FileExists(BlogPath & "\..\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\..\" ElseIf fso.FileExists(BlogPath & "\..\..\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\..\..\" ElseIf fso.FileExists(BlogPath & "\..\..\..\..\..\" & ZC_DATABASE_PATH) Then BlogPath=BlogPath & "..\..\..\..\..\" End If Set fso=Nothing GetReallyDirectory=True Err.Clear End Function '********************************************************* '********************************************************* ' 目的? 设置提示标志 '********************************************************* Function SetBlogHint(bolOperateSuccess,bolRebuildIndex,bolRebuildFiles) Call SetBlogHintWithCLSID(bolOperateSuccess,bolRebuildIndex,bolRebuildFiles,ZC_BLOG_CLSID) End Function '********************************************************* '********************************************************* ' 目的? 设置提示标志withCLSID '********************************************************* Function SetBlogHintWithCLSID(bolOperateSuccess,bolRebuildIndex,bolRebuildFiles,newCLSID) Application.Lock Application(newCLSID & "SIGNAL_OPERATESUCCESS")=bolOperateSuccess If IsEmpty(bolRebuildIndex)=False Then Application(newCLSID & "SIGNAL_REBUILDINDEX")=bolRebuildIndex End If If IsEmpty(bolRebuildFiles)=False Then Application(newCLSID & "SIGNAL_REBUILDFILES")=bolRebuildFiles End If Application.UnLock End Function '********************************************************* '********************************************************* ' 目的? 输出提示 '********************************************************* Function GetBlogHint() Dim bolOperateSuccess,bolRebuildIndex,bolRebuildFiles Application.Lock bolOperateSuccess=Application(ZC_BLOG_CLSID & "SIGNAL_OPERATESUCCESS") bolRebuildIndex=Application(ZC_BLOG_CLSID & "SIGNAL_REBUILDINDEX") bolRebuildFiles=Application(ZC_BLOG_CLSID & "SIGNAL_REBUILDFILES") Application.UnLock If IsEmpty(bolOperateSuccess)=False Then If bolOperateSuccess=True Then Response.Write "

" & ZC_MSG266 & "

" End If If bolOperateSuccess=False Then Response.Write "

" & ZC_MSG267 & "

" End If Application.Lock Application(ZC_BLOG_CLSID & "SIGNAL_OPERATESUCCESS")=Empty Application.UnLock End If If IsEmpty(bolRebuildIndex)=False Then If bolRebuildIndex=True Then Response.Write "

" & ZC_MSG268 & "

" End If End If If IsEmpty(bolRebuildFiles)=False Then If bolRebuildFiles=True Then Response.Write "

" & ZC_MSG269 & "

" End If End If End Function '********************************************************* '********************************************************* ' 目的? 解析ZC_CUSTOM_DIRECTORY_REGEX '********************************************************* Function ParseCustomDirectory(strRegex,strPost,strCategory,strUser,strYear,strMonth,strDay,strID,strAlias) On Error Resume Next Dim s s=strRegex s=Replace(s,"{%post%}",strPost) s=Replace(s,"{%category%}",strCategory) s=Replace(s,"{%user%}",strUser) s=Replace(s,"{%year%}",strYear) s=Replace(s,"{%month%}",Right("0" & strMonth,2)) s=Replace(s,"{%day%}",Right("0" & strDay,2)) s=Replace(s,"{%id%}",strID) s=Replace(s,"{%alias%}",strAlias) ParseCustomDirectory=s Err.Clear End Function '********************************************************* '********************************************************* ' 目的? 按照CustomDirectory指示创建相应的目? '********************************************************* Sub CreatDirectoryByCustomDirectory(strCustomDirectory) On Error Resume Next Dim s Dim t Dim i Dim fso Set fso = CreateObject("Scripting.FileSystemObject") s=BlogPath t=Split(strCustomDirectory,"/") For i=LBound(t) To UBound(t) If (IsEmpty(t(i))=False) And (t(i)<>"") Then s=s & t(i) & "\" If (fso.FolderExists(fldr)=False) Then Call fso.CreateFolder(s) End If End If Next Set fso = Nothing Err.Clear End Sub '********************************************************* %>