当前位置：ASP技术首页 >> ASP应用 >> ASP的自定义实用函数表(1)

ASP的自定义实用函数表(1)

2006-02-15 08:00:00 作者：来源：互联网浏览次数：0 文字大小：【大】【中】【小】

简介：　　'汉字判断 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 le...

关键字：函数实用 ASP

　　'汉字判断

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

isChinese=true

if err.number<>0 then err.clear

end function

如：

if not isChinese(request("name")) then

errmsg=errmsg+"

"+"

用户名应为汉字"

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 ""

if request.form("content")="" then

response.write "

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))

end function

content=request.form("content")

response.write "

"&getpy(content)&chr(10)

response.write "

返回"

end if

--------------------------------------------

ip限制函数

'******************************

'Function CheckIp(cInput_Ip,cBound_Ip)

'Created by qqdao, qqdao@263.net 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

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

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 function

'******************************

'Function Ip2Str(cIp)

'Created by qqdao, qqdao@263.net 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

g=b(i)

end if

end function

function c(str)

c=""

for i=1 to len(str)

c=c&g(asc(mid(str,i,1)))

end function

response.write c(request("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

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

AtoC = AtoC & Ch1 & Ch2

If I = J And String3 = 0 Then '最后一位（分）为0时，加上“整”

AtoC = AtoC & "整"

End If

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

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

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&"

FOR J = FirstCHR TO LastCHR

RESPONSE.WRITE ""&CHR(J)&" "

k = k+1

if (J mod 20) = 0 then

RESPONSE.WRITE "（最后为"&J&"）

end if

RESPONSE.WRITE "

共有："& K &"中文字
"

End Sub

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))

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

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 "
---"

Response.Write objFile.name

Response.Write "

bianli(nowpath)'递归

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""&vbcrlf

Response.Write cTextBox("NAME", "1", "12") &vbcrlf

End Function

Function cCheckBox(name, value, checked)

Response.Write"

If checked = 1 Then Response.Write" CHECKED"

Response.Write">"

End Function

Function cRadio(name, value, checked)

Response.Write"

If checked = 1 Then Response.Write" CHECKED"

Response.Write">"

End Function

'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)

------------------------------------------

判断文章中文字符数量

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

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

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,"$1" )

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

数字转换

责任编辑：admin

本文引用地址： http://www.3pcode.com/asp/2006/02/74735.htm

发表评论　加入收藏　告诉好友　打印本页　关闭窗口　返回顶部

ASP的自定义实用函数表(1)

最新文章

更多

推荐文章

更多

热点文章

更多