1，经常写些系统，那么一般都是从登录程序开始，每接一个系统就写一次登录，好麻烦。
干脆直接做个登录验证函数吧，对我来说，大都情况可以胜任了：）
[code]
<%
Function chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)dim cn_name,cn_pwdcn_name=trim(request.form(""&requestname&""))cn_pwd=trim(request.form(""&requestpwd&""))if cn_name="" or cn_pwd="" thenresponse.Write("<script language=javascript>alert(""请将帐号密码填写完整，谢谢合作。"");history.go(-1)</script>")end ifSet rs = server.CreateObject ("ADODB.Recordset")sql = "Select * from "&tablename&" where "&namefield&"=''"&cn_name&"''"rs.open sql,conn,1,1if rs.eof thenresponse.Write("<script language=javascript>alert(""没有该会员ID，请确认有没有被申请。"");history.go(-1)</script>")elseif rs(""&pwdfield&"")=cn_pwd then session("cn_name")=rs(""&namefield&"")response.Redirect(reurl)elseresponse.Write("<script language=javascript>alert(""提醒，您的帐号和密码是不吻合。注意数字和大小写。"");history.go(-1)</script>")end ifend ifrs.close Set rs = NothingEnd Function%>
[code]
参数说明：
chk_regist(requestname,requestpwd,tablename,namefield,pwdfield,reurl)
requestname 为接受HTML页中输入名称的INPUT控件名
requestpwd 为接受HTML页中输入密码的INPUT控件名
tablename 为数据库中保存注册信息的表名
namefield 为该信息表中存放用户名称的字段名
pwdfield 为该信息表中存放用户密码的字段名
reurl 为登录正确后跳转的页
引用示例如下：
<%call chk_regist("b_name","b_pwd","cn_admin","cn_name","cn_pwd","admin.asp")%>
2，经常有可能对某个事物进行当前状态的判断，一般即做一字段（数值类型，默认值为0）
通过对该字段值的修改达到状态切换的效果。那么，我又做了个函数，让自己轻松轻松。
<%Function pvouch(tablename,fildname,autoidname,indexid)dim fildvalueSet rs = Server.CreateObject ("ADODB.Recordset")sql = "Select * from "&tablename&" where "&autoidname&"="&indexidrs.Open sql,conn,2,3fildvalue=rs(""&fildname&"")if fildvalue=0 thenfildvalue=1elsefildvalue=0end ifrs(""&fildname&"")=fildvaluers.updaters.close Set rs = NothingEnd Function%>
参数说明：
pvouch(tablename,fildname,autoidname,indexid)
tablename 该事物所在数据库中的表名
fildname 该事物用以表明状态的字段名（字段类型是数值型）
autoidname 在该表中的自动编号名
indexid 用以修改状态的对应自动编号的值
引用示例如下：
<%dowhat=request.QueryString("dowhat")p_id=cint(request.QueryString("p_id"))if dowhat="tj" and p_id<>"" thencall pvouch("cn_products","p_vouch","p_id",p_id)end if%><%if rs("p_vouch")=0 then%>>推荐<%else%>>取消推荐<%end if%>
3，为很多中小企业写站点，一般产品展示是个大项目，那么做成的页面也就不同。
要不就是横排来几个，要不就是竖排来几个，甚至全站要翻来覆去的搞个好几次，麻烦也很累。
索性写个函数能缓解一下，于是就成了下面
<%function showpros(tablename,topnum,fildname,loopnum,typenum)Set rs = Server.CreateObject ("ADODB.Recordset")sql = "Select top "&topnum&" * from "&tablenamers.Open sql,conn,1,1if rs.eof and rs.bof thenresponse.Write("暂时无该记录")elseresponse.Write("")for i=1 to rs.recordcountif (i mod loopnum=1) thenresponse.write" "end ifselect case typenumcase "1"response.Write(" ")response.Write(rs(""&fildname&""))response.Write(" ")response.Write("方式1之"&i&"记录")''此处的“方式1”可以替换显示为其余字段的值response.Write(" ")''如果字段比较多，继续添加新个表格行来显示response.Write(" ")case "2"response.Write(" ")response.Write(rs(""&fildname&""))response.Write(" ")response.Write(" ")response.Write("方式2之"&i&"记录")response.Write(" ")response.Write(" ")end selectif (i mod loopnum=0) thenresponse.write" "end ifrs.movenextnextresponse.Write(" ")end ifrs.close Set rs = Nothingend function%>
参数说明：showpros(tablename,topnum,fildname,loopnum,typenum)
whichpro为选择何类型的产品种类
topnum表示提取多少条记录
fildname表示调试显示的字段，具体应用的时候可以省去该参数，在函数内部直接使用
loopnum表示显示的循环每行的记录条数
typenum表示循环显示的方法：目前分了两类，横向并列、纵向并列显示同一数据记录行的不同记录
引用示例如下：
<%if request.form("submit")<>"" thentopnum=request.form("topnum")loopnum=request.form("loopnum")typenum=request.form("typenum")elsetopnum=8loopnum=2typenum=1end if%><%call showpros("cn_products",topnum,"p_name",loopnum,typenum)%>
1.文件上传（单个）
upload.asp '文件上传参数及数据库插入页面
<!--#include file="upLoad_class.asp"-->
<!--#include file="conn.asp"-->
<%
Set myrequest=new UpLoadClass
myrequest.MaxSize=5000*1024 '如果不写这行，默认最大为500K
myrequest.FileType="zip/rar/jpeg/jpg/doc/txt/pdf/ppt/xls" '如果不写这行，默认文件类型限制为gif/jpg
myrequest.Savepath="file/" '如果不写这行，默认为UpLoadFile/
myrequest.open
path="file/"+myrequest.Form("photo")
a=date()
ftime=FormatDateTime(a)
conn.execute("insert into filetable(path,ftime) values('"& path &"','"& ftime &"')")
response.Redirect("upload_ok.asp")
%>
upLoad_class.asp '上传类
<%
Class UpLoadClass
Private Ver,Err,FormD,FormStream,ItemStream
Dim MaxSize,FileType,SavePath,AutoSave
Private Sub Class_Initialize
MaxSize=150*1024
FileType="jpg/gif"
SavePath="UpLoadFile/"
AutoSave=true
Ver ="Rumor UpLoadClass Version 1.02"
Err=0
Set FormD = Server.CreateObject ("Scripting.Dictionary")
FormD.CompareMode = 1
Set FormStream=server.CreateObject("ADODB.Stream")
Set ItemStream=server.CreateObject("ADODB.Stream")
End Sub
Private Sub Class_Terminate
Set ItemStream=nothing
FormStream.Close()
Set FormStream=nothing
FormD.RemoveAll
Set FormD=nothing
End Sub
Public Sub Open()
Dim RequestSize,RequestData
RequestSize=Request.TotalBytes
if RequestSize<1 then
Err=4
Exit Sub
end if
RequestData=Request.BinaryRead(RequestSize)
Dim FormSize,CrLf,bCrLf,ListSeparator,LenListSep,FormData
FormStream.Type = 1
FormStream.Open
FormStream.Write RequestData
FormSize=FormStream.Size
bCrLf=ChrB(13)&ChrB(10)
Separator=MidB(RequestData,1,InstrB(1,RequestData,bCrLf)-1)
Dim pStart,pEnd,pTemp,ItemInfo,ItemName,ItemData
pStart=LenB(Separator)+2
Do
pEnd = InStrB (pStart,RequestData,bCrLf&bCrLf)+3
ItemStream.Type=1
ItemStream.Open
FormStream.Position=pStart
FormStream.CopyTo ItemStream,pEnd-pStart
ItemStream.Position=0
ItemStream.Type=2
ItemStream.Charset="gb2312"
ItemInfo=ItemStream.ReadText
ItemStream.Close()
pStart=pEnd
pEnd = InStrB (pStart,RequestData,Separator)-1
ItemStream.Type=1
ItemStream.Open
FormStream.Position=pStart
FormStream.CopyTo ItemStream,pEnd-pStart-2
ItemName=Mid(ItemInfo,39,Instr(39,ItemInfo,"""")-39)
if Instr(40,ItemInfo,"filename=""")>0 then
if ItemStream.Size<>0 then
Dim SourceFile,TargetFile
pTemp=52+Len(ItemName)
SourceFile=Mid(ItemInfo,pTemp,Instr(pTemp,ItemInfo,"""")-pTemp)
FormD.Add ItemName&"_Type",Mid(ItemInfo,Instr(pTemp,ItemInfo,"Content-Type: ")+14)
FormD.Add ItemName&"_Name",Mid(SourceFile,InstrRev(SourceFile,"/")+1)
FormD.Add ItemName&"_Path",Left(SourceFile,InstrRev(SourceFile,"/"))
if InstrRev(SourceFile,".")<>0 then
FormD.Add ItemName&"_Ext",Mid(SourceFile,InstrRev(SourceFile,".")+1)
else
FormD.Add ItemName&"_Ext",""
end if
FormD.Add ItemName&"_From",pStart
FormD.Add ItemName&"_Size",ItemStream.Size
FormD.Add ItemName&"_Err",0
if Instr(1,LCase("/"&FileType&"/"),LCase("/"&FormD(ItemName&"_Ext")&"/"))=0 then
if Err<2 then Err=Err+2
FormD(ItemName&"_Err")=FormD(ItemName&"_Err")+2
end if
if FormD(ItemName&"_Size")>MaxSize then
if Err<1 then Err=Err+1
FormD(ItemName&"_Err")=FormD(ItemName&"_Err")+1
end if
if FormD(ItemName&"_Err")=0 then
if AutoSave then
tarFileName=GetTimeStr()
if FormD(ItemName&"_Ext")<>"" then tarFileName=tarFileName&"."&FormD(ItemName&"_Ext")
FormD.Add ItemName,tarFileName
ItemStream.SaveToFile Server.MapPath(SavePath&tarFileName),2
else
FormD.Add ItemName,"Please save first"
end if
end if
else
FormD.Add ItemName,""
end if
else
ItemStream.Position=0
ItemStream.Type=2
ItemStream.Charset="gb2312"
ItemData=ItemStream.ReadText
if FormD.Exists(ItemName) then
FormD(ItemName) = FormD (ItemName)&","&ItemData
else
FormD.Add ItemName,ItemData
end if
end if
ItemStream.Close()
pStart = pEnd+LenB(Separator)+2
loop Until pStart+3>FormSize
End Sub
Public Function GetTimeStr()
GetTimeStr=Cstr(Date())&FormatNumber(Timer()*1000,0)
GetTimeStr=replace(replace(GetTimeStr,"-",""),",","")
End Function
Public Sub Save(Item,FileName)
if Not AutoSave and FormD.Exists(Item&"_From") then
if FormD(Item&"_Err")<>0 then
FormD(Item)=""
Exit Sub
End if
ItemStream.Type = 1
ItemStream.Open
FormStream.Position = FormD(Item&"_From")
FormStream.CopyTo ItemStream,FormD(Item&"_Size")
ItemStream.SaveToFile Server.MapPath(SavePath&FileName),2
ItemStream.Close()
FormD(Item)=FileName
end if
End Sub
Public Function GetData(Item)
GetData=""
if FormD.Exists(Item&"_From") then
if FormD(Item&"_Err")<>0 then Exit Function
FormStream.Position = FormD(Item&"_From")
GetData=FormStream.Read(FormD(Item&"_Size"))
end if
End Function
Public Function Form(Item)
if FormD.Exists(Item) then
Form=FormD(Item)
else
Form=""
end if
End Function
Public Function QueryString(Item)
QueryString=request.QueryString(Item)
End Function
Public Function Version()
Version=Ver
End Function
Public Function Error()
Error=Err
End Function
End Class
%>
2.生成数字图片（验证码）
<%
Class UpLoadClass
Private Ver,Err,FormD,FormStream,ItemStream
Dim MaxSize,FileType,SavePath,AutoSave
Private Sub Class_Initialize
MaxSize=150*1024
FileType="jpg/gif"
SavePath="UpLoadFile/"
AutoSave=true
Ver ="Rumor UpLoadClass Version 1.02"
Err=0
Set FormD = Server.CreateObject ("Scripting.Dictionary")
FormD.CompareMode = 1
Set FormStream=server.CreateObject("ADODB.Stream")
Set ItemStream=server.CreateObject("ADODB.Stream")
End Sub
Private Sub Class_Terminate
Set ItemStream=nothing
FormStream.Close()
Set FormStream=nothing
FormD.RemoveAll
Set FormD=nothing
End Sub
Public Sub Open()
Dim RequestSize,RequestData
RequestSize=Request.TotalBytes
if RequestSize<1 then
Err=4
Exit Sub
end if
RequestData=Request.BinaryRead(RequestSize)
Dim FormSize,CrLf,bCrLf,ListSeparator,LenListSep,FormData
FormStream.Type = 1
FormStream.Open
FormStream.Write RequestData
FormSize=FormStream.Size
bCrLf=ChrB(13)&ChrB(10)
Separator=MidB(RequestData,1,InstrB(1,RequestData,bCrLf)-1)
Dim pStart,pEnd,pTemp,ItemInfo,ItemName,ItemData
pStart=LenB(Separator)+2
Do
pEnd = InStrB (pStart,RequestData,bCrLf&bCrLf)+3
ItemStream.Type=1
ItemStream.Open
FormStream.Position=pStart
FormStream.CopyTo ItemStream,pEnd-pStart
ItemStream.Position=0
ItemStream.Type=2
ItemStream.Charset="gb2312"
ItemInfo=ItemStream.ReadText
ItemStream.Close()
pStart=pEnd
pEnd = InStrB (pStart,RequestData,Separator)-1
ItemStream.Type=1
ItemStream.Open
FormStream.Position=pStart
FormStream.CopyTo ItemStream,pEnd-pStart-2
ItemName=Mid(ItemInfo,39,Instr(39,ItemInfo,"""")-39)
if Instr(40,ItemInfo,"filename=""")>0 then
if ItemStream.Size<>0 then
Dim SourceFile,TargetFile
pTemp=52+Len(ItemName)
SourceFile=Mid(ItemInfo,pTemp,Instr(pTemp,ItemInfo,"""")-pTemp)
FormD.Add ItemName&"_Type",Mid(ItemInfo,Instr(pTemp,ItemInfo,"Content-Type: ")+14)
FormD.Add ItemName&"_Name",Mid(SourceFile,InstrRev(SourceFile,"/")+1)
FormD.Add ItemName&"_Path",Left(SourceFile,InstrRev(SourceFile,"/"))
if InstrRev(SourceFile,".")<>0 then
FormD.Add ItemName&"_Ext",Mid(SourceFile,InstrRev(SourceFile,".")+1)
else
FormD.Add ItemName&"_Ext",""
end if
FormD.Add ItemName&"_From",pStart
FormD.Add ItemName&"_Size",ItemStream.Size
FormD.Add ItemName&"_Err",0
if Instr(1,LCase("/"&FileType&"/"),LCase("/"&FormD(ItemName&"_Ext")&"/"))=0 then
if Err<2 then Err=Err+2
FormD(ItemName&"_Err")=FormD(ItemName&"_Err")+2
end if
if FormD(ItemName&"_Size")>MaxSize then
if Err<1 then Err=Err+1
FormD(ItemName&"_Err")=FormD(ItemName&"_Err")+1
end if
if FormD(ItemName&"_Err")=0 then
if AutoSave then
tarFileName=GetTimeStr()
if FormD(ItemName&"_Ext")<>"" then tarFileName=tarFileName&"."&FormD(ItemName&"_Ext")
FormD.Add ItemName,tarFileName
ItemStream.SaveToFile Server.MapPath(SavePath&tarFileName),2
else
FormD.Add ItemName,"Please save first"
end if
end if
else
FormD.Add ItemName,""
end if
else
ItemStream.Position=0
ItemStream.Type=2
ItemStream.Charset="gb2312"
ItemData=ItemStream.ReadText
if FormD.Exists(ItemName) then
FormD(ItemName) = FormD (ItemName)&","&ItemData
else
FormD.Add ItemName,ItemData
end if
end if
ItemStream.Close()
pStart = pEnd+LenB(Separator)+2
loop Until pStart+3>FormSize
End Sub
Public Function GetTimeStr()
GetTimeStr=Cstr(Date())&FormatNumber(Timer()*1000,0)
GetTimeStr=replace(replace(GetTimeStr,"-",""),",","")
End Function
Public Sub Save(Item,FileName)
if Not AutoSave and FormD.Exists(Item&"_From") then
if FormD(Item&"_Err")<>0 then
FormD(Item)=""
Exit Sub
End if
ItemStream.Type = 1
ItemStream.Open
FormStream.Position = FormD(Item&"_From")
FormStream.CopyTo ItemStream,FormD(Item&"_Size")
ItemStream.SaveToFile Server.MapPath(SavePath&FileName),2
ItemStream.Close()
FormD(Item)=FileName
end if
End Sub
Public Function GetData(Item)
GetData=""
if FormD.Exists(Item&"_From") then
if FormD(Item&"_Err")<>0 then Exit Function
FormStream.Position = FormD(Item&"_From")
GetData=FormStream.Read(FormD(Item&"_Size"))
end if
End Function
Public Function Form(Item)
if FormD.Exists(Item) then
Form=FormD(Item)
else
Form=""
end if
End Function
Public Function QueryString(Item)
QueryString=request.QueryString(Item)
End Function
Public Function Version()
Version=Ver
End Function
Public Function Error()
Error=Err
End Function
End Class
%>
3.文字转拼音
<%
Set d = CreateObject("Scripting.Dictionary")
d.add "a",-20319
d.add "ai",-20317
d.add "an",-20304
d.add "ang",-20295
d.add "ao",-20292
d.add "ba",-20283
d.add "bai",-20265
d.add "ban",-20257
d.add "bang",-20242
d.add "bao",-20230
d.add "bei",-20051
d.add "ben",-20036
d.add "beng",-20032
d.add "bi",-20026
d.add "bian",-20002
d.add "biao",-19990
d.add "bie",-19986
d.add "bin",-19982
d.add "bing",-19976
d.add "bo",-19805
d.add "bu",-19784
d.add "ca",-19775
d.add "cai",-19774
d.add "can",-19763
d.add "cang",-19756
d.add "cao",-19751
d.add "ce",-19746
d.add "ceng",-19741
d.add "cha",-19739
d.add "chai",-19728
d.add "chan",-19725
d.add "chang",-19715
d.add "chao",-19540
d.add "che",-19531
d.add "chen",-19525
d.add "cheng",-19515
d.add "chi",-19500
d.add "chong",-19484
d.add "chou",-19479
d.add "chu",-19467
d.add "chuai",-19289
d.add "chuan",-19288
d.add "chuang",-19281
d.add "chui",-19275
d.add "chun",-19270
d.add "chuo",-19263
d.add "ci",-19261
d.add "cong",-19249
d.add "cou",-19243
d.add "cu",-19242
d.add "cuan",-19238
d.add "cui",-19235
d.add "cun",-19227
d.add "cuo",-19224
d.add "da",-19218
d.add "dai",-19212
d.add "dan",-19038
d.add "dang",-19023
d.add "dao",-19018
d.add "de",-19006
d.add "deng",-19003
d.add "di",-18996
d.add "dian",-18977
d.add "diao",-18961
d.add "die",-18952
d.add "ding",-18783
d.add "diu",-18774
d.add "dong",-18773
d.add "dou",-18763
d.add "du",-18756
d.add "duan",-18741
d.add "dui",-18735
d.add "dun",-18731
d.add "duo",-18722
d.add "e",-18710
d.add "en",-18697
d.add "er",-18696
d.add "fa",-18526
d.add "fan",-18518
d.add "fang",-18501
d.add "fei",-18490
d.add "fen",-18478
d.add "feng",-18463
d.add "fo",-18448
d.add "fou",-18447
d.add "fu",-18446
d.add "ga",-18239
d.add "gai",-18237
d.add "gan",-18231
d.add "gang",-18220
d.add "gao",-18211
d.add "ge",-18201
d.add "gei",-18184
d.add "gen",-18183
d.add "geng",-18181
d.add "gong",-18012
d.add "gou",-17997
d.add "gu",-17988
d.add "gua",-17970
d.add "guai",-17964
d.add "guan",-17961
d.add "guang",-17950
d.add "gui",-17947
d.add "gun",-17931
d.add "guo",-17928
d.add "ha",-17922
d.add "hai",-17759
d.add "han",-17752
d.add "hang",-17733
d.add "hao",-17730
d.add "he",-17721
d.add "hei",-17703
d.add "hen",-17701
d.add "heng",-17697
d.add "hong",-17692
d.add "hou",-17683
d.add "hu",-17676
d.add "hua",-17496
d.add "huai",-17487
d.add "huan",-17482
d.add "huang",-17468
d.add "hui",-17454
d.add "hun",-17433
d.add "huo",-17427
d.add "ji",-17417
d.add "jia",-17202
d.add "jian",-17185
d.add "jiang",-16983
d.add "jiao",-16970
d.add "jie",-16942
d.add "jin",-16915
d.add "jing",-16733
d.add "jiong",-16708
d.add "jiu",-16706
d.add "ju",-16689
d.add "juan",-16664
d.add "jue",-16657
d.add "jun",-16647
d.add "ka",-16474
d.add "kai",-16470
d.add "kan",-16465
d.add "kang",-16459
d.add "kao",-16452
d.add "ke",-16448
d.add "ken",-16433
d.add "keng",-16429
d.add "kong",-16427
d.add "kou",-16423
d.add "ku",-16419
d.add "kua",-16412
d.add "kuai",-16407
d.add "kuan",-16403
d.add "kuang",-16401
d.add "kui",-16393
d.add "kun",-16220
d.add "kuo",-16216
d.add "la",-16212
d.add "lai",-16205
d.add "lan",-16202
d.add "lang",-16187
d.add "lao",-16180
d.add "le",-16171
d.add "lei",-16169
d.add "leng",-16158
d.add "li",-16155
d.add "lia",-15959
d.add "lian",-15958
d.add "liang",-15944
d.add "liao",-15933
d.add "lie",-15920
d.add "lin",-15915
d.add "ling",-15903
d.add "liu",-15889
d.add "long",-15878
d.add "lou",-15707
d.add "lu",-15701
d.add "lv",-15681
d.add "luan",-15667
d.add "lue",-15661
d.add "lun",-15659
d.add "luo",-15652
d.add "ma",-15640
d.add "mai",-15631
d.add "man",-15625
d.add "mang",-15454
d.add "mao",-15448
d.add "me",-15436
d.add "mei",-15435
d.add "men",-15419
d.add "meng",-15416
d.add "mi",-15408
d.add "mian",-15394
d.add "miao",-15385
d.add "mie",-15377
d.add "min",-15375
d.add "ming",-15369
d.add "miu",-15363
d.add "mo",-15362
d.add "mou",-15183
d.add "mu",-15180
d.add "na",-15165
d.add "nai",-15158
d.add "nan",-15153
d.add "nang",-15150
d.add "nao",-15149
d.add "ne",-15144
d.add "nei",-15143
d.add "nen",-15141
d.add "neng",-15140
d.add "ni",-15139
d.add "nian",-15128
d.add "niang",-15121
d.add "niao",-15119
d.add "nie",-15117
d.add "nin",-15110
d.add "ning",-15109
d.add "niu",-14941
d.add "nong",-14937
d.add "nu",-14933
d.add "nv",-14930
d.add "nuan",-14929
d.add "nue",-14928
d.add "nuo",-14926
d.add "o",-14922
d.add "ou",-14921
d.add "pa",-14914
d.add "pai",-14908
d.add "pan",-14902
d.add "pang",-14894
d.add "pao",-14889
d.add "pei",-14882
d.add "pen",-14873
d.add "peng",-14871
d.add "pi",-14857
d.add "pian",-14678
d.add "piao",-14674
d.add "pie",-14670
d.add "pin",-14668
d.add "ping",-14663
d.add "po",-14654
d.add "pu",-14645
d.add "qi",-14630
d.add "qia",-14594
d.add "qian",-14429
d.add "qiang",-14407
d.add "qiao",-14399
d.add "qie",-14384
d.add "qin",-14379
d.add "qing",-14368
d.add "qiong",-14355
d.add "qiu",-14353
d.add "qu",-14345
d.add "quan",-14170
d.add "que",-14159
d.add "qun",-14151
d.add "ran",-14149
d.add "rang",-14145
d.add "rao",-14140
d.add "re",-14137
d.add "ren",-14135
d.add "reng",-14125
d.add "ri",-14123
d.add "rong",-14122
d.add "rou",-14112
d.add "ru",-14109
d.add "ruan",-14099
d.add "rui",-14097
d.add "run",-14094
d.add "ruo",-14092
d.add "sa",-14090
d.add "sai",-14087
d.add "san",-14083
d.add "sang",-13917
d.add "sao",-13914
d.add "se",-13910
d.add "sen",-13907
d.add "seng",-13906
d.add "sha",-13905
d.add "shai",-13896
d.add "shan",-13894
d.add "shang",-13878
d.add "shao",-13870
d.add "she",-13859
d.add "shen",-13847
d.add "sheng",-13831
d.add "shi",-13658
d.add "shou",-13611
d.add "shu",-13601
d.add "shua",-13406
d.add "shuai",-13404
d.add "shuan",-13400
d.add "shuang",-13398
d.add "shui",-13395
d.add "shun",-13391
d.add "shuo",-13387
d.add "si",-13383
d.add "song",-13367
d.add "sou",-13359
d.add "su",-13356
d.add "suan",-13343
d.add "sui",-13340
d.add "sun",-13329
d.add "suo",-13326
d.add "ta",-13318
d.add "tai",-13147
d.add "tan",-13138
d.add "tang",-13120
d.add "tao",-13107
d.add "te",-13096
d.add "teng",-13095
d.add "ti",-13091
d.add "tian",-13076
d.add "tiao",-13068
d.add "tie",-13063
d.add "ting",-13060
d.add "tong",-12888
d.add "tou",-12875
d.add "tu",-12871
d.add "tuan",-12860
d.add "tui",-12858
d.add "tun",-12852
d.add "tuo",-12849
d.add "wa",-12838
d.add "wai",-12831
d.add "wan",-12829
d.add "wang",-12812
d.add "wei",-12802
d.add "wen",-12607
d.add "weng",-12597
d.add "wo",-12594
d.add "wu",-12585
d.add "xi",-12556
d.add "xia",-12359
d.add "xian",-12346
d.add "xiang",-12320
d.add "xiao",-12300
d.add "xie",-12120
d.add "xin",-12099
d.add "xing",-12089
d.add "xiong",-12074
d.add "xiu",-12067
d.add "xu",-12058
d.add "xuan",-12039
d.add "xue",-11867
d.add "xun",-11861
d.add "ya",-11847
d.add "yan",-11831
d.add "yang",-11798
d.add "yao",-11781
d.add "ye",-11604
d.add "yi",-11589
d.add "yin",-11536
d.add "ying",-11358
d.add "yo",-11340
d.add "yong",-11339
d.add "you",-11324
d.add "yu",-11303
d.add "yuan",-11097
d.add "yue",-11077
d.add "yun",-11067
d.add "za",-11055
d.add "zai",-11052
d.add "zan",-11045
d.add "zang",-11041
d.add "zao",-11038
d.add "ze",-11024
d.add "zei",-11020
d.add "zen",-11019
d.add "zeng",-11018
d.add "zha",-11014
d.add "zhai",-10838
d.add "zhan",-10832
d.add "zhang",-10815
d.add "zhao",-10800
d.add "zhe",-10790
d.add "zhen",-10780
d.add "zheng",-10764
d.add "zhi",-10587
d.add "zhong",-10544
d.add "zhou",-10533
d.add "zhu",-10519
d.add "zhua",-10331
d.add "zhuai",-10329
d.add "zhuan",-10328
d.add "zhuang",-10322
d.add "zhui",-10315
d.add "zhun",-10309
d.add "zhuo",-10307
d.add "zi",-10296
d.add "zong",-10281
d.add "zou",-10274
d.add "zu",-10270
d.add "zuan",-10262
d.add "zui",-10260
d.add "zun",-10256
d.add "zuo",-10254
function g(num)
if num>0 and num<160 then
g=chr(num)
else
if num<-20319 or num>-10247 then
g=""
else
a=d.Items
b=d.keys
for i=d.count-1 to 0 step -1
if a(i)<=num then exit for
next
g=b(i)
end if
end if
end function
function c(str)
c=""
for i=1 to len(str)
c=c&g(asc(mid(str,i,1)))&" "
next
end function
%>
4.群发数据库中EMAIL （必选先安装JMail44_free.exe）
<%
Dim db, strConn
strConn="Dbq=" & Server.Mappath("address.mdb") & ";Driver={Microsoft Access Driver (*.mdb)}"
Set db=Server.CreateObject("ADODB.Connection")
db.Open strConn '以下建立Recordset对象实例rs
Dim strSql,rs,aa
strSql="select top 1 * from bbb where fid = 0"
Set rs=db.Execute(strSql)
if rs.bof and rs.eof then
'Response.Write("邮件全部发送完毕！！")
%>
<script>
alert('Email全部发送成功!')
window.history.go(-1)
</script>
<%
else
set aa=rs("email")
Dim Jmail
Set Jmail = Server.CreateObject("Jmail.Message")
dim bb,cc
uname = rs("uname")
bb=""
'bb为邮件内容，为html代码，其中格式必须为一行，"要用""替代
Jmail.silent=true
Jmail.logging=true
Jmail.charset="gb2312"
Jmail.contenttype="text/html"
Jmail.AddRecipient aa
Jmail.From = "rbk_20068@126.com"
Jmail.FromName = ""
Jmail.Subject = ""
Jmail.priority=3
Jmail.body=bb
'Jmail.Body = Request("body")
'Jmail.AddAttachment "C:/Inetpub/wwwroot/music.mid" '附件
Jmail.send("rbk_20068:123456@smtp.126.com") '执行发送
Jmail.Close '关闭对象
'Response.Write "成功发送"
%>
<%=rs("email")%>已经发送！
<%
dim sql1,rs1
sql1="update bbb set fid = 1 where email = '"&aa&"'"
set rs1=db.Execute(sql1)
End if
%>
5.重命名文件
<!--#include file="conn.asp"-->
<%
strSql="select * from 123 "
Set rs=db.Execute(strSql)
do while not rs.eof
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set f = fso.GetFile("E:/pic/"&rs("upix_name")&"")
f.name =""&rs("urelname")&".jpg"
newname=f.name
response.write newname
rs.movenext
loop
%>
6.自动生成html页面
<!--#include file="conn.asp"-->
<%
function chan_time(shijian)'转换日期时间函数
s_year=year(shijian)
if len(s_year)=2 then s_year="20"&s_year
s_month=month(shijian)
if s_month<10 then s_month="0"&s_month
s_day=day(shijian)
if s_day<10 then s_day="0"&s_day
s_hour=hour(shijian)
if s_hour<10 then s_hour="0"&s_hour
s_minute=minute(shijian)
if s_minute<10 then s_minute="0"&s_minute
chan_time=s_year & s_month & s_day & s_hour & s_minute
end function
function chan_data(shijian) '转换日期时间函数
s_year=year(shijian)
if len(s_year)=2 then s_year="20"&s_year
s_month=month(shijian)
if s_month<10 then s_month="0"&s_month
s_day=day(shijian)
if s_day<10 then s_day="0"&s_day
chan_data=s_year & s_month & s_day
end function
function chan_file(shijian)'转换日期时间函数
s_month=month(shijian)
if s_month<10 then s_month="0"&s_month
s_day=day(shijian)
if s_day<10 then s_day="0"&s_day
s_hour=hour(shijian)
if s_hour<10 then s_hour="0"&s_hour
s_minute=minute(shijian)
if s_minute<10 then s_minute="0"&s_minute
s_ss=second(shijian)
if s_ss<10 then s_ss="0"&s_ss
chan_file = s_month & s_day & s_hour & s_minute & s_ss
end function
top="<html><head><title>news</title></head><body>"
botom="</body></html>"
msg1=request.Form("msg")
uname=request.Form("uname")
msg1=replace(msg1,vbcrlf,"")
msg1=replace(msg1,chr(9),"")
msg1=replace(msg1," "," ")
msg1=replace(msg1,"/r/n","<br>")
msg1=replace(msg1,"/n","<br>")
msg=top&uname&msg1&botom
Set fs=Server.CreateObject("Scripting.FileSystemObject")
all_tree2=server.mappath("news")&"/"&chan_data(now)
if (fs.FolderExists(all_tree2)) then'判断今天的文件夹是否存在
else
fs.CreateFolder(all_tree2)
end if
pass=chan_file(now)
randomize '使用系统计时器来初始化乱数产生器
pass=rnd(pass)
pass=get_pass(pass)
pass=left(pass,10)
file1=pass
files=file1&".txt"
filez=all_tree2&"/"&files
set ts = fs.createtextfile(filez,true) '写文件
for z=1 to len(msg)
write_now=mid(msg,z,1)
ts.write(write_now)
next
' ts.writeline(all_msg)
ts.close
set ts=nothing '文件生成
if err.number<>0 or err then%>
<script language="javascript">
alert("不能完成")
</script>
<%else%>
<script language="javascript">
alert("已完成")
history.back();
</script>
<%end if
Set MyFile = fs.GetFile(filez)
all_tree2=server.mappath("news")&"/"&chan_data(now)
if (fs.FolderExists(all_tree2)) then
else
fs.CreateFolder(all_tree2)
end if
aaa=left(MyFile.name,len(MyFile.name)-4)
MyFile.name= aaa&".html"
bbb="news/"&chan_data(now)&"/" &MyFile.name
set rs=db.execute("insert into news(uname,uot,ulink) values ('"&uname&"','"&msg1&"','"&bbb&"')")
set MyFile=nothing
set fs=nothing
set fdir=nothing
function get_pass(pass)
pass=cstr(pass)
pass=replace(pass," ","")
pass=replace(pass," ","")
pass=replace(pass,"-","")
pass=replace(pass," ","")
pass=replace(pass,":","")
pass=replace(pass,".","")
pass=replace(pass,"+","")
pass=replace(pass,"_","")
pass=replace(pass,"<","")
pass=replace(pass,">","")
pass=replace(pass,"!","")
pass=replace(pass,"@","")
pass=replace(pass,"#","")
pass=replace(pass,"$","")
pass=replace(pass,"%","")
pass=replace(pass,"^","")
pass=replace(pass,"&","")
pass=replace(pass,"*","")
pass=replace(pass,"(","")
pass=replace(pass,")","")
pass=replace(pass,"=","")
pass=replace(pass,"/","")
pass=replace(pass,"/","")
pass=replace(pass,"|","")
get_pass=pass
end function
%>
7.Excel文件导入数据库
sql = "SELECT * into temp FROM OpenDataSource( 'Microsoft.Jet.OLEDB.4.0','Data Source="&xlsname&";Extended properties=Excel 5.0')...[Sheet1$] "
'sql数据库将生成一个表名为temp的新表
8.数据库导出Excel文件
<!--#include file="conn.asp"-->
<%
dim tablename,filetype,fieldPid
uno = request.Form("uno")
if uno = "wrong" then
tablename = "信息错误会员名单"
sql = "Select ExchangeID as 编号,CounterID as 柜台号,CustomerName as 姓名,CustomerId as 卡号,telephone as 电话,TotalOfExchangeTransactions as 兑换总量,QuantityofExchangeTransactions as 兑换质量,DateOfExchange as 兑换日期,Usedpoints as 积分点数,province as 省份,city as 城市,address as 联系地址,zip as 邮编,udate as 输入日期 from vip_wrong"
end if
filetype = "scv"
fieldPid = request("pid")
if fieldPid = "" then
fieldPid = "id"
end if
fieldPid = lcase(fieldPid)
if lcase(left(sql,6))<>"select" then
Response.write "sql语句必须为select * from [table] where ......."
Response.end
end if
if tablename = "" then
tablename = "数据导出结果"
end if
function HTMLEncode(fString)
if not isnull(fString) then
fString = Server.HTMLEncode(fString)
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
fString = Replace(fString, CHR(9), " ")
HTMLEncode = fString
end if
end function
function Myreplace(str)
if not isnull(str) then
fString = Replace(fString,"""", """""")
Myreplace = str
else
Myreplace = ""
end if
end function
function Myreplace2(str)
if not isnull(str) then
fString = Replace(fString,"'", "''")
Myreplace2 = str
else
Myreplace2 = ""
end if
end function
dim def_export_sep,def_export_val
def_export_sep = " "
def_export_val = """"
Set rs = Conn.Execute(sql)
Response.contenttype="xls"
Response.AddHeader "Content-Disposition", "attachment;filename="&tablename&".xls"
strLine=""
For each x in rs.fields
strLine= strLine & def_export_val & x.name & def_export_val & def_export_sep
Next
Response.write strLine & vbnewline
While rs.EOF =false
strLine= ""
For each x in rs.fields
strLine= strLine & def_export_val & Myreplace(x.value) & def_export_val & def_export_sep
Next
rs.MoveNext
Response.write strLine & vbnewline
Wend
%>
04-11
01-20
1220
“相关推荐”对你有帮助么？
-
非常没帮助 -
没帮助 -
一般 -
有帮助 -
非常有帮助
提交
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
