ASP的自定义实用函数表(1)
时间：2010-04-30 来源：mx11
'汉字判断
function isChinese(para)
on error resume next
if isNUll(para) then
isChinese=false
exit function
end if
if trim(para)="" then
isChinese=false
exit function
end if
dim c
for i=1 to len(para)
c=asc(mid(para,i,1))
if c>=0 then
isChinese=false
exit function
end if
next
isChinese=true
if err.number<>0 then err.clear
end function
%>
如：
if not isChinese(request("name")) then
errmsg=errmsg+"
"+"<li>用户名应为汉字"
founderr=true
else
username=trim(request("name"))
end if
----------------------------------------------
'替换指定文件内字符串的函数
<%
function FSOlineedit(filename,Target,String)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FiletempData = objCountFile.ReadAll
objCountFile.Close
FiletempData=Replace(FiletempData,Target,String)
Set objCountFile=objFSO.CreateTextFile(Server.MapPath(filename),True)
objCountFile.Write FiletempData
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
response.write FSOlineedit("test.txt","世界","明天是一个好天去")
%>
----------------------------------------------
'获取中文字符串拼音首字母串的函数
<%
response.write "<link href=style.css rel=stylesheet>"
if request.form("content")="" then
response.write "<center><form method=post action=asd.asp><input name=content type=text>__<input type=submit></form>"
else
function getpychar(char)
tmp=65536+asc(char)
if(tmp>=45217 and tmp<=45252) then
getpychar= "A"
elseif(tmp>=45253 and tmp<=45760) then
getpychar= "B"
elseif(tmp>=45761 and tmp<=46317) then
getpychar= "C"
elseif(tmp>=46318 and tmp<=46825) then
getpychar= "D"
elseif(tmp>=46826 and tmp<=47009) then
getpychar= "E"
elseif(tmp>=47010 and tmp<=47296) then
getpychar= "F"
elseif(tmp>=47297 and tmp<=47613) then
getpychar= "G"
elseif(tmp>=47614 and tmp<=48118) then
getpychar= "H"
elseif(tmp>=48119 and tmp<=49061) then
getpychar= "J"
elseif(tmp>=49062 and tmp<=49323) then
getpychar= "K"
elseif(tmp>=49324 and tmp<=49895) then
getpychar= "L"
elseif(tmp>=49896 and tmp<=50370) then
getpychar= "M"
elseif(tmp>=50371 and tmp<=50613) then
getpychar= "N"
elseif(tmp>=50614 and tmp<=50621) then
getpychar= "O"
elseif(tmp>=50622 and tmp<=50905) then
getpychar= "P"
elseif(tmp>=50906 and tmp<=51386) then
getpychar= "Q"
elseif(tmp>=51387 and tmp<=51445) then
getpychar= "R"
elseif(tmp>=51446 and tmp<=52217) then
getpychar= "S"
elseif(tmp>=52218 and tmp<=52697) then
getpychar= "T"
elseif(tmp>=52698 and tmp<=52979) then
getpychar= "W"
elseif(tmp>=52980 and tmp<=53640) then
getpychar= "X"
elseif(tmp>=53689 and tmp<=54480) then
getpychar= "Y"
elseif(tmp>=54481 and tmp<=62289) then
getpychar= "Z"
else '如果不是中文，则不处理
getpychar=char
end if
end function
function getpy(str)
for i=1 to len(str)
getpy=getpy&getpychar(mid(str,i,1))
next
end function
content=request.form("content")
response.write "<center>"&getpy(content)&chr(10)
response.write "<br><br><br><a href=# onclick=javascript:history.go(-1)>返回</a>"
end if
%>
--------------------------------------------
ip限制函数
'******************************
'Function CheckIp(cInput_Ip,cBound_Ip)
'Created by qqdao, [email protected] 2001/11/28
'说明：首先需要根据;号循环，然后判断是否含有"-"，如果有则进行拆分处理，最后判断是否在范围内
'参数： cInput_Ip,代检查的ip
' cBound_Ip,给定的范围格式为,单个ip,和范围ip，范围ip最后使用”-“分割，如果是“*”则必须放到最后一位
' 每个范围后添加":ALLOW"表示允许登陆，添加":REFUSE"表示拒绝登陆。多个范围用”;“隔开
' 例如192.168.1*.*:ALLOW;192.168.1.1:ALLOW;192.168.1.1-10:REFUSE"
'返回值: true/false
'更新：2001/12/05 支持ALLOW,REFUSE支持’*‘,不想对？支持，因为和*差不多
'******************************
function CheckIp(cInput_Ip,cBound_Ip)
dim cSingle_Ip,cTemp_IP,cStart_IP,cEnd_Ip
CheckIp = false
cSingle_Ip=split(cBound_Ip,";")
for i=0 to ubound(cSingle_Ip)
if Instr(cSingle_Ip(i),"REFUSE") <> 0 then '就是拒绝了
cTemp_IP = left(cSingle_Ip(i),instr(cSingle_Ip(i),":")-1)
if Instr(cTemp_IP,"*") <> 0 then '是宽范围
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1)
if left(cInput_Ip,len(cStart_IP))=cStart_IP then
CheckIp = false
exit function
end if
end if
if Instr(cTemp_IP,"-") = 0 then
cStart_IP = cTemp_IP
cEnd_Ip = cTemp_IP
else
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1)
cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1)
end if
if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then
CheckIp = false
exit function
end if
elseif Instr(cSingle_Ip(i),"ALLOW") <> 0 then '允许
cTemp_IP = left(cSingle_Ip(i),instr(cSingle_Ip(i),":")-1)
if Instr(cTemp_IP,"*") <> 0 then '是宽范围
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1)
if left(cInput_Ip,len(cStart_IP))=cStart_IP then
CheckIp = true
end if
end if
if Instr(cTemp_IP,"-") = 0 then
cStart_IP = cTemp_IP
cEnd_Ip = cTemp_IP
else
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1)
cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1)
end if
if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then
CheckIp =true
else
CheckIp =false
end if
end if
next
end function
'******************************
'Function Ip2Str(cIp)
'Created by qqdao, [email protected] 2001/11/28
'参考动网ip算法
'参数：cIp ip地址
'返回值: 转换后数值
'******************************
function Ip2Str(cIp)
Dim str1,str2,str3,str4
Dim cIp_Temp
if cIp="127.0.0.1" then cIp="192.168.0.1"
str1=left(cIp,instr(cIp,".")-1)
cIp_Temp=mid(cIp,instr(cIp,".")+1)
str2=left(cIp_Temp,instr(cIp_Temp,".")-1)
cIp_Temp=mid(cIp_Temp,instr(cIp_Temp,".")+1)
str3=left(cIp_Temp,instr(cIp_Temp,".")-1)
str4=mid(cIp_Temp,instr(cIp_Temp,".")+1)
if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then
else
Ip2Str=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
end if
end function
'代码调用演示
if CheckIp("192.168.1.1","192.168.1.*:REFUSE") then
response.write "登陆成功"
else
response.write "您的ip不被允许"
end if
cinput_ip就是要检查的ip，也就是Request.ServerVariables("REMOTE_ADDR")
cbound_ip是范围，可以存到库里，范围的写法，我已详细说明了。
----------------------------------------------
汉字转化为拼音
很多问题都是因为中文问题造成的
如文件名最好别用中文
现在的解决方法一般是产生一个ID,将这个ID做文件名
网页上如果url带汉字也经常出错
现在的解决方法一般用urlencode编码
现在用了这个转化，就好多了
原理，使用Dictionary技术
1.添加索引
2.遍历词典
<%
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
response.write c(request("hz"))
%>
<form method=post>
请在此处输入中文：<input name=hz>
----------------------------------------
一个非常简单的将半角"转换为中文“的函数
function new_str(str)
if instr(str,chr(34))<>0 and str<>"" then
str_split=split(str,chr(34))
i=1
str_s=""
for j=0 to ubound(str_split)-1
if i mod 2 then
str_s=str_s&str_split(j)&"“"&str_split(j+1)
else
str_s=str_s&str_split(j)&"”"&str_split(j+1)
end if
i=i+1
next
end function
-----------------------------------------
货币大写转换函数的更新
<%
dim a '要转换成大写的金额
dim atoc '转换之后的值
Dim String1 '如下定义
Dim String2 '如下定义
Dim String3 '从原A值中取出的值
Dim I '循环变量
Dim J 'A的值乘以100的字符串长度
Dim Ch1 '数字的汉语读法
Dim Ch2 '数字位的汉字读法
Dim nZero '用来计算连续的零值是几个
String1 = "零壹贰叁肆伍陆柒捌玖"
String2 = "万仟佰拾亿仟佰拾万仟佰拾元角分"
nZero = 0
If InStr(1, CStr(a * 100), ".") <> 0 Then
err.Raise 5000, , "此函数( AtoC() )只能转换小数点后有两位以内的数！"
End If
J = Len(CStr(a * 100))
String2 = Right(String2, J) '取出对应位数的STRING2的值
For I = 1 To J
String3 = Mid(a * 100, I, 1) '取出需转换的某一位的值
If I <> (J - 3) + 1 And I <> (J - 7) + 1 And I <> (J - 11) + 1 And I <>(J - 15) + 1 Then
If String3 = 0 Then
Ch1 = ""
Ch2 = ""
nZero = nZero + 1
ElseIf String3 <> 0 And nZero <> 0 Then
Ch1 = "零" & Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
Else
Ch1 = Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
End If
Else '该位是万亿，亿，万，元位等关键位
If String3 <> 0 And nZero <> 0 Then
Ch1 = "零" & Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
ElseIf String3 <> 0 And nZero = 0 Then
Ch1 = Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
ElseIf String3 = 0 And nZero >= 3 Then
Ch1 = ""
Ch2 = ""
nZero = nZero + 1
Else
Ch1 = ""
Ch2 = Mid(String2, I, 1)
nZero = nZero + 1
End If
If I = (J - 11) + 1 Or I = (J - 3) + 1 Then '如果该位是亿位或元位，则必须写上
Ch2 = Mid(String2, I, 1)
End If
End If
AtoC = AtoC & Ch1 & Ch2
If I = J And String3 = 0 Then '最后一位（分）为0时，加上“整”
AtoC = AtoC & "整"
End If
Next
if a=0 then
atoc="零元整"
end if
%>
------------------------------------
本函数计算两个时间的差
Function TimeDiff(sBegin, sEnd)
Dim iHourB, iMinuteB, iSecondB, iMiniSecondB
Dim iHourE, iMinuteE, iSecondE, iMiniSecondE
Dim dTimeB, dTimeE, dTimeDiff
Dim iHour, iMinute, iSecond, iMiniSecond
iHourB = clng(Left(sBegin, 2))
iMinuteB = clng(Mid(sBegin, 4, 2))
iSecondB = clng(Mid(sBegin, 7, 2))
iMiniSecondB = clng(Mid(sBegin, 10, 4))
iHourE = clng(Left(sEnd, 2))
iMinuteE = clng(Mid(sEnd, 4, 2))
iSecondE = clng(Mid(sEnd, 7, 2))
iMiniSecondE = clng(Mid(sEnd, 10, 4))
dTimeB = iHourB * 3600 + iMinuteB * 60 + iSecondB + iMiniSecondB / 1000
dTimeE = iHourE * 3600 + iMinuteE * 60 + iSecondE + iMiniSecondE / 1000
dTimeDiff = dTimeE - dTimeB
iHour = Int(dTimeDiff / 3600)
dTimeDiff = dTimeDiff - iHour * 3600
iMinute = Int(dTimeDiff / 60)
dTimeDiff = dTimeDiff - iMinute * 60
iSecond = Int(dTimeDiff)
dTimeDiff = dTimeDiff - Int(dTimeDiff)
iMiniSecond = dTimeDiff
TimeDiff = iHour & "小时" & iMinute & "分钟" & iSecond & FormatNumber(iMiniSecond, 3) & "秒"
End Function
----------------------------------------
生成一个不重复的随即数字
Sub CalCaPiao()
Dim strCaiPiaoNoArr() As String
Dim strSQL As String
Dim strCaiPiaoNo As String
strCaiPiaoNo = "01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33"
Dim StrTempArr(7) As String
Dim strZhongJiangArr(7) As String
strCaiPiaoNoArr = Split(strCaiPiaoNo, ",")
Dim intRand As Integer
Dim i As Integer
Dim j As Integer
i = 0
Dim find As Boolean
Do While True
find = False
Randomize
intRand = Int((33 * Rnd) + 1)
For j = 0 To i - 1
If StrTempArr(j) = CStr(intRand) Then
find = True
End If
Next
If Not find Then
StrTempArr(j) = CStr(intRand)
strZhongJiangArr(i) = CStr(intRand)
'Text1(i) = strZhongJiangArr(i)
i = i + 1
If i = 7 Then
Exit Do
End If
End If
Loop
End Sub
---------------------------------------
简体中文编码对应器
<% DIM FirstCHR,LastCHR,K,I,J
FirstCHR = Request("FirstCHR") 'FirstCHR="45217" '定义起始值
LastCHR = Request("LastCHR") 'LastCHR="62289" '定义终结值
HttpAddress = Request.ServerVariables("url") '不要动
Sub MakeChineseWord()
Response.write "起始值："&FirstCHR&" "
Response.write "终止值："&LastCHR&" "
Response.write "差值= "&LastCHR-FirstCHR+1&"<P>"
FOR J = FirstCHR TO LastCHR
RESPONSE.WRITE "<a title='"&J&"'>"&CHR(J)&"</a> "
k = k+1
if (J mod 20) = 0 then
RESPONSE.WRITE "（最后为"&J&"）<p>"
end if
NEXT
RESPONSE.WRITE "<p>共有："& K &"中文字<br>"
End Sub
%>
<form action="<%=HttpAddress%>" method="post">
<select name="FirstCHR">
<option value="" SELECTED>选择起始值</option>
<%For I = 1 to 72
Response.write "<option value="&(45217+K1)&">"&(45217+K1)&"-"&I&"</option>"
K1 = K1 + 256
Next%>
</select>
<select name="LastCHR">
<option value="" SELECTED>选择起始值</option>
<%For I = 1 to 72
Response.write "<option value="&(45310+K2)&">"&(45310+K2)&"-"&I&"</option>"
K2 = K2 + 256
Next%>
</select>
<input type="submit" value="确定">
</form>
<%
if FirstCHR <> "" and LastCHR <> "" then
Call MakeChineseWord()
end if
%>
----------------------------------------
显示左边的n个字符(自动识别汉字)函数(探索者)
rem 显示左边的n个字符(自动识别汉字)
Function LeftTrue(str,n)
If len(str)<=n/2 Then
LeftTrue=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
t=l
TStr=""
t=0
for i=1 to l
c=asc(mid(str,i,1))
If c<0 then c=c+65536
If c>255 then
t=t+2
Else
t=t+1
End If
If t>n Then exit for
TStr=TStr&(mid(str,i,1))
next
LeftTrue = TStr
End If
End Function
------------------------------------------
控制输出字符串的长度，可以区别中英文
函数在下面，是方法是：
strvalue("复请Email通知如果不填写则取注册Email",26)
这里26是指26个英文字母，也就是13个汉字
function strlen(str)
dim p_len
p_len=0
strlen=0
if trim(str)<>"" then
p_len=len(trim(str))
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
else
strlen=int(strlen) + 1
end if
next
end if
end function
function strvalue(str,lennum)
dim p_num
dim i
if strlen(str)<=lennum then
strvalue=str
else
p_num=0
x=0
do while not p_num > lennum-2
x=x+1
if asc(mid(str,x,1))<0 then
p_num=int(p_num) + 2
else
p_num=int(p_num) + 1
end if
strvalue=left(trim(str),x)&"…"
loop
end if
end function
-------------------------------------
遍历目录以及目录下文件的函数
<%
function bianli(path)
set fso=server.CreateObject("scripting.filesystemobject")
on error resume next
set objFolder=fso.GetFolder(path)
set objSubFolders=objFolder.Subfolders
for each objSubFolder in objSubFolders
nowpath=path + "\" + objSubFolder.name
Response.Write nowpath
set objFiles=objSubFolder.Files
for each objFile in objFiles
Response.Write "<br>---"
Response.Write objFile.name
next
Response.Write "<p>"
bianli(nowpath)'递归
next
set objFolder=nothing
set objSubFolders=nothing
set fso=nothing
end function
%>
<%
bianli("d:") '遍历d:盘
%>
------------------------------------
StripNonNumeric函数源程序
<%
Function StripNonNumeric(strInput)
Dim iPos, sNew, iTemp
strInput = Trim(strInput)
If strInput <> "" Then
iPos = 1
iTemp = Len(strInput)
While iTemp >= iPos
If IsNumeric(Mid(strInput,iPos,1)) = True Then
sNew = sNew & Mid(strInput,iPos,1)
End If
iPos = iPos + 1
Wend
Else
sNew = ""
End If
StripNonNumeric = sNew
End Function
%>
-----------------------------------
动态输入框的三个函数
<%
Function cTextBox(name, value, size)
Response.Write"<input type=text name='"&name&"' value='"&value&"' size='"&size&"'>"&vbcrlf
Response.Write cTextBox("NAME", "1", "12") &vbcrlf
End Function
Function cCheckBox(name, value, checked)
Response.Write"<input type=checkbox name='"&name&"' value='"&value&"'"
If checked = 1 Then Response.Write" CHECKED"
Response.Write">"
End Function
Function cRadio(name, value, checked)
Response.Write"<input type=radio name='"&name&"' value='"&value&"'"
If checked = 1 Then Response.Write" CHECKED"
Response.Write">"
End Function
%>
<html>
<body>
<%
'just declaring a couple of static variables here,
'but you can create cbname and cbvalue any way you like.
'use a recordset, or Request collection too:
cbname = "checkbox_name"
cbvalue = "act"
Response.Write "My Checkbox: "&cCheckBox(cbname, cbvalue, 1)&" "
'or, write a radio button like this:
Response.Write cRadio(cbname, cbvalue, 1)
%>
</body>
</html>
------------------------------------------
判断文章中文字符数量
dim WINNT_CHINESE
WINNT_CHINESE = (len("论坛")=2)
function strLength(str)
ON ERROR RESUME NEXT
if WINNT_CHINESE then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+65536
if c>255 then
t=t+1
end if
next
strLength=t
else
strLength=len(str)
end if
if err.number<>0 then err.clear
end function
----------------------------------------
检查sql字符串中是否有单引号，有则进行转化
<%
function CheckStr(str)
dim tstr,l,i,ch
l=len(str)
for i=1 to l
ch=mid(str,i,1)
if ch="'" then
tstr=tstr+"'"
end if
tstr=tstr+ch
next
CheckStr=tstr
end function
%>
---------------------------------------
简单的检查输入email是否合法程序
function chkEmail(email)
on error resume next
dim i,l,pos1,pos2
chkEmail=true
if isnull(email) then chkEmail=false:exit function
pos1= instr(email,"@")
pos2=instrRev(email,".")
if not(pos1>0) or not (pos2>0) or pos1>pos2 then
chkEmail=false
end if
if err.number<>0 then err.clear
end function
---------------------------------------
用正则表达式突出显示字符串中查询到的单词的函数
Function BoldWord(strContent,word)
dim objRegExp
Set objRegExp=new RegExp
objRegExp.IgnoreCase =true
objRegExp.Global=True
objRegExp.Pattern="(" & word & ")"
strContent=objRegExp.Replace(strContent,"<font color=""#FF0000"">$1</font>" )
Set objRegExp=Nothing
BoldWord=strContent
End Function
----------------------------------------
人民币小写转换为大写
<%
'****人民币大小写转换格式****
dim str(9)
str(0)="零"
str(1)="壹"
str(2)="贰"
str(3)="叁"
str(4)="肆"
str(5)="伍"
str(6)="陆"
str(7)="柒"
str(8)="捌"
str(9)="玖"
aa=Request.form("source")
hh=formatnumber(aa,2,-1)
aa=replace(hh,".","")
aa=replace(aa,",","")
for i=1 to len(aa)
s=mid(aa,i,1)
mynum=str(s)
select case(len(aa)+1-i)
case 1: k= mynum&"分"
case 2: k= mynum&"角"
case 3: k= mynum&"元"
case 4: k= mynum&"拾"
case 5: k= mynum&"佰"
case 6: k= mynum&"仟"
case 7: k= mynum&"万"
case 8: k= mynum&"拾"
case 9: k= mynum&"佰"
case 10: k= mynum&"仟"
end select
m=m&k
next
%>
<html>
<head>
<title>数字转换</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<!--
Elseif(s=".") then
n=m
i=i+2
for j=i to len(aa)
s=mid(aa,i,1)
mynum=str(s)
select case(len(aa)+1-i)
case 1: p= mynum&"分"
case 2: p= mynum&"角"
end select
m=m&p
next
-->
<body bgcolor="#FFFFFF">
<form method="post" name="forma">
<input type="text" name="source" value="<%=hh%>">
=
<input type="text" name="result" value="<%=m%>" size="40">
<input type="submit" name="Submit" value="提交 " >
</form>
</body>
</html>
function isChinese(para)
on error resume next
if isNUll(para) then
isChinese=false
exit function
end if
if trim(para)="" then
isChinese=false
exit function
end if
dim c
for i=1 to len(para)
c=asc(mid(para,i,1))
if c>=0 then
isChinese=false
exit function
end if
next
isChinese=true
if err.number<>0 then err.clear
end function
%>
如：
if not isChinese(request("name")) then
errmsg=errmsg+"
"+"<li>用户名应为汉字"
founderr=true
else
username=trim(request("name"))
end if
----------------------------------------------
'替换指定文件内字符串的函数
<%
function FSOlineedit(filename,Target,String)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FiletempData = objCountFile.ReadAll
objCountFile.Close
FiletempData=Replace(FiletempData,Target,String)
Set objCountFile=objFSO.CreateTextFile(Server.MapPath(filename),True)
objCountFile.Write FiletempData
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
response.write FSOlineedit("test.txt","世界","明天是一个好天去")
%>
----------------------------------------------
'获取中文字符串拼音首字母串的函数
<%
response.write "<link href=style.css rel=stylesheet>"
if request.form("content")="" then
response.write "<center><form method=post action=asd.asp><input name=content type=text>__<input type=submit></form>"
else
function getpychar(char)
tmp=65536+asc(char)
if(tmp>=45217 and tmp<=45252) then
getpychar= "A"
elseif(tmp>=45253 and tmp<=45760) then
getpychar= "B"
elseif(tmp>=45761 and tmp<=46317) then
getpychar= "C"
elseif(tmp>=46318 and tmp<=46825) then
getpychar= "D"
elseif(tmp>=46826 and tmp<=47009) then
getpychar= "E"
elseif(tmp>=47010 and tmp<=47296) then
getpychar= "F"
elseif(tmp>=47297 and tmp<=47613) then
getpychar= "G"
elseif(tmp>=47614 and tmp<=48118) then
getpychar= "H"
elseif(tmp>=48119 and tmp<=49061) then
getpychar= "J"
elseif(tmp>=49062 and tmp<=49323) then
getpychar= "K"
elseif(tmp>=49324 and tmp<=49895) then
getpychar= "L"
elseif(tmp>=49896 and tmp<=50370) then
getpychar= "M"
elseif(tmp>=50371 and tmp<=50613) then
getpychar= "N"
elseif(tmp>=50614 and tmp<=50621) then
getpychar= "O"
elseif(tmp>=50622 and tmp<=50905) then
getpychar= "P"
elseif(tmp>=50906 and tmp<=51386) then
getpychar= "Q"
elseif(tmp>=51387 and tmp<=51445) then
getpychar= "R"
elseif(tmp>=51446 and tmp<=52217) then
getpychar= "S"
elseif(tmp>=52218 and tmp<=52697) then
getpychar= "T"
elseif(tmp>=52698 and tmp<=52979) then
getpychar= "W"
elseif(tmp>=52980 and tmp<=53640) then
getpychar= "X"
elseif(tmp>=53689 and tmp<=54480) then
getpychar= "Y"
elseif(tmp>=54481 and tmp<=62289) then
getpychar= "Z"
else '如果不是中文，则不处理
getpychar=char
end if
end function
function getpy(str)
for i=1 to len(str)
getpy=getpy&getpychar(mid(str,i,1))
next
end function
content=request.form("content")
response.write "<center>"&getpy(content)&chr(10)
response.write "<br><br><br><a href=# onclick=javascript:history.go(-1)>返回</a>"
end if
%>
--------------------------------------------
ip限制函数
'******************************
'Function CheckIp(cInput_Ip,cBound_Ip)
'Created by qqdao, [email protected] 2001/11/28
'说明：首先需要根据;号循环，然后判断是否含有"-"，如果有则进行拆分处理，最后判断是否在范围内
'参数： cInput_Ip,代检查的ip
' cBound_Ip,给定的范围格式为,单个ip,和范围ip，范围ip最后使用”-“分割，如果是“*”则必须放到最后一位
' 每个范围后添加":ALLOW"表示允许登陆，添加":REFUSE"表示拒绝登陆。多个范围用”;“隔开
' 例如192.168.1*.*:ALLOW;192.168.1.1:ALLOW;192.168.1.1-10:REFUSE"
'返回值: true/false
'更新：2001/12/05 支持ALLOW,REFUSE支持’*‘,不想对？支持，因为和*差不多
'******************************
function CheckIp(cInput_Ip,cBound_Ip)
dim cSingle_Ip,cTemp_IP,cStart_IP,cEnd_Ip
CheckIp = false
cSingle_Ip=split(cBound_Ip,";")
for i=0 to ubound(cSingle_Ip)
if Instr(cSingle_Ip(i),"REFUSE") <> 0 then '就是拒绝了
cTemp_IP = left(cSingle_Ip(i),instr(cSingle_Ip(i),":")-1)
if Instr(cTemp_IP,"*") <> 0 then '是宽范围
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1)
if left(cInput_Ip,len(cStart_IP))=cStart_IP then
CheckIp = false
exit function
end if
end if
if Instr(cTemp_IP,"-") = 0 then
cStart_IP = cTemp_IP
cEnd_Ip = cTemp_IP
else
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1)
cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1)
end if
if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then
CheckIp = false
exit function
end if
elseif Instr(cSingle_Ip(i),"ALLOW") <> 0 then '允许
cTemp_IP = left(cSingle_Ip(i),instr(cSingle_Ip(i),":")-1)
if Instr(cTemp_IP,"*") <> 0 then '是宽范围
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"*")-1)
if left(cInput_Ip,len(cStart_IP))=cStart_IP then
CheckIp = true
end if
end if
if Instr(cTemp_IP,"-") = 0 then
cStart_IP = cTemp_IP
cEnd_Ip = cTemp_IP
else
cStart_IP = left(cTemp_IP,instr(cTemp_IP,"-")-1)
cEnd_Ip = left(cStart_IP,InStrRev(cStart_IP,".")-1)+"."+mid(cTemp_IP,instr(cTemp_IP,"-")+1)
end if
if Ip2Str(cInput_Ip)>=Ip2Str(cStart_IP) and Ip2Str(cInput_Ip)<=Ip2Str(cEnd_Ip) then
CheckIp =true
else
CheckIp =false
end if
end if
next
end function
'******************************
'Function Ip2Str(cIp)
'Created by qqdao, [email protected] 2001/11/28
'参考动网ip算法
'参数：cIp ip地址
'返回值: 转换后数值
'******************************
function Ip2Str(cIp)
Dim str1,str2,str3,str4
Dim cIp_Temp
if cIp="127.0.0.1" then cIp="192.168.0.1"
str1=left(cIp,instr(cIp,".")-1)
cIp_Temp=mid(cIp,instr(cIp,".")+1)
str2=left(cIp_Temp,instr(cIp_Temp,".")-1)
cIp_Temp=mid(cIp_Temp,instr(cIp_Temp,".")+1)
str3=left(cIp_Temp,instr(cIp_Temp,".")-1)
str4=mid(cIp_Temp,instr(cIp_Temp,".")+1)
if isNumeric(str1)=0 or isNumeric(str2)=0 or isNumeric(str3)=0 or isNumeric(str4)=0 then
else
Ip2Str=cint(str1)*256*256*256+cint(str2)*256*256+cint(str3)*256+cint(str4)-1
end if
end function
'代码调用演示
if CheckIp("192.168.1.1","192.168.1.*:REFUSE") then
response.write "登陆成功"
else
response.write "您的ip不被允许"
end if
cinput_ip就是要检查的ip，也就是Request.ServerVariables("REMOTE_ADDR")
cbound_ip是范围，可以存到库里，范围的写法，我已详细说明了。
----------------------------------------------
汉字转化为拼音
很多问题都是因为中文问题造成的
如文件名最好别用中文
现在的解决方法一般是产生一个ID,将这个ID做文件名
网页上如果url带汉字也经常出错
现在的解决方法一般用urlencode编码
现在用了这个转化，就好多了
原理，使用Dictionary技术
1.添加索引
2.遍历词典
<%
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
response.write c(request("hz"))
%>
<form method=post>
请在此处输入中文：<input name=hz>
----------------------------------------
一个非常简单的将半角"转换为中文“的函数
function new_str(str)
if instr(str,chr(34))<>0 and str<>"" then
str_split=split(str,chr(34))
i=1
str_s=""
for j=0 to ubound(str_split)-1
if i mod 2 then
str_s=str_s&str_split(j)&"“"&str_split(j+1)
else
str_s=str_s&str_split(j)&"”"&str_split(j+1)
end if
i=i+1
next
end function
-----------------------------------------
货币大写转换函数的更新
<%
dim a '要转换成大写的金额
dim atoc '转换之后的值
Dim String1 '如下定义
Dim String2 '如下定义
Dim String3 '从原A值中取出的值
Dim I '循环变量
Dim J 'A的值乘以100的字符串长度
Dim Ch1 '数字的汉语读法
Dim Ch2 '数字位的汉字读法
Dim nZero '用来计算连续的零值是几个
String1 = "零壹贰叁肆伍陆柒捌玖"
String2 = "万仟佰拾亿仟佰拾万仟佰拾元角分"
nZero = 0
If InStr(1, CStr(a * 100), ".") <> 0 Then
err.Raise 5000, , "此函数( AtoC() )只能转换小数点后有两位以内的数！"
End If
J = Len(CStr(a * 100))
String2 = Right(String2, J) '取出对应位数的STRING2的值
For I = 1 To J
String3 = Mid(a * 100, I, 1) '取出需转换的某一位的值
If I <> (J - 3) + 1 And I <> (J - 7) + 1 And I <> (J - 11) + 1 And I <>(J - 15) + 1 Then
If String3 = 0 Then
Ch1 = ""
Ch2 = ""
nZero = nZero + 1
ElseIf String3 <> 0 And nZero <> 0 Then
Ch1 = "零" & Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
Else
Ch1 = Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
End If
Else '该位是万亿，亿，万，元位等关键位
If String3 <> 0 And nZero <> 0 Then
Ch1 = "零" & Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
ElseIf String3 <> 0 And nZero = 0 Then
Ch1 = Mid(String1, clng(String3) + 1, 1)
Ch2 = Mid(String2, I, 1)
nZero = 0
ElseIf String3 = 0 And nZero >= 3 Then
Ch1 = ""
Ch2 = ""
nZero = nZero + 1
Else
Ch1 = ""
Ch2 = Mid(String2, I, 1)
nZero = nZero + 1
End If
If I = (J - 11) + 1 Or I = (J - 3) + 1 Then '如果该位是亿位或元位，则必须写上
Ch2 = Mid(String2, I, 1)
End If
End If
AtoC = AtoC & Ch1 & Ch2
If I = J And String3 = 0 Then '最后一位（分）为0时，加上“整”
AtoC = AtoC & "整"
End If
Next
if a=0 then
atoc="零元整"
end if
%>
------------------------------------
本函数计算两个时间的差
Function TimeDiff(sBegin, sEnd)
Dim iHourB, iMinuteB, iSecondB, iMiniSecondB
Dim iHourE, iMinuteE, iSecondE, iMiniSecondE
Dim dTimeB, dTimeE, dTimeDiff
Dim iHour, iMinute, iSecond, iMiniSecond
iHourB = clng(Left(sBegin, 2))
iMinuteB = clng(Mid(sBegin, 4, 2))
iSecondB = clng(Mid(sBegin, 7, 2))
iMiniSecondB = clng(Mid(sBegin, 10, 4))
iHourE = clng(Left(sEnd, 2))
iMinuteE = clng(Mid(sEnd, 4, 2))
iSecondE = clng(Mid(sEnd, 7, 2))
iMiniSecondE = clng(Mid(sEnd, 10, 4))
dTimeB = iHourB * 3600 + iMinuteB * 60 + iSecondB + iMiniSecondB / 1000
dTimeE = iHourE * 3600 + iMinuteE * 60 + iSecondE + iMiniSecondE / 1000
dTimeDiff = dTimeE - dTimeB
iHour = Int(dTimeDiff / 3600)
dTimeDiff = dTimeDiff - iHour * 3600
iMinute = Int(dTimeDiff / 60)
dTimeDiff = dTimeDiff - iMinute * 60
iSecond = Int(dTimeDiff)
dTimeDiff = dTimeDiff - Int(dTimeDiff)
iMiniSecond = dTimeDiff
TimeDiff = iHour & "小时" & iMinute & "分钟" & iSecond & FormatNumber(iMiniSecond, 3) & "秒"
End Function
----------------------------------------
生成一个不重复的随即数字
Sub CalCaPiao()
Dim strCaiPiaoNoArr() As String
Dim strSQL As String
Dim strCaiPiaoNo As String
strCaiPiaoNo = "01,02,03,04,05,06,07,08,09,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33"
Dim StrTempArr(7) As String
Dim strZhongJiangArr(7) As String
strCaiPiaoNoArr = Split(strCaiPiaoNo, ",")
Dim intRand As Integer
Dim i As Integer
Dim j As Integer
i = 0
Dim find As Boolean
Do While True
find = False
Randomize
intRand = Int((33 * Rnd) + 1)
For j = 0 To i - 1
If StrTempArr(j) = CStr(intRand) Then
find = True
End If
Next
If Not find Then
StrTempArr(j) = CStr(intRand)
strZhongJiangArr(i) = CStr(intRand)
'Text1(i) = strZhongJiangArr(i)
i = i + 1
If i = 7 Then
Exit Do
End If
End If
Loop
End Sub
---------------------------------------
简体中文编码对应器
<% DIM FirstCHR,LastCHR,K,I,J
FirstCHR = Request("FirstCHR") 'FirstCHR="45217" '定义起始值
LastCHR = Request("LastCHR") 'LastCHR="62289" '定义终结值
HttpAddress = Request.ServerVariables("url") '不要动
Sub MakeChineseWord()
Response.write "起始值："&FirstCHR&" "
Response.write "终止值："&LastCHR&" "
Response.write "差值= "&LastCHR-FirstCHR+1&"<P>"
FOR J = FirstCHR TO LastCHR
RESPONSE.WRITE "<a title='"&J&"'>"&CHR(J)&"</a> "
k = k+1
if (J mod 20) = 0 then
RESPONSE.WRITE "（最后为"&J&"）<p>"
end if
NEXT
RESPONSE.WRITE "<p>共有："& K &"中文字<br>"
End Sub
%>
<form action="<%=HttpAddress%>" method="post">
<select name="FirstCHR">
<option value="" SELECTED>选择起始值</option>
<%For I = 1 to 72
Response.write "<option value="&(45217+K1)&">"&(45217+K1)&"-"&I&"</option>"
K1 = K1 + 256
Next%>
</select>
<select name="LastCHR">
<option value="" SELECTED>选择起始值</option>
<%For I = 1 to 72
Response.write "<option value="&(45310+K2)&">"&(45310+K2)&"-"&I&"</option>"
K2 = K2 + 256
Next%>
</select>
<input type="submit" value="确定">
</form>
<%
if FirstCHR <> "" and LastCHR <> "" then
Call MakeChineseWord()
end if
%>
----------------------------------------
显示左边的n个字符(自动识别汉字)函数(探索者)
rem 显示左边的n个字符(自动识别汉字)
Function LeftTrue(str,n)
If len(str)<=n/2 Then
LeftTrue=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
t=l
TStr=""
t=0
for i=1 to l
c=asc(mid(str,i,1))
If c<0 then c=c+65536
If c>255 then
t=t+2
Else
t=t+1
End If
If t>n Then exit for
TStr=TStr&(mid(str,i,1))
next
LeftTrue = TStr
End If
End Function
------------------------------------------
控制输出字符串的长度，可以区别中英文
函数在下面，是方法是：
strvalue("复请Email通知如果不填写则取注册Email",26)
这里26是指26个英文字母，也就是13个汉字
function strlen(str)
dim p_len
p_len=0
strlen=0
if trim(str)<>"" then
p_len=len(trim(str))
for xx=1 to p_len
if asc(mid(str,xx,1))<0 then
strlen=int(strlen) + 2
else
strlen=int(strlen) + 1
end if
next
end if
end function
function strvalue(str,lennum)
dim p_num
dim i
if strlen(str)<=lennum then
strvalue=str
else
p_num=0
x=0
do while not p_num > lennum-2
x=x+1
if asc(mid(str,x,1))<0 then
p_num=int(p_num) + 2
else
p_num=int(p_num) + 1
end if
strvalue=left(trim(str),x)&"…"
loop
end if
end function
-------------------------------------
遍历目录以及目录下文件的函数
<%
function bianli(path)
set fso=server.CreateObject("scripting.filesystemobject")
on error resume next
set objFolder=fso.GetFolder(path)
set objSubFolders=objFolder.Subfolders
for each objSubFolder in objSubFolders
nowpath=path + "\" + objSubFolder.name
Response.Write nowpath
set objFiles=objSubFolder.Files
for each objFile in objFiles
Response.Write "<br>---"
Response.Write objFile.name
next
Response.Write "<p>"
bianli(nowpath)'递归
next
set objFolder=nothing
set objSubFolders=nothing
set fso=nothing
end function
%>
<%
bianli("d:") '遍历d:盘
%>
------------------------------------
StripNonNumeric函数源程序
<%
Function StripNonNumeric(strInput)
Dim iPos, sNew, iTemp
strInput = Trim(strInput)
If strInput <> "" Then
iPos = 1
iTemp = Len(strInput)
While iTemp >= iPos
If IsNumeric(Mid(strInput,iPos,1)) = True Then
sNew = sNew & Mid(strInput,iPos,1)
End If
iPos = iPos + 1
Wend
Else
sNew = ""
End If
StripNonNumeric = sNew
End Function
%>
-----------------------------------
动态输入框的三个函数
<%
Function cTextBox(name, value, size)
Response.Write"<input type=text name='"&name&"' value='"&value&"' size='"&size&"'>"&vbcrlf
Response.Write cTextBox("NAME", "1", "12") &vbcrlf
End Function
Function cCheckBox(name, value, checked)
Response.Write"<input type=checkbox name='"&name&"' value='"&value&"'"
If checked = 1 Then Response.Write" CHECKED"
Response.Write">"
End Function
Function cRadio(name, value, checked)
Response.Write"<input type=radio name='"&name&"' value='"&value&"'"
If checked = 1 Then Response.Write" CHECKED"
Response.Write">"
End Function
%>
<html>
<body>
<%
'just declaring a couple of static variables here,
'but you can create cbname and cbvalue any way you like.
'use a recordset, or Request collection too:
cbname = "checkbox_name"
cbvalue = "act"
Response.Write "My Checkbox: "&cCheckBox(cbname, cbvalue, 1)&" "
'or, write a radio button like this:
Response.Write cRadio(cbname, cbvalue, 1)
%>
</body>
</html>
------------------------------------------
判断文章中文字符数量
dim WINNT_CHINESE
WINNT_CHINESE = (len("论坛")=2)
function strLength(str)
ON ERROR RESUME NEXT
if WINNT_CHINESE then
dim l,t,c
dim i
l=len(str)
t=l
for i=1 to l
c=asc(mid(str,i,1))
if c<0 then c=c+65536
if c>255 then
t=t+1
end if
next
strLength=t
else
strLength=len(str)
end if
if err.number<>0 then err.clear
end function
----------------------------------------
检查sql字符串中是否有单引号，有则进行转化
<%
function CheckStr(str)
dim tstr,l,i,ch
l=len(str)
for i=1 to l
ch=mid(str,i,1)
if ch="'" then
tstr=tstr+"'"
end if
tstr=tstr+ch
next
CheckStr=tstr
end function
%>
---------------------------------------
简单的检查输入email是否合法程序
function chkEmail(email)
on error resume next
dim i,l,pos1,pos2
chkEmail=true
if isnull(email) then chkEmail=false:exit function
pos1= instr(email,"@")
pos2=instrRev(email,".")
if not(pos1>0) or not (pos2>0) or pos1>pos2 then
chkEmail=false
end if
if err.number<>0 then err.clear
end function
---------------------------------------
用正则表达式突出显示字符串中查询到的单词的函数
Function BoldWord(strContent,word)
dim objRegExp
Set objRegExp=new RegExp
objRegExp.IgnoreCase =true
objRegExp.Global=True
objRegExp.Pattern="(" & word & ")"
strContent=objRegExp.Replace(strContent,"<font color=""#FF0000"">$1</font>" )
Set objRegExp=Nothing
BoldWord=strContent
End Function
----------------------------------------
人民币小写转换为大写
<%
'****人民币大小写转换格式****
dim str(9)
str(0)="零"
str(1)="壹"
str(2)="贰"
str(3)="叁"
str(4)="肆"
str(5)="伍"
str(6)="陆"
str(7)="柒"
str(8)="捌"
str(9)="玖"
aa=Request.form("source")
hh=formatnumber(aa,2,-1)
aa=replace(hh,".","")
aa=replace(aa,",","")
for i=1 to len(aa)
s=mid(aa,i,1)
mynum=str(s)
select case(len(aa)+1-i)
case 1: k= mynum&"分"
case 2: k= mynum&"角"
case 3: k= mynum&"元"
case 4: k= mynum&"拾"
case 5: k= mynum&"佰"
case 6: k= mynum&"仟"
case 7: k= mynum&"万"
case 8: k= mynum&"拾"
case 9: k= mynum&"佰"
case 10: k= mynum&"仟"
end select
m=m&k
next
%>
<html>
<head>
<title>数字转换</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
</head>
<!--
Elseif(s=".") then
n=m
i=i+2
for j=i to len(aa)
s=mid(aa,i,1)
mynum=str(s)
select case(len(aa)+1-i)
case 1: p= mynum&"分"
case 2: p= mynum&"角"
end select
m=m&p
next
-->
<body bgcolor="#FFFFFF">
<form method="post" name="forma">
<input type="text" name="source" value="<%=hh%>">
=
<input type="text" name="result" value="<%=m%>" size="40">
<input type="submit" name="Submit" value="提交 " >
</form>
</body>
</html>
相关阅读 更多 +
