不碰asp好久了。就像好久不碰篮球一样，甚至于有了一些怀念的情绪。php实现伪静态可以用.htaccess来实现，也可以用php脚本实现。方便而且强大。今天我们看asp伪静态的脚本实现方法。其实ISAPI_Rewrite效果更好，只是普及不过。
» 阅读全文
浏览模式: 标准 | 列表分类:网站|ASP备忘
asp的伪静态实现
Submitted by 淡水河边 on 2007, October 28, 4:22 PM
ASP随机调用ACCESS记录
Submitted by on 2007, July 19, 6:30 PM
打开ACCESS，用“Select * From [table] order By Rnd(ID)"可以实现对记录集的随机排序（其中ID是[table]这个表的主键，不必非是主键，只要是数字类型的字段就可以了）。但奇怪的是在ACCESS中明明可以随机排序的，在ASP中用同样的语句进行查询却还是每次查询出的记录集顺序相同。
再试……
最后终于发现用“Select * FROM [table] orDER BY Rnd(ID-timer())”在ASP跟ACCESS中查询得到的记录集是随机排序的了。但用Rnd(ID+timer())或Rnd(timer()-ID)做条件都不行,原因未知。
结论：
在ASP中可以用“Select TOP N * FROM [table] orDER BY Rnd(ID-timer())”的SQL语句随机取出N条记录。
再试……
最后终于发现用“Select * FROM [table] orDER BY Rnd(ID-timer())”在ASP跟ACCESS中查询得到的记录集是随机排序的了。但用Rnd(ID+timer())或Rnd(timer()-ID)做条件都不行,原因未知。
结论：
在ASP中可以用“Select TOP N * FROM [table] orDER BY Rnd(ID-timer())”的SQL语句随机取出N条记录。
asp随机调用access数据库n条数据
Submitted by on 2007, July 13, 4:57 PM
N久没有用到asp了。估计手生了不少。刚在落伍看到asp随机调用acc的方法。不错记下。
step 一: sql="select id from table" 结果用存在 rs=conn.execute(sql)
step 二: 生成一个 step1的最大值(rs.recordcount)内的随机数字. N个
step 三: 将数组联合 join成一个","分割的
整个代码：
step 一: sql="select id from table" 结果用存在 rs=conn.execute(sql)
step 二: 生成一个 step1的最大值(rs.recordcount)内的随机数字. N个
| 代码: |
|
<%Randomize %> <% dim r(10) for i=0 to UBound(r) r(i)=int(Rnd()*100) int(Rnd()*100) .... %> |
step 三: 将数组联合 join成一个","分割的
整个代码：
| 代码: |
| <%Randomize %>
<% sql="select id from table" rs=conn.execute(sql) maxrecord=rs.recordcount dim r(10) for i=0 to ubound(r) r(i)=rs(int(rnd()*maxrecord)) next s=join(r,",") sql="select * from table where id in("&s&")" newrs=conn.execute(sql) %> |
asp直接将繁体中文转为简体中文
Submitted by on 2007, March 10, 4:04 AM
怎么用asp直接将繁体中文转为简体中文？
代码如下：
调用代码：
response.write surnfujtof("我",1)
注释：1简到繁 2繁到简；其中“我”为需要转换的字符，希望对大家有用。
代码如下：
| 代码: |
| <%
function surnfujtof(str,types) dim surnfujian,surnfufan,surnfujtofstr surnfujtofstr="" surnfujian="皑蔼碍爱翱袄奥澳靶耙坝罢摆败扳颁办绊帮绑镑谤剥雹饱宝报鲍辈贝钡狈备惫绷笔蓖毕毙闭弊臂陛边编贬变辩辫鳖别瘪濒滨宾摈饼拨钵铂驳卜补簿怖参蚕残惭惨灿苍舱仓沧厕侧册测层诧搀掺蝉馋谗缠铲产阐颤猖场尝长偿肠厂畅钞车掣彻郴尘陈衬撑称惩诚骋痴迟驰耻齿炽冲虫宠酬畴踌筹绸丑橱厨锄雏础储搐触处传疮闯创锤纯戳绰茨雌辞瓷词赐聪葱囱从丛凑醋促蹿窜瘁淬撮措错达戴带贷担单郸掸胆但惮诞弹当挡党荡档捣岛祷导盗灯邓迪敌涤递缔颠滇点垫电奠淀钓调爹蝶迭谍叠钉顶锭订东懂动栋冻斗犊独读睹赌镀锻断缎兑队对吨敦顿钝遁哆夺鹅额讹恶遏饿儿尔饵贰发罚阀珐矾钒烦范贩饭访纺飞废费纷坟奋愤粪丰枫峰锋风疯逢冯缝讽凤肤辐抚辅赋复腹负讣妇缚噶该概钙盖干赶秆赣冈刚钢纲岗皋搞镐搁鸽疙阁铬个给羹耿龚宫巩贡钩沟构购够蛊顾剐关观馆惯贯广规硅归龟闺轨诡柜贵刽辊滚锅国过骸骇韩汉阂赫鹤贺横轰鸿红后壶护沪户哗华画划话徊怀坏欢环还缓换唤痪焕涣黄蝗谎挥辉恢毁慧晦贿秽会烩汇讳诲绘荤浑伙获货祸击机稽积饥讥鸡绩缉极辑级挤几蓟剂济计记际继纪夹荚颊贾钾稼价驾歼监坚笺间艰缄茧检碱硷拣捡简俭减荐槛鉴践贱见键舰剑饯渐溅涧浆蒋桨奖讲酱椒焦胶浇骄娇搅铰矫侥脚饺缴绞教轿较揭秸阶节茎惊经景颈静敬镜径痉竟竞净纠厩旧驹举据锯惧剧鹃绢攫杰睫洁结藉诫届紧锦仅谨进晋烬尽劲荆觉决诀绝钧军俊浚骏开凯堪坎康糠颗壳课垦恳抠库裤夸块侩宽矿旷况亏岿窥奎傀馈溃扩阔蜡腊莱来赖蓝栏拦篮阑兰澜谰揽览懒缆烂滥捞劳涝乐镭垒肋类泪冷梨黎篱离理里鲤礼荔丽厉励砾历痢沥隶哩俩联莲连镰怜涟帘敛脸链恋炼练粮凉两辆谅聊疗寥辽撂镣猎临邻鳞凛赁菱龄铃凌灵岭领馏刘龙聋咙笼隆垄拢陇楼娄搂篓陋芦卢颅庐炉掳卤虏鲁赂禄录陆驴吕铝侣履屡缕虑滤绿峦挛孪滦乱抡轮伦仑沦纶论萝罗逻锣箩骡落骆络妈玛码蚂马骂吗买麦卖迈脉瞒馒蛮满谩猫锚铆贸么霉没镁门闷们蒙盟锰梦谜弥觅绵勉缅藐庙灭悯闽鸣铭谬摹谋亩钠纳难挠脑恼闹呢馁腻蔫撵捻酿鸟聂啮镊镍柠狞宁拧泞钮纽脓浓农疟懦诺欧鸥殴呕沤潘盘盼庞国山爱下赔喷鹏骗飘频贫苹凭评坡泼颇扑铺朴谱脐齐骑岂启砌气弃讫牵扦钎铅迁签谦黔钱钳潜浅谴堑歉枪呛羌墙蔷强抢锹桥乔侨撬翘窍窃钦亲轻氢倾顷请庆琼穷趋区躯驱取龋颧权痊劝炔却鹊让饶扰绕热韧认纫荣绒褥软锐闰润撒洒萨鳃赛伞嗓丧骚扫涩杀纱啥筛晒闪陕赡缮伤赏捎烧绍赊赦摄慑设绅审婶肾渗声绳胜圣师狮湿诗尸时蚀实识驶势释饰视试寿兽枢输书赎熟暑署黍属术树竖数帅双谁税瞬顺说硕烁丝饲耸怂颂讼诵艘擞苏诉肃蒜虽绥碎岁孙损笋梭缩琐锁獭挞抬酞摊贪瘫滩坛痰谭谈袒探叹汤烫涛绦腾誊锑题啼体嚏涕屉条贴铁厅听烃铜统头图涂团颓蜕退拖脱鸵驮驼椭洼袜弯湾顽万网韦违围惟为潍维苇伟伪纬谓卫温闻纹稳问翁瓮挝蜗涡窝握呜钨乌诬无芜吴坞雾务误锡牺膝檄袭习铣戏细虾辖峡侠狭厦锨鲜纤咸贤衔闲显险现献县馅羡宪限线厢镶乡详响项萧销晓啸些蝎协挟携胁谐写卸懈泻谢锌衅兴汹锈绣戌虚嘘须许绪续轩悬选癣绚薛学勋询寻驯训讯逊压鸦鸭哑亚讶咽阉烟盐严颜阎艳厌砚唁彦谚验鸯杨扬疡阳痒养样邀瑶摇尧遥窑谣药噎爷页业叶夜壹医铱颐遗仪彝蚁艺亿逸疫毅忆义诣议谊译异翌绎荫阴银饮樱婴鹰应缨莹萤营荧蝇颖哟拥佣痈雍踊咏涌优忧邮铀犹游诱盂愚舆鱼渝渔娱与屿语吁御狱誉预驭鸳渊辕园员圆源缘远愿院约跃钥岳粤悦阅云郧匀陨运蕴酝晕韵杂灾载攒暂赞赃脏遭凿枣灶责择则泽贼赠扎札轧铡闸诈斋债瞻毡盏斩辗崭蘸栈战湛绽张涨帐账胀赵蛰辙锗这甄臻贞针侦诊振镇阵挣睁狰帧郑证织职殖执纸挚掷帜质钟终种肿众诌轴皱昼骤猪诸诛烛瞩嘱贮铸筑驻专砖转赚桩庄装妆壮状锥赘坠缀谆浊兹资渍棕踪综总纵邹诅组钻致钟么为只凶准启板里雳余链泄" surnfufan="皚藹礙愛翺襖奧澳靶耙壩罷擺敗扳頒辦絆幫綁鎊謗剝雹飽寶報鮑輩貝鋇狽備憊繃筆蓖畢斃閉弊臂陛邊編貶變辯辮鼈別癟瀕濱賓擯餅撥缽鉑駁蔔補簿怖參蠶殘慚慘燦蒼艙倉滄廁側冊測層詫攙摻蟬饞讒纏鏟産闡顫猖場嘗長償腸廠暢鈔車掣徹郴塵陳襯撐稱懲誠騁癡遲馳恥齒熾沖蟲寵酬疇躊籌綢醜櫥廚鋤雛礎儲搐觸處傳瘡闖創錘純戳綽茨雌辭瓷詞賜聰蔥囪從叢湊醋促躥竄瘁淬撮措錯達戴帶貸擔單鄲撣膽但憚誕彈當擋黨蕩檔搗島禱導盜燈鄧迪敵滌遞締顛滇點墊電奠澱釣調爹蝶叠諜疊釘頂錠訂東懂動棟凍鬥犢獨讀睹賭鍍鍛斷緞兌隊對噸敦頓鈍遁哆奪鵝額訛惡遏餓兒爾餌貳發罰閥琺礬釩煩範販飯訪紡飛廢費紛墳奮憤糞豐楓峰鋒風瘋逢馮縫諷鳳膚輻撫輔賦複腹負訃婦縛噶該概鈣蓋幹趕稈贛岡剛鋼綱崗臯搞鎬擱鴿疙閣鉻個給羹耿龔宮鞏貢鈎溝構購夠蠱顧剮關觀館慣貫廣規矽歸龜閨軌詭櫃貴劊輥滾鍋國過骸駭韓漢閡赫鶴賀橫轟鴻紅後壺護滬戶嘩華畫劃話徊懷壞歡環還緩換喚瘓煥渙黃蝗謊揮輝恢毀慧晦賄穢會燴彙諱誨繪葷渾夥獲貨禍擊機稽積饑譏雞績緝極輯級擠幾薊劑濟計記際繼紀夾莢頰賈鉀稼價駕殲監堅箋間艱緘繭檢堿鹼揀撿簡儉減薦檻鑒踐賤見鍵艦劍餞漸濺澗漿蔣槳獎講醬椒焦膠澆驕嬌攪鉸矯僥腳餃繳絞教轎較揭稭階節莖驚經景頸靜敬鏡徑痙竟競淨糾廄舊駒舉據鋸懼劇鵑絹攫傑睫潔結藉誡屆緊錦僅謹進晉燼盡勁荊覺決訣絕鈞軍俊浚駿開凱堪坎康糠顆殼課墾懇摳庫褲誇塊儈寬礦曠況虧巋窺奎傀饋潰擴闊蠟臘萊來賴藍欄攔籃闌蘭瀾讕攬覽懶纜爛濫撈勞澇樂鐳壘肋類淚冷梨黎籬離理裏鯉禮荔麗厲勵礫曆痢瀝隸哩倆聯蓮連鐮憐漣簾斂臉鏈戀煉練糧涼兩輛諒聊療寥遼撂鐐獵臨鄰鱗凜賃菱齡鈴淩靈嶺領餾劉龍聾嚨籠隆壟攏隴樓婁摟簍陋蘆盧顱廬爐擄鹵虜魯賂祿錄陸驢呂鋁侶履屢縷慮濾綠巒攣孿灤亂掄輪倫侖淪綸論蘿羅邏鑼籮騾落駱絡媽瑪碼螞馬罵嗎買麥賣邁脈瞞饅蠻滿謾貓錨鉚貿麽黴沒鎂門悶們蒙盟錳夢謎彌覓綿勉緬藐廟滅憫閩鳴銘謬摹謀畝鈉納難撓腦惱鬧呢餒膩蔫攆撚釀鳥聶齧鑷鎳檸獰甯擰濘鈕紐膿濃農瘧懦諾歐鷗毆嘔漚潘盤盼龐國山愛下賠噴鵬騙飄頻貧蘋憑評坡潑頗撲鋪樸譜臍齊騎豈啓砌氣棄訖牽扡釺鉛遷簽謙黔錢鉗潛淺譴塹歉槍嗆羌牆薔強搶鍬橋喬僑撬翹竅竊欽親輕氫傾頃請慶瓊窮趨區軀驅取齲顴權痊勸炔卻鵲讓饒擾繞熱韌認紉榮絨褥軟銳閏潤撒灑薩鰓賽傘嗓喪騷掃澀殺紗啥篩曬閃陝贍繕傷賞捎燒紹賒赦攝懾設紳審嬸腎滲聲繩勝聖師獅濕詩屍時蝕實識駛勢釋飾視試壽獸樞輸書贖熟暑署黍屬術樹豎數帥雙誰稅瞬順說碩爍絲飼聳慫頌訟誦艘擻蘇訴肅蒜雖綏碎歲孫損筍梭縮瑣鎖獺撻擡酞攤貪癱灘壇痰譚談袒探歎湯燙濤縧騰謄銻題啼體嚏涕屜條貼鐵廳聽烴銅統頭圖塗團頹蛻退拖脫鴕馱駝橢窪襪彎灣頑萬網韋違圍惟爲濰維葦偉僞緯謂衛溫聞紋穩問翁甕撾蝸渦窩握嗚鎢烏誣無蕪吳塢霧務誤錫犧膝檄襲習銑戲細蝦轄峽俠狹廈鍁鮮纖鹹賢銜閑顯險現獻縣餡羨憲限線廂鑲鄉詳響項蕭銷曉嘯些蠍協挾攜脅諧寫卸懈瀉謝鋅釁興洶鏽繡戌虛噓須許緒續軒懸選癬絢薛學勳詢尋馴訓訊遜壓鴉鴨啞亞訝咽閹煙鹽嚴顔閻豔厭硯唁彥諺驗鴦楊揚瘍陽癢養樣邀瑤搖堯遙窯謠藥噎爺頁業葉夜壹醫銥頤遺儀彜蟻藝億逸疫毅憶義詣議誼譯異翌繹蔭陰銀飲櫻嬰鷹應纓瑩螢營熒蠅穎喲擁傭癰雍踴詠湧優憂郵鈾猶遊誘盂愚輿魚渝漁娛與嶼語籲禦獄譽預馭鴛淵轅園員圓源緣遠願院約躍鑰嶽粵悅閱雲鄖勻隕運蘊醞暈韻雜災載攢暫贊贓髒遭鑿棗竈責擇則澤賊贈紮劄軋鍘閘詐齋債瞻氈盞斬輾嶄蘸棧戰湛綻張漲帳賬脹趙蟄轍鍺這甄臻貞針偵診振鎮陣掙睜猙幀鄭證織職殖執紙摯擲幟質鍾終種腫衆謅軸皺晝驟豬諸誅燭矚囑貯鑄築駐專磚轉賺樁莊裝妝壯狀錐贅墜綴諄濁茲資漬棕蹤綜總縱鄒詛組鑽緻鐘麼為隻兇準啟闆裡靂餘鍊洩" if types=1 then "@#简到烦 surnfujtofstr=surnfujof(str,surnfujian,surnfufan) elseif types=2 then "@#简到烦 surnfujtofstr=surnfujof(str,surnfufan,surnfujian) end if surnfujtof=surnfujtofstr end function function surnfujof(str,str1,str2) dim surnfufori,finlishstr,surnfulens surnfulens=len(str) finlishstr="" for surnfufori=1 to surnfulens if instr(str1,mid(str,surnfufori,1))<>0 then finlishstr=finlishstr&mid(str2,instr(str1,mid(str,surnfufori,1)),1) else finlishstr=finlishstr&mid(str,surnfufori,1) end if next surnfujof=finlishstr end function %> |
调用代码：
response.write surnfujtof("我",1)
注释：1简到繁 2繁到简；其中“我”为需要转换的字符，希望对大家有用。
给PJBlog增加语法高亮的功能
Submitted by on 2007, March 9, 5:35 AM
支持以下类型:
1. c
2. c#
3. css
4. js
5. delphi
6. java
7. php
8. python
9. ruby
10. vb
11. sql
12. xml
功能演示
http://www.tsingfeng.com/a...
1. c
2. c#
3. css
4. js
5. delphi
6. java
7. php
8. python
9. ruby
10. vb
11. sql
12. xml
功能演示
http://www.tsingfeng.com/a...
下载文件
VBS中使用Try——Catch
Submitted by on 2007, February 9, 5:17 PM
值得一看
[html]<script language="vbscript">
function Test(a,b)
Test = a/b
end function
</script>
<script language="javascript">
try
{
alert(Test(6,0));
}
catch(e)
{
alert(e.message);
}
</script> [/html]
[html]<script language="vbscript">
function Test(a,b)
Test = a/b
end function
</script>
<script language="javascript">
try
{
alert(Test(6,0));
}
catch(e)
{
alert(e.message);
}
</script> [/html]
VBScript实现的ASP模板类（未测试）
Submitted by on 2007, February 3, 7:22 PM
<%
" 档案名称：cls_MyTemplate.asp
" 原创作者：胡传照
Class MyTemplate
Private m_strError " 出错信息
Private m_strVersion " 版本号
Private m_strVersionName " 版本名称
Private m_strClassName " 类的名称
Private mvarTplPath "As Variant "local copy
Private objDic "As Scripting.Dictionary "local copy
" 类初始化
Private Sub Class_Initialize()
m_strError = ""
m_strVersion = "0.1"
m_strVersionName = "Alpha 0.1版"
m_strClassName = ""
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
End Sub
" 类释放
Private Sub Class_Terminate()
Set Dic = Nothing
m_strError = ""
m_strVersion = ""
m_strVersionName = ""
m_strName = ""
End Sub
"-----读写各个属性---------------------------
Public Property Get ClassName()
ClassName = m_strClassName
End Property
Public Property Let ClassName(strName)
m_strClassName = strName
End Property
"-----------------------------------------------
" 获取错误信息
Public Function GetLastError()
GetLastError = m_strError
End Function
" 私有方法，添加错误信息
Private Sub AddErr(strEcho)
m_strError = m_strError + "<Div CLASS=""alert"">" & strEcho & "</Div>"
End Sub
" 清除错误信息
Public Function ClearError()
m_strError = ""
End Function
Public Function Parse(varName) " As String) As String
Dim mc "As MatchCollection
Dim m "As Match
"Dim sms "As SubMatches
Dim i
If Dic.Item(varName) = Empty Then
Parse = ""
Else
Dim reg "As RegExp
Set reg = New RegExp
reg.Global = True
reg.MultiLine = True
reg.IgnoreCase = True
reg.Pattern = "{(\w*)}"
Dim strResult "As String
strResult = Dic.Item(varName)
Set mc = reg.Execute(strResult)
If mc.Count >= 1 Then
For i = 0 To mc.Count - 1
Set m = mc.Item(i)
Key = Mid(m.Value, 2, Len(m.Value) - 2)
reg.Pattern = m.Value
If Not IsEmpty(Dic.Item(Key)) Then
strResult = reg.Replace(strResult, Dic.Item(Key))
End If
Set m = Nothing
Next
End If
Set mc = Nothing
Set reg = Nothing
Parse = strResult
End If
End Function
Public Sub SplitVars(varName) "As String)
Dim lenth "As Integer
Dim mc "As MatchCollection
Dim m "As Match
Dim sms "As SubMatches
"Response.Write "test " & varname &"<br>"
If Dic.Item(varName) = Empty Then
Response.Write varname &" is empty"
Exit Sub
End If
Dim Template_Exp "As RegExp
Set Template_Exp = New RegExp
"Template_Exp.Global = True
Template_Exp.IgnoreCase = True
"<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND+\1 *-->
"<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND +\1 *-->
Template_Exp.Pattern = "<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND +\1 *-->"
While Template_Exp.Test(Dic.Item(varName)) <> False
Set mc = Template_Exp.Execute(Dic.Item(varName))
If mc.Count >= 1 Then
"mc.Item(0) = mc.Item(1)
For Each m In mc
"r = r & m.Value & vbNewLine
Set sms = m.SubMatches
" For j = 0 To sms.Count - 1
" r = r & sms.Item(j) & vbNewLine
" Next j
Dic.Item(sms.Item(0)) = sms.Item(1)
Next " m
"MsgBox r
End If
s = "{" & sms.Item(0) & "}"
"MsgBox s
Dic.Item(varName) = Template_Exp.Replace(Dic.Item(varName), s)
" MsgBox Dic.Item(varName), , "Dic.Item(varName)"
s = sms.Item(0)
Set sms = Nothing
Set mc = Nothing
SplitVars (s)
"Set Template_Exp = Nothing
Wend
End Sub
Public Sub LoadFile(varName, filename) "(varName As String, filename As String)
Dim fso "As Scripting.FileSystemObject
Set fso = Server.CreateObject("Scripting.FileSystemObject") "New FileSystemObject
Dim Pathfile "As String
Pathfile = fso.BuildPath(TplPath, filename)
Response.Write Server.MapPath(Pathfile) & "<br>"
If fso.FileExists(Server.MapPath(Pathfile)) Then
Set f = fso.OpenTextFile(Server.MapPath(Pathfile), 1)
Dic.RemoveAll
Dic.Item(varName) = f.ReadAll()
Response.Write "Dic.Item("& varName&")="
Response.Write "laod file success "
Set f = Nothing
else
Response.Write Pathfile & " ----Do not Exist<br>"
Response.Write "load file faild"
End If
Pathfile = ""
Set fso = Nothing
End Sub
Public Sub LoadAccess(varName, TemplateName) "(varName As String, TemplateName As String)
sqlTemplate = "Select * From Template Where TemplateName="" & TemplateName & """
"Response.Write sqlTemplate
If Not IsObject(Conn) Then
DBPath = "./"
DBFile = "data/BlogData.mdb"
ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(""& DbPath & "" & DbFile & "")
"Response.Write ConnStr
Set Conn=Server.CreateObject("ADODB.Connection")
Conn.open ConnStr
If Err Then
Err.Clear
Set Conn = Nothing
AddErr "数据库连接出错，请检查连接字串。"
Response.Write GetLastError
"Response.Write Err
Dic.Item(varName) = "加载数据失败，请检查数据库连接是否正确"
"Response.End
End If
End If
Set rsTemplate = Server.CreateObject("Adodb.Recordset")
rsTemplate.Open sqlTemplate, Conn, 1, 1
Dic.Item(varName) = rsTemplate("TemplateHtml")
rsTemplate.Close
Set rsTemplate = Nothing
End Sub
Public Property Let TplPath(vData) "(ByVal vData) "As Variant)
mvarTplPath = vData
End Property
"Public Property Set TplPath(vData)"(ByVal vData) "As Variant)
" Set mvarTplPath = vData
"End Property
Public Property Get TplPath() "As Variant
"If IsObject(mvarTplPath) Then
" Set TplPath = mvarTplPath
"Else
TplPath = mvarTplPath
"End If
End Property
"Public Property Let Dic(vData)"(ByVal vData) "As Variant)
" objDic = vData
"End Property
Public Property Set Dic(vData) "(ByVal vData) "As Variant)
Set objDic = vData
End Property
Public Property Get Dic() "As Variant
If IsObject(objDic) Then
"a=objDic.Keys
"response.Write "In Dic there are " &cstr(objDic.count) & "Items<br>"
"for i=objDic.count-1 to 0 step -1
"response.Write "Index "&CStr(i)&"-" & a(i) & ":" & objDic.Item(a(i))& "<br>--------------------------------------<br>"
"response.Write a(i) & vbNewline
"
"next
Set Dic = objDic
Else
Dic = objDic
End If
End Property
End Class
%>
调试的时候使用了VB来调试，所以里面有很多VB的代码，但是都注释掉了，不影响使用。
使用和沐风的那个差不多。
例子：
<!--#include file="cls_MyTemplate.asp"-->
Dim tpl "As MyTemplate
Set tpl = New MyTemplate
tpl.TplPath = "E:\Webs\hublog\template"
"tpl.LoadFile "Main", "blogview.htm"
tpl.LoadAccess "Main","default"
TplLoadTimes=TplLoadTimes+1
tpl.SplitVars ("Main")
"a=tpl.Dic.Keys
"response.Write "ssssssssssssssssssssssssssssssssssssssssssssss"
"for i=tpl.Dic.count-1 to 0 step -1
"response.Write a(i)
"response.Write "::::--->>><br>" & tpl.dic.Item(a(i))& "<br>--------------------------------------<br>"
"response.Write a(i) & vbNewline
"tpl.Dic.Item(a(i))=tpl.Parse(a(i))
"next
Dim ss
"tpl.Dic.Item("TITLE") =tpl.Parse("TITLE")
ss = objMyBlogArticle.Title
tpl.Dic.Item("TITLE") =CheckEmptyStr(ss,"标题未设置")
"tpl.Dic.Item("AUTHOR") =tpl.Parse("AUTHOR")
ss = objMyBlogArticle.Author
tpl.Dic.Item("AUTHOR") = CheckEmptyStr(ss,"作者不详")
"tpl.Dic.Item("CONTENT") = tpl.Parse("CONTENT")
ss = objMyBlogArticle.Content
tpl.Dic.Item("CONTENT") = CheckEmptyStr(ss,"请更新数据")
"tpl.Dic.Item("POSTTIME") = tpl.Parse("POSTTIME")
ss = objMyBlogArticle.PostTime
tpl.Dic.Item("POSTTIME") =CheckEmptyStr(ss,"请更新数据")
tpl.Dic.Item("ARTICLE") = tpl.Parse("ARTICLE")
"response.Write tpl.Parse("TITLE")
"response.Write tpl.Parse("ARTICLE")
response.Write tpl.Parse("Main")
Set tpl = Nothing
else
Response.Write "文章不存在!"
End if
Set objMyBlogArticle = Nothing%>
----------------------------
blogview.htm自己去填，有时间的话我再贴上来，没时间就算了
loadaccess中的tpl.LoadAccess "Main","default"，default是一个模版的名字，内容是blogview.htm
" 档案名称：cls_MyTemplate.asp
" 原创作者：胡传照
Class MyTemplate
Private m_strError " 出错信息
Private m_strVersion " 版本号
Private m_strVersionName " 版本名称
Private m_strClassName " 类的名称
Private mvarTplPath "As Variant "local copy
Private objDic "As Scripting.Dictionary "local copy
" 类初始化
Private Sub Class_Initialize()
m_strError = ""
m_strVersion = "0.1"
m_strVersionName = "Alpha 0.1版"
m_strClassName = ""
Set Dic = CreateObject("Scripting.Dictionary")
Dic.CompareMode = vbTextCompare
End Sub
" 类释放
Private Sub Class_Terminate()
Set Dic = Nothing
m_strError = ""
m_strVersion = ""
m_strVersionName = ""
m_strName = ""
End Sub
"-----读写各个属性---------------------------
Public Property Get ClassName()
ClassName = m_strClassName
End Property
Public Property Let ClassName(strName)
m_strClassName = strName
End Property
"-----------------------------------------------
" 获取错误信息
Public Function GetLastError()
GetLastError = m_strError
End Function
" 私有方法，添加错误信息
Private Sub AddErr(strEcho)
m_strError = m_strError + "<Div CLASS=""alert"">" & strEcho & "</Div>"
End Sub
" 清除错误信息
Public Function ClearError()
m_strError = ""
End Function
Public Function Parse(varName) " As String) As String
Dim mc "As MatchCollection
Dim m "As Match
"Dim sms "As SubMatches
Dim i
If Dic.Item(varName) = Empty Then
Parse = ""
Else
Dim reg "As RegExp
Set reg = New RegExp
reg.Global = True
reg.MultiLine = True
reg.IgnoreCase = True
reg.Pattern = "{(\w*)}"
Dim strResult "As String
strResult = Dic.Item(varName)
Set mc = reg.Execute(strResult)
If mc.Count >= 1 Then
For i = 0 To mc.Count - 1
Set m = mc.Item(i)
Key = Mid(m.Value, 2, Len(m.Value) - 2)
reg.Pattern = m.Value
If Not IsEmpty(Dic.Item(Key)) Then
strResult = reg.Replace(strResult, Dic.Item(Key))
End If
Set m = Nothing
Next
End If
Set mc = Nothing
Set reg = Nothing
Parse = strResult
End If
End Function
Public Sub SplitVars(varName) "As String)
Dim lenth "As Integer
Dim mc "As MatchCollection
Dim m "As Match
Dim sms "As SubMatches
"Response.Write "test " & varname &"<br>"
If Dic.Item(varName) = Empty Then
Response.Write varname &" is empty"
Exit Sub
End If
Dim Template_Exp "As RegExp
Set Template_Exp = New RegExp
"Template_Exp.Global = True
Template_Exp.IgnoreCase = True
"<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND+\1 *-->
"<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND +\1 *-->
Template_Exp.Pattern = "<!--#TPLDEF +(\w*) *-->((.|\n)*)<!--#TPLEND +\1 *-->"
While Template_Exp.Test(Dic.Item(varName)) <> False
Set mc = Template_Exp.Execute(Dic.Item(varName))
If mc.Count >= 1 Then
"mc.Item(0) = mc.Item(1)
For Each m In mc
"r = r & m.Value & vbNewLine
Set sms = m.SubMatches
" For j = 0 To sms.Count - 1
" r = r & sms.Item(j) & vbNewLine
" Next j
Dic.Item(sms.Item(0)) = sms.Item(1)
Next " m
"MsgBox r
End If
s = "{" & sms.Item(0) & "}"
"MsgBox s
Dic.Item(varName) = Template_Exp.Replace(Dic.Item(varName), s)
" MsgBox Dic.Item(varName), , "Dic.Item(varName)"
s = sms.Item(0)
Set sms = Nothing
Set mc = Nothing
SplitVars (s)
"Set Template_Exp = Nothing
Wend
End Sub
Public Sub LoadFile(varName, filename) "(varName As String, filename As String)
Dim fso "As Scripting.FileSystemObject
Set fso = Server.CreateObject("Scripting.FileSystemObject") "New FileSystemObject
Dim Pathfile "As String
Pathfile = fso.BuildPath(TplPath, filename)
Response.Write Server.MapPath(Pathfile) & "<br>"
If fso.FileExists(Server.MapPath(Pathfile)) Then
Set f = fso.OpenTextFile(Server.MapPath(Pathfile), 1)
Dic.RemoveAll
Dic.Item(varName) = f.ReadAll()
Response.Write "Dic.Item("& varName&")="
Response.Write "laod file success "
Set f = Nothing
else
Response.Write Pathfile & " ----Do not Exist<br>"
Response.Write "load file faild"
End If
Pathfile = ""
Set fso = Nothing
End Sub
Public Sub LoadAccess(varName, TemplateName) "(varName As String, TemplateName As String)
sqlTemplate = "Select * From Template Where TemplateName="" & TemplateName & """
"Response.Write sqlTemplate
If Not IsObject(Conn) Then
DBPath = "./"
DBFile = "data/BlogData.mdb"
ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(""& DbPath & "" & DbFile & "")
"Response.Write ConnStr
Set Conn=Server.CreateObject("ADODB.Connection")
Conn.open ConnStr
If Err Then
Err.Clear
Set Conn = Nothing
AddErr "数据库连接出错，请检查连接字串。"
Response.Write GetLastError
"Response.Write Err
Dic.Item(varName) = "加载数据失败，请检查数据库连接是否正确"
"Response.End
End If
End If
Set rsTemplate = Server.CreateObject("Adodb.Recordset")
rsTemplate.Open sqlTemplate, Conn, 1, 1
Dic.Item(varName) = rsTemplate("TemplateHtml")
rsTemplate.Close
Set rsTemplate = Nothing
End Sub
Public Property Let TplPath(vData) "(ByVal vData) "As Variant)
mvarTplPath = vData
End Property
"Public Property Set TplPath(vData)"(ByVal vData) "As Variant)
" Set mvarTplPath = vData
"End Property
Public Property Get TplPath() "As Variant
"If IsObject(mvarTplPath) Then
" Set TplPath = mvarTplPath
"Else
TplPath = mvarTplPath
"End If
End Property
"Public Property Let Dic(vData)"(ByVal vData) "As Variant)
" objDic = vData
"End Property
Public Property Set Dic(vData) "(ByVal vData) "As Variant)
Set objDic = vData
End Property
Public Property Get Dic() "As Variant
If IsObject(objDic) Then
"a=objDic.Keys
"response.Write "In Dic there are " &cstr(objDic.count) & "Items<br>"
"for i=objDic.count-1 to 0 step -1
"response.Write "Index "&CStr(i)&"-" & a(i) & ":" & objDic.Item(a(i))& "<br>--------------------------------------<br>"
"response.Write a(i) & vbNewline
"
"next
Set Dic = objDic
Else
Dic = objDic
End If
End Property
End Class
%>
调试的时候使用了VB来调试，所以里面有很多VB的代码，但是都注释掉了，不影响使用。
使用和沐风的那个差不多。
例子：
<!--#include file="cls_MyTemplate.asp"-->
Dim tpl "As MyTemplate
Set tpl = New MyTemplate
tpl.TplPath = "E:\Webs\hublog\template"
"tpl.LoadFile "Main", "blogview.htm"
tpl.LoadAccess "Main","default"
TplLoadTimes=TplLoadTimes+1
tpl.SplitVars ("Main")
"a=tpl.Dic.Keys
"response.Write "ssssssssssssssssssssssssssssssssssssssssssssss"
"for i=tpl.Dic.count-1 to 0 step -1
"response.Write a(i)
"response.Write "::::--->>><br>" & tpl.dic.Item(a(i))& "<br>--------------------------------------<br>"
"response.Write a(i) & vbNewline
"tpl.Dic.Item(a(i))=tpl.Parse(a(i))
"next
Dim ss
"tpl.Dic.Item("TITLE") =tpl.Parse("TITLE")
ss = objMyBlogArticle.Title
tpl.Dic.Item("TITLE") =CheckEmptyStr(ss,"标题未设置")
"tpl.Dic.Item("AUTHOR") =tpl.Parse("AUTHOR")
ss = objMyBlogArticle.Author
tpl.Dic.Item("AUTHOR") = CheckEmptyStr(ss,"作者不详")
"tpl.Dic.Item("CONTENT") = tpl.Parse("CONTENT")
ss = objMyBlogArticle.Content
tpl.Dic.Item("CONTENT") = CheckEmptyStr(ss,"请更新数据")
"tpl.Dic.Item("POSTTIME") = tpl.Parse("POSTTIME")
ss = objMyBlogArticle.PostTime
tpl.Dic.Item("POSTTIME") =CheckEmptyStr(ss,"请更新数据")
tpl.Dic.Item("ARTICLE") = tpl.Parse("ARTICLE")
"response.Write tpl.Parse("TITLE")
"response.Write tpl.Parse("ARTICLE")
response.Write tpl.Parse("Main")
Set tpl = Nothing
else
Response.Write "文章不存在!"
End if
Set objMyBlogArticle = Nothing%>
----------------------------
blogview.htm自己去填，有时间的话我再贴上来，没时间就算了
loadaccess中的tpl.LoadAccess "Main","default"，default是一个模版的名字，内容是blogview.htm
实现只下载的asp代码
Submitted by on 2007, February 3, 7:04 PM
贴代码啰：
| 代码: |
| if Request("Filename")="" then
response.write "<h1>Error:</h1>Filename is empty!<p>" else call downloadFile(replace(replace(Request("Filename"),"\",""),"/","")) end if Function downloadFile(strFile) strFilename = server.MapPath(strFile) Response.Buffer = True Response.Clear Set s = Server.CreateObject("ADODB.Stream") s.Open "Set as binary s.Type = 1 "load in the file on error resume next "check the file exists Set fso = Server.CreateObject("Scripting.FileSystemObject") if not fso.FileExists(strFilename) then Response.Write("<h1>Error:</h1>"&strFilename&" does not exists!<p>") Response.End end if "get length of file Set f = fso.GetFile(strFilename) intFilelength = f.size s.LoadFromFile(strFilename) if err then Response.Write("<h1>Error: </h1>Unknown Error!<p>") Response.End end if "send the headers to the users Browse Response.AddHeader "Content-Disposition","attachment; filename="&f.name Response.AddHeader "Content-Length",intFilelength Response.CharSet = "UTF-8" Response.ContentType = "application/octet-stream" "output the file to the browser Response.BinaryWrite s.Read Response.Flush "tidy up s.Close Set s = Nothing End Function |
AspJpeg制作透明文字水印
Submitted by on 2007, January 30, 7:18 PM
效果图：
技术支持：
1、aspjpeg能对图片水印进行透明度调整，不能对文字水印调整，
2、aspjpeg支持Binary，可以Jpeg.OpenBinary读取，可以Jpeg.sendBinary,也可Jpeg.Binary赋值
思路：
1、把原始的图片数据二进制度赋值给TempA，
2、将文字水印处理后的图片数据二进制赋值给TempB，
3、以TempB作为"图片水印"，附加在TempA上，调整透明度，输出就ok了
思路很简单，代码也很简单：
<%
LocalFile="d:\apple.jpg"
TargetFile="d:\myapple.jpg"
Dim Jpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
If Err.Number=-2147221005 then
Response.write "没有这个组件，请安装!""检查是否安装AspJpeg组件
Response.End()
End If
Jpeg.Open (LocalFile)"打开图片
If err.number then
Response.write"打开图片失败,请检查路径！"
Response.End()
End if
Dim TempA "原始图片的二进制数据
Dim TempB "加了不透明文字水印的图片
Dim TempC "最终效果
TempA=Jpeg.Binary"将原始数据赋给TempA
"=========加文字水印=================
Jpeg.Canvas.Font.Color = &Hfffffff"水印文字颜色
Jpeg.Canvas.Font.Family = Arial"字体
Jpeg.Canvas.Font.Bold = True"是否加粗
Jpeg.Canvas.Font.Size = 35"字体大小
Jpeg.Canvas.Font.ShadowColor = &H000000"阴影色彩
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = True
Jpeg.Canvas.Font.Quality = 5"输出质量
Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-150,Jpeg.OriginalHeight/2,"www.Tsingfeng.com"...水印位置及文字
TempB=Jpeg.Binary"将文字水印处理后的值赋给TempB，这时，文字水印没有不透明度
"============调整文字透明度================
Set MyJpeg = Server.CreateObject("Persits.Jpeg")
MyJpeg.OpenBinary TempA
Set Logo = Server.CreateObject("Persits.Jpeg")
Logo.OpenBinary TempB
MyJpeg.DrawImage 0,0, Logo, 0.2"0.3是透明度
TempC=MyJpeg.Binary"将最终结果赋值给TempC,这时也可以生成目标图片了
response.BinaryWrite TempC"将二进输出给浏览器
MyJpeg.Save (TargetFile)
set TempA=nothing
set TempB=nothing
set TempC=nothing
Jpeg.close
MyJpeg.Close
Logo.Close
%>
原图：
技术支持：
1、aspjpeg能对图片水印进行透明度调整，不能对文字水印调整，
2、aspjpeg支持Binary，可以Jpeg.OpenBinary读取，可以Jpeg.sendBinary,也可Jpeg.Binary赋值
思路：
1、把原始的图片数据二进制度赋值给TempA，
2、将文字水印处理后的图片数据二进制赋值给TempB，
3、以TempB作为"图片水印"，附加在TempA上，调整透明度，输出就ok了
思路很简单，代码也很简单：
<%
LocalFile="d:\apple.jpg"
TargetFile="d:\myapple.jpg"
Dim Jpeg
Set Jpeg = Server.CreateObject("Persits.Jpeg")
If Err.Number=-2147221005 then
Response.write "没有这个组件，请安装!""检查是否安装AspJpeg组件
Response.End()
End If
Jpeg.Open (LocalFile)"打开图片
If err.number then
Response.write"打开图片失败,请检查路径！"
Response.End()
End if
Dim TempA "原始图片的二进制数据
Dim TempB "加了不透明文字水印的图片
Dim TempC "最终效果
TempA=Jpeg.Binary"将原始数据赋给TempA
"=========加文字水印=================
Jpeg.Canvas.Font.Color = &Hfffffff"水印文字颜色
Jpeg.Canvas.Font.Family = Arial"字体
Jpeg.Canvas.Font.Bold = True"是否加粗
Jpeg.Canvas.Font.Size = 35"字体大小
Jpeg.Canvas.Font.ShadowColor = &H000000"阴影色彩
Jpeg.Canvas.Font.ShadowYOffset = 1
Jpeg.Canvas.Font.ShadowXOffset = 1
Jpeg.Canvas.Brush.Solid = True
Jpeg.Canvas.Font.Quality = 5"输出质量
Jpeg.Canvas.PrintText Jpeg.OriginalWidth/2-150,Jpeg.OriginalHeight/2,"www.Tsingfeng.com"...水印位置及文字
TempB=Jpeg.Binary"将文字水印处理后的值赋给TempB，这时，文字水印没有不透明度
"============调整文字透明度================
Set MyJpeg = Server.CreateObject("Persits.Jpeg")
MyJpeg.OpenBinary TempA
Set Logo = Server.CreateObject("Persits.Jpeg")
Logo.OpenBinary TempB
MyJpeg.DrawImage 0,0, Logo, 0.2"0.3是透明度
TempC=MyJpeg.Binary"将最终结果赋值给TempC,这时也可以生成目标图片了
response.BinaryWrite TempC"将二进输出给浏览器
MyJpeg.Save (TargetFile)
set TempA=nothing
set TempB=nothing
set TempC=nothing
Jpeg.close
MyJpeg.Close
Logo.Close
%>
原图：
Aspjpeg入门详解
Submitted by on 2007, January 30, 6:20 PM
ASPJPEG是一款功能相当强大的图象处理组件，用它可以轻松地做出图片的缩略图和为图片加上水印功能。呵呵，应该都知道了。先说制作缩略图吧
1、为图片制作缩略图
<%
" ###建立实例###
Dim Jpeg,Path
Set Jpeg = Server.CreateObject("Persits.Jpeg")
" ###图片所在位置###
Path = Server.MapPath("images/clock.jpg")
" ###打开###
Jpeg.Open Path
" ###设置缩略图大小（这里比例设定为原图的50%）###
"###OriginalWidth属性为原图的宽,OriginalHeight为原图的高###
"###也可以直接指定Width和Height 属性为具体数值###
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
" ###保存缩略图到指定文件夹下###
Jpeg.Save Server.MapPath("images/clock_small.jpg"")
" ###注销实例###
Set Jpeg = Nothing
%>
2、为图片加入水印功能
2.1加入文字水印
<%
Dim Jpeg
" 建立实例
Set Jpeg = Server.CreateObject("Persits.Jpeg")
" 打开目标图片
Jpeg.Open Server.MapPath("images/dodge_viper.jpg")
" 添加文字水印
Jpeg.Canvas.Font.Color = &HFF0000" 红色
Jpeg.Canvas.Font.Family = "宋体"
Jpeg.Canvas.Font.Bold = True
Jpeg.Canvas.Print 10, 10, "Copyright (c) TSINGFENG.com"
" 保存文件
Jpeg.Save Server.MapPath("images/dodge_viper_framed.jpg")
" 注销对象
Set Jpeg = Nothing
%>
2.2加入图片水印
<%
LocalFile="d:\apple.jpg"
LogoFile="d:\logo.jpg"
TargetFile="d:\myapplelogo.jpg"
Set LocalJpeg = Server.CreateObject("Persits.Jpeg")
LocalJpeg.Open (LocalFile) "打开处理图片
Set Logo = Server.CreateObject("Persits.Jpeg")
Logo.Open (LogoFile) "打开水印图片
LocalJpeg.DrawImage 255,280, Logo, 0.5 "0,0是位置,0.5是透明度
TempA=localJpeg.binary
response.BinaryWrite TempA"将二进输出给浏览器
LocalJpeg.Save (TargetFile) "保存加了水印的图片
set TempA=nothing
Logo.close
LocalJpeg.close
%>
以上代码，淡水河边这厮都测试通过了。
1、为图片制作缩略图
<%
" ###建立实例###
Dim Jpeg,Path
Set Jpeg = Server.CreateObject("Persits.Jpeg")
" ###图片所在位置###
Path = Server.MapPath("images/clock.jpg")
" ###打开###
Jpeg.Open Path
" ###设置缩略图大小（这里比例设定为原图的50%）###
"###OriginalWidth属性为原图的宽,OriginalHeight为原图的高###
"###也可以直接指定Width和Height 属性为具体数值###
Jpeg.Width = Jpeg.OriginalWidth / 2
Jpeg.Height = Jpeg.OriginalHeight / 2
" ###保存缩略图到指定文件夹下###
Jpeg.Save Server.MapPath("images/clock_small.jpg"")
" ###注销实例###
Set Jpeg = Nothing
%>
2、为图片加入水印功能
2.1加入文字水印
<%
Dim Jpeg
" 建立实例
Set Jpeg = Server.CreateObject("Persits.Jpeg")
" 打开目标图片
Jpeg.Open Server.MapPath("images/dodge_viper.jpg")
" 添加文字水印
Jpeg.Canvas.Font.Color = &HFF0000" 红色
Jpeg.Canvas.Font.Family = "宋体"
Jpeg.Canvas.Font.Bold = True
Jpeg.Canvas.Print 10, 10, "Copyright (c) TSINGFENG.com"
" 保存文件
Jpeg.Save Server.MapPath("images/dodge_viper_framed.jpg")
" 注销对象
Set Jpeg = Nothing
%>
2.2加入图片水印
<%
LocalFile="d:\apple.jpg"
LogoFile="d:\logo.jpg"
TargetFile="d:\myapplelogo.jpg"
Set LocalJpeg = Server.CreateObject("Persits.Jpeg")
LocalJpeg.Open (LocalFile) "打开处理图片
Set Logo = Server.CreateObject("Persits.Jpeg")
Logo.Open (LogoFile) "打开水印图片
LocalJpeg.DrawImage 255,280, Logo, 0.5 "0,0是位置,0.5是透明度
TempA=localJpeg.binary
response.BinaryWrite TempA"将二进输出给浏览器
LocalJpeg.Save (TargetFile) "保存加了水印的图片
set TempA=nothing
Logo.close
LocalJpeg.close
%>
以上代码，淡水河边这厮都测试通过了。
