ASP 实用Function集合

最新推荐文章于 2017-02-08 20:22:57 发布

三井学长

最新推荐文章于 2017-02-08 20:22:57 发布

阅读量4.4k

点赞数

文章标签： function asp javascript character email 脚本

本文链接：https://blog.csdn.net/david1030/article/details/2023992

版权

'==================取除左右括号============================
Function getReplace(Str)
Str = Replace(Str,"(","")
Str = Replace(Str,")","")
getReplace = Trim(Str)
End Function
'==================取出数组中字符组成带括号的新字符=========
Function getNewStr(tempArr)
temp = ""
For i = 0 To UBound(tempArr)
If temp = "" Then
  temp = "(" & tempArr(i) & ")"
Else
  temp = temp & ",(" & tempArr(i) & ")"
End if
Next
getNewStr = temp
End Function
'==================生成数组放入sql查询语句==================
Function getInsql(tempArr)
temp = ""
if isarray(tempArr) then
for i = 0 to ubound(tempArr)
  if temp = "" then
   temp = "'" & tempArr(i) & "'"
  else
   temp = temp & ",'"& tempArr(i) &"'"
  end if
next
end if
getInsql = temp
End Function
'================================================'
'================字符串处理======================='
'================================================'
'截取一定长度的字符串
'Str为字符串，length为长度
Function cutStr(Str,Length)
If len(Str)>Length Then
  cutStr=left(Str,Length)&"..."
Else
  cutStr=Str
End If
End Function

'格式化文本输出,如空格、换行
Function outputStr_BR(str)
If str<>"" Then
  outputStr_BR=Server.HTMLEnCode(str)
  outputStr_BR=Replace(outputStr_BR," "," ")
  outputStr_BR=Replace(outputStr_BR,chr(13),"<br>")
Else
  outputStr_BR=""
End If
End Function

'字符安全处理
Function SafeStr(str,IfTrim)
Dim temp
temp=Replace(str,"'","''")
If IfTrim Then
temp=Trim(temp)
End If
SafeStr=temp
End Function

'不够宽度用空格填充“ ”，区分汉字（2个字长）、字母（1个字长）
Function FormatLen(str,length)
Dim temp,tempLen,i
temp=str
tempLen=len(str)
i=tempLen
While i>0
  If len(temp)>0 And Asc(right(temp,1))<0 Then
   tempLen=tempLen+1
  End If
  i=i-1
  temp=left(temp,i)
Wend
If tempLen<length Then
  temp=Replace(Space(length-tempLen)," "," ")
End If
FormatLen=str&temp
End Function

'返回半字长度
Function lLen(str)
Dim temp,tempLen,i
tempLen=0
temp=str
While Len(temp)>0
  If Asc(Left(temp,1))<0 Then
   tempLen=tempLen+2
  Else
   tempLen=tempLen+1
  End If
  temp=Right(temp,Len(temp)-1)
Wend
lLen=tempLen
End Function

'返回定长的HTML格式空格
Function HTMLSpace(length)
HTMLSpace=Replace(Space(length)," "," ")
End Function

'替换接收form内提交的字符串
Function crequest(inputname)
if inputname<>"" then
crequest=replace(trim(request(inputname)),"'","''")
else
crequest=""
end if
End Function

'替换接收form内提交的字符串，主要为id
Function irequest(inputname)
irequest=replace(trim(request(inputname)),"'","''")
if irequest="" then irequest = "0"
End Function

'替换接受翻页的页数
Function prequest(pageNumber)
Dim tmpPageNumber
tmpPageNumber= request(pageNumber)
If IsNull(tmpPageNumber) Or tmpPageNumber="" Then
  prequest = 1
Else
  If IsNumeric(tmpPageNumber) Then
   prequest = CInt(tmpPageNumber)
  Else
   prequest = 1
  End If
End If
End Function

'从字符串str中删除字符串str1
function deleteStr(str,str1)
dim pos
pos = Instr(str,str1)
if pos >0 then
deleteStr = left(str,pos-1) & right(str,len(str)-pos-len(str1)+1)
else
deleteStr = str
end if
end function

'str字符串左起补0
function leftZero(n,str)
Dim zero_tag,z
zero_tag = ""
for z=0 to n-1
zero_tag = zero_tag &"0"
next
leftZero = right(zero_tag&str,n)
end function

'判断手机号码是否合法
function isCellphone(str)
if len(str)=11 and mid(str,1,1)="1" and mid(str,2,1)="3" then
isCellphone = true
else
isCellphone = false
end if
end function

'判断email地址是否合法
function isValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
  IsValidEmail = false
  exit function
end if
for each name in names
  if Len(name) <= 0 then
   IsValidEmail = false
   exit function
  end if
  for i = 1 to Len(name)
   c = Lcase(Mid(name, i, 1))
   if InStr("abcdefghijklmnopqrstuvwxyz_-.+", c) <= 0 and not IsNumeric(c) then
    IsValidEmail = false
    exit function
   end if
  next
  if Left(name, 1) = "." or Right(name, 1) = "." then
   IsValidEmail = false
   exit function
  end if
  if Left(name, 1) = "+" or Right(name, 1) = "+" then
   IsValidEmail = false
   exit function
  end if
next
if InStr(names(1), ".") <= 0 then
  IsValidEmail = false
  exit function
end if
if Left(names(1),1) ="+" then
  IsValidEmail = false
  exit function
end if
if Right(names(1),1) ="+" then
  IsValidEmail = false
  exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
  IsValidEmail = false
  exit function
end if
if InStr(email, "..") > 0 then
  IsValidEmail = false
end if
end function

'判断Fax是否合法
Public Function IsValidFax(fax)
Dim oRegExp
Set oRegExp = New RegExp
oRegExp.Pattern = "(^0/d{2,3}/-[1-9]/d{2,7}$)|(^[1-9]/d{2,7}$)|(^/(0[1-9]{2,3}/)[1-9]/d{2,7}$)"
oRegExp.IgnoreCase = True
oRegExp.Global = True
IsValidFax = oRegExp.Test(fax)
Set oRegExp = Nothing
End Function

'去除字符串中最后一个字符
Function eraseLastChr(var_Str,var_character)
If IsNull(var_Str) Or var_Str="" Then
  eraseLastChr = ""
Else
   If IsNull(var_character) Or var_character ="" Then
   eraseLastChr = var_Str
  Else
   If Right(var_Str,1)=var_character Then
    eraseLastChr = Left(var_Str,Len(var_Str)-1)
   Else
    eraseLastChr = var_Str
   End If
  End If
End If
End Function

'======小数点前补0
Function addZeroPoint(str)
tmpPosition = InStr(1,str,".",1)
If tmpPosition = 1 Then str = "0" & str
addZeroPoint = str
End function
'================================================'
'================字符数组处理======================'
'================================================'
'转换字符串到数组
function to_array(str,character) 'change the "xx,xx,xx" to array (xx,xx,xx)
if isNull(str) then
  to_array = empty
elseif trim(str) = "" then
   to_array = empty
else
  to_array = split(str,character)
end if
end Function

'转换数组到字符串
Function to_String(arr,character) 'change the array (xx,xx,xx) to "xx,xx,xx"
Dim x,returnStr
If IsArray(arr) Then
  For x=0 To UBound(arr)
   If returnStr = "" Then
    returnStr = arr(x)
   Else
    returnStr = returnStr & character & arr(x)
   End If
  Next
  to_String = returnStr
Else
  to_String = ""
End If
End Function

' 从数组中删除
function removeStr(str,arr) 'delete the string from the array
dim k
k = 0
redim temp_arr(k)
if isArray(arr) then
  for i=0 to ubound(arr)
   midstr = arr(i)
   if not midstr = str then
    redim preserve temp_arr(k)
    temp_arr(k) = midstr
       k = k + 1
   end if
  next
else
  removeStr = arr
end if
end function

'判断字符串是否在1维数组中
function strInArr(str,arr)
strInArr = false
if not isarray(arr) then
  strInArr = false
else
  for x=0 to ubound(arr)
   midstr = trim(arr(x))
   if midstr = trim(str) then
    strInArr = true
   end if
  next
end if
end function

'判断字符串是否在2维数组中
function strInArr2(str,arr)
strInArr2 = false
if not isarray(arr) then
  strInArr2 = false

else
  for x=0 to ubound(arr,2)
   midstr = trim(arr(0,x))
   if midstr = trim(str) then

    strInArr2 = true
   end if
  next
end if
end function

'得到字符串在1维数组中的位置
function indexOfArr(str ,arr)
indexOfArr = -1
if not isarray(arr) then
  indexOfArr = -1
Else
  for x=0 to ubound(arr)
   midstr = cstr(arr(x))
   if CInt(midstr) = CInt(str) then
    indexOfArr = x
   end if
  Next
end if
end Function

'得到字符串在1维数组中的所有位置
function AllindexOfArr(str ,arr)
AllindexOfArr = -1
if not isarray(arr) then
  AllindexOfArr = -1
Else
  for x=0 to ubound(arr)
   midstr = cstr(arr(x))
   if cstr(midstr) = cstr(str) then
    If tmpPostion = "" Then
     AllindexOfArr = x
    Else
     AllindexOfArr = AllindexOfArr & "," & x
    End If
   end If
  Next
end if
end Function

'更新数组内的特定位置的字符串内容
'arr 为数组，pos为位置，str为新内容
function updateArr(arr,pos,str) 'update the array content at special position
if pos > ubound(arr) or pos < 0 or not isarray(arr) then
  updateArr = arr
else
  arr(pos) = str
  updateArr = arr
end if
end function

'把1维数组输出
sub writeArr(arr)
Dim x
if not isarray(arr) then
  response.write "empty array!!!"
else
  for x=0 to ubound(arr)
   response.write x&":["&trim(arr(x))&"]<br>"
  next
end if
end sub

'删除数组中特定位置的字符串生成新的数组
function removeIndex(arr,pos) 'delete one where positioned pos from arr
if isarray(arr) then
  redim temp_arr(0)
  dim k
  k= 0
  for x = 0 to ubound(arr)
   midstr = arr(x)
   if not x = pos then
    redim preserve temp_arr(k)
    temp_arr(k) = midstr
    k = k + 1
   end if
        next
  removeIndex = temp_arr
else
  removeIndex = arr
end if
end function

'追加数组内容
function arrAppend(arr,str)
dim temp_arr,arr_len
if isarray(arr) then
  arr_len = ubound(arr)
  redim preserve arr(arr_len+1)
        arr(arr_len+1) = str
  arrAppend = arr
else
  redim temp_arr(0)
        temp_arr(0) = str
  arrAppend = temp_arr
end if
end function

'删除数组中空的记录
function deleteNull(arr)   'delete the null value in the array
dim temp_arrKeyword,z,temp_str
if isarray(arr) then
  for z=0 to ubound(arr)
   temp_str = arr(z)
   if (Not IsNull(temp_str)) And (trim(temp_str) <> "") then
    temp_arrKeyword = arrAppend(temp_arrKeyword,trim(temp_str))
   end if
  next
  deleteNull = temp_arrKeyword
else
  deleteNull = arr
end if
end function

'================================================'
'================窗口处理========================='
'================================================'

'关闭非模态窗口
Function ClosePop()
Response.Write "<Script Language='JavaScript'>"
Response.Write "parent.window.close();"
Response.Write "</Script>"
End Function

'================================================'
'================警告处理========================='
'================================================'

'生成客户端脚本，页面转向
Function ForwardTo(URL)
Response.Write "<Script Language='JavaScript'>"
Response.Write "top.Main.location.replace('"&URL&"');"
Response.Write "</Script>"
End Function

'生成客户端脚本，页面转向
Function ForwardListTo(URL)
Response.Write "<Script Language='JavaScript'>"
Response.Write "this.parent.List_FRAME.location.href = ('"&URL&"');"
Response.Write "</Script>"
End Function

'生成客户端脚本，页面转向
Function ForwardViewTo(URL)
Response.Write "<Script Language='JavaScript'>"
Response.Write "this.parent.View_FRAME.location.href = ('"&URL&"');"
Response.Write "</Script>"
End Function

'生成客户端脚本，显示提示信息
Function ShowMsg(Msg)
Response.Write "<Script Language='JavaScript'>"
Response.Write "alert('"&Msg&"');"
Response.Write "</Script>"
End Function

'生成客户端脚本，显示提示信息并返回前页
Function ShowMsgAndBack(Msg)
Response.Write "<Script Language='JavaScript'>"
Response.Write "alert('"&Msg&"');"
Response.Write "history.back();"
Response.Write "</Script>"
Response.end
End Function

'生成客户端脚本，显示提示信息并关闭当前窗口
Function ShowMsgAndClose(Msg)
Response.Write "<Script Language='JavaScript'>"
Response.Write "alert('"&Msg&"');"
Response.Write "window.close();"
Response.Write "</Script>"
End Function

'生成客户端脚本，显示提示信息并关闭当前模态框架窗口
Function ShowMsgAndClosePop(Msg)
Response.Write "<Script Language='JavaScript'>"
Response.Write "alert('"&Msg&"');"
Response.Write "parent.window.close();"
Response.Write "</Script>"
End Function

'生成客户端脚本，并转移到指定页面
Function ShowMsgAndTo(Msg,URL)
Response.Write "<Script Language='JavaScript'>"
Response.Write "alert('"&Msg&"');"
Response.Write "location.href='"&URL&"';"
Response.Write "</Script>"
End Function

'生成客户端脚本，返回前页
Function PageBack()
Response.Write "<Script Language='JavaScript'>"
Response.Write "history.back();"
Response.Write "</Script>"
End Function

'生成客户端脚本，刷新父窗口
Function FlashOpener(URL)
Dim tempURL
tempURL=URL
If tempURL="" Then
tempURL="opener.location.href"
Else
tempURL="'"&tempURL&"'"
End If
Response.Write "<Script Language='JavaScript'>"
Response.Write "opener.location.replace("&tempURL&");"
Response.Write "</Script>"
End Function

'生成客户端脚本，刷新父窗口(非模态框架窗口)
Function FlashPopOpener(URL)
Response.Write "<Script Language='JavaScript'>"
If URL="" Then
Response.Write "parent.ParentFun('PopOpener.location.reload/(/)');"
Else
Response.Write "parent.ParentFun('PopOpener.location.replace/("""&URL&"""/)');"
End If
Response.Write "</Script>"
End Function

'生成客户端脚本，刷新父窗口，并且关闭自身
Function FlashOpenerAndCloseMe(msg)
Response.Write "<Script Language='JavaScript'>"
Response.Write "alert('"&msg&"');"
Response.Write "window.close();"
Response.Write "top.opener.location.reload();"
Response.Write "</Script>"
End Function

'================================================'
'================时间日期处理======================'
'================================================'
'得到标准日期 19000101
function getDate1()
yyyy = cstr(year(now))
mm = right("00"&cstr(month(now)),2)
dd = right("00"&cstr(day(now)),2)
h = right("00"&cstr(hour(now)),2)
m = right("00"&cstr(minute(now)),2)
s = right("00"&cstr(second(now)),2)
getDate1 = yyyy&mm&dd&h&m&s
end function

function getDate(dateStr)
if isdate(dateStr) then
  yyyy = cstr(year(CDate(dateStr)))
  mm = right("00"&cstr(month(CDate(dateStr))),2)
  dd = right("00"&cstr(day(CDate(dateStr))),2)
  getDate = yyyy&mm&dd
else
  getDate = "20000101"
end if
end function

'得到由时间生成的随机数 20060101221022&4位随机数
Function getDateTimeSeries()
dim yyyy,mm,dd,h,m,s,MyValue
yyyy = year(now)
mm  = right("00"&cstr(month(now)),2)
dd  =   right("00"&cstr(day(now)),2)
h  =   right("00"&cstr(hour(now)),2)
m  =   right("00"&cstr(minute(now)),2)
s  =   right("00"&cstr(second(now)),2)
Randomize
MyValue = Int((1000 * Rnd) + 1)
getDateTimeSeries = yyyy&mm&dd&h&m&s&"-"&MyValue
End Function

'得到标准日期   1900-01-01
function getFormatDate(dateStr)
Dim yyyy,mm,dd
if isdate(dateStr) then
  yyyy = cstr(year(CDate(dateStr)))
  mm = right("00"&cstr(month(CDate(dateStr))),2)
  dd = right("00"&cstr(day(CDate(dateStr))),2)
  getFormatDate = yyyy&"-"&mm&"-"&dd
else
  getFormatDate = "2000-01-01"
end if
end function

'得到标准时间    2000-01-01 00:00:00
Function getExactTime(str_Date)
if isdate(str_date) then
  getExactTime = formatdatetime(str_Date,2) & " " & formatdatetime(str_Date,4)
else
  getExactTime = "2000-01-01 00:00:00"
end if
End Function

'得到中国时间表达方式
function getChineseDate(var_date)
   yyyy = year(var_date)
   mm   = month(var_date)
   dd   = day(var_date)
   hh   = hour(var_date)
   mi   = minute(var_date)
   ss   = second(var_date)
   getChineseDate = yyyy&"年"&mm&"月"&dd&"日 "&hh&"时"&mi&"分"&ss&"秒"
end function

'显示两个时间相差多少天，时，分，秒
function getDateDiff(var_dateSince,var_dateTill)
var_s = DateDiff("s", CDate(var_dateSince), CDate(var_dateTill))
var_d = var_s / 86400
if var_d>0 then
  var_s = var_s - 86400*var_d '如果大于天，那么减去天的秒数
  getDateDiff = getDateDiff & var_d&"天 "
end if
var_h = var_s / 3600
if var_h>0 then
  var_s = var_s - 3600*var_h '如果大于小时，那么减去小时的秒数
  getDateDiff = getDateDiff & var_h&"小时 "
end if
var_m = var_s / 60
if var_h>0 then
  var_s = var_s - 60*var_m '如果大于分钟，那么减去分钟的秒数
  getDateDiff = getDateDiff & var_m&"分钟 "
end if
getDateDiff = getDateDiff & var_s&"秒 "
end function

'小时下拉列表
'intHour 已选项
Function sHour(intHour)
Dim i
For i=0 To 9
  If i=intHour Then
   Response.Write "<option value=""0"&i&""" Selected>0"&i&"</option>"
  Else
   Response.Write "<option value=""0"&i&""">0"&i&"</option>"
  End If
Next
For i=10 To 23
  If i=intHour Then
   Response.Write "<option value="""&i&""" Selected>"&i&"</option>"
  Else
   Response.Write "<option value="""&i&""">"&i&"</option>"
  End If
Next
End Function

'分钟下拉列表
'intMinute 已选项
Function sMinute(intMinute)
If intMinute=0 Then
         Response.Write "<option value=""00"" Selected>00</option>"
         Response.Write "<option value=""15"">15</option>"
         Response.Write "<option value=""30"">30</option>"
         Response.Write "<option value=""45"">45</option>"
ElseIf intMinute=15 Then
         Response.Write "<option value=""00"">00</option>"
         Response.Write "<option value=""15"" Selected>15</option>"
         Response.Write "<option value=""30"">30</option>"
         Response.Write "<option value=""45"">45</option>"
ElseIf intMinute=30 Then
         Response.Write "<option value=""00"">00</option>"
         Response.Write "<option value=""15"">15</option>"
         Response.Write "<option value=""30"" Selected>30</option>"
         Response.Write "<option value=""45"">45</option>"
ElseIf intMinute=45 Then
         Response.Write "<option value=""00"">00</option>"
         Response.Write "<option value=""15"">15</option>"
         Response.Write "<option value=""30"">30</option>"
         Response.Write "<option value=""45"" Selected>45</option>"
Else
   Response.Write "<option value=""00"">00</option>"
         Response.Write "<option value=""15"">15</option>"
         Response.Write "<option value=""30"">30</option>"
         Response.Write "<option value=""45"">45</option>"
End If
End Function

Function FormatEnTime()
Dim y, m, d, h, mi, s
FormatEnTime = ""
'If IsDate(s_Time) = False Then Exit Function

y = cstr(month(now()))
Select Case y
case 1
  y = "Jan "
case 2
  y = "Feb "
case 3
  y = "Mar "
case 4
  y = "Apr "
case 5
  y = "May "
case 6
  y = "June "
   case 7
  y = "July "
case 8
  y = "Oct "
case 9
  y = "Sep "
case 10
  y = "Oct "
case 11
  y = "Nov "
   case 12
  y = "Dec "
   end select

   FormatEnTime = hour(now())&":"&minute(now())&":"&second(now())&"  "&y &day(now())&", " &year(now())

End Function
'================================================'
'================   金额处理======================'
'================================================'

'转换金额为人民币大写
'需要调用以下两个自定义函数toChineseNum,toChineseUnit
function toChineseAmount(num)
dim i
dim num_str
dim big_num,small_num
dim num_for
dim outputnum,outputnum1
outputnum=""
num_str=cstr(formatnumber(num,2,true,false,false))
big_num=left(num_str,len(num_str)-3)
small_num=right(num_str,2)
if len(big_num)>13 then
  response.write "所需要转换成人民币大写的数字超出系统运算范围，系统运算非正常退出....."
  response.end
end if
for i=1 to len(big_num)
  num_for=right(left(big_num,len(big_num)-i+1),1)
  if toChineseNum(num_for)="零" and (toChineseUnit(i)="元" or toChineseUnit(i)="万" or toChineseUnit(i)="亿") then '是标志位
   outputnum=toChineseUnit(i)&outputnum
  elseif toChineseNum(num_for)="零" and (toChineseUnit(i)<>"元" and toChineseUnit(i)<>"万" and toChineseUnit(i)<>"亿") then '不是标志位
   outputnum=toChineseNum(num_for)&outputnum
  else '其他情况
  outputnum=toChineseNum(num_for)&toChineseUnit(i)&outputnum
  end if
next
'将连续的零替换成一个“零”
outputnum=replace(outputnum,"零零零零","零")
outputnum=replace(outputnum,"零零零","零")
outputnum=replace(outputnum,"零零","零")
'注意替换的先后顺序,换掉标志位前的零
outputnum=replace(outputnum,"零元","元")
outputnum=replace(outputnum,"零万","万")
outputnum=replace(outputnum,"零亿","亿")
'换掉大单位到小单位造成的误差，因为只可能出现万亿，而不可能出现亿万
outputnum=replace(outputnum,"亿万","亿")
'重新考虑整数为零的情况
if big_num="0" then
  outputnum="" '将整数位设置成空
end if
'处理小数
outputnum1=""
if left(small_num,1)<>"0" then
  outputnum1=toChineseNum(left(small_num,1))&"角"
else
  if big_num="0" then
   outputnum1=""
  else
   outputnum1="零"
  end if
end if
if right(small_num,1)<>"0" then
  outputnum1=outputnum1&toChineseNum(right(small_num,1))&"分"
end if
if small_num="00" then
  outputnum1=""
end if
toChineseAmount=outputnum&outputnum1&"整"
if num_str="0.00" then
  toChineseAmount="零元整"
end if
end function

'把传入的数字字符转换成大写，通过函数返回
function toChineseNum(strT)
select case strT
  case "1"
   toChineseNum="壹"
  case "2"
   toChineseNum="贰"
  case "3"
   toChineseNum="叁"
  case "4"
   toChineseNum="肆"
  case "5"
   toChineseNum="伍"
  case "6"
   toChineseNum="陆"
  case "7"
   toChineseNum="柒"
  case "8"
   toChineseNum="捌"
  case "9"
   toChineseNum="玖"
  case "0"
   toChineseNum="零"
end select
end function

function toChineseUnit(i)
select case i
  case 1
   toChineseUnit="元"
  case 2
   toChineseUnit="拾"
  case 3
   toChineseUnit="佰"
  case 4
   toChineseUnit="仟"
  case 5
   toChineseUnit="万"
  case 6
   toChineseUnit="拾"
  case 7
   toChineseUnit="佰"
  case 8
   toChineseUnit="仟"
  case 9
   toChineseUnit="亿"
  case 10
   toChineseUnit="拾"
  case 11
   toChineseUnit="佰"
  case 12
   toChineseUnit="仟"
  case 13
   toChineseUnit="万"
end select
end function

'================================================'
'===================文件处理======================'
'================================================'
'新建一个目录
'返回目录全地址;返回-1表示失败，目录已经存在。
Function CreateFolder(str_path,str_folderName)
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
tmpPath = str_path&"/"&str_folderName
If not(fso.FolderExists(tmpPath)) Then
  Set f = fso.CreateFolder(tmpPath)
  CreateFolder = f.Path
Else
  CreateFolder = "-1"
end if
set fso = nothing
End Function

'=======删除一个目录
'=======返回1表示删除成功；返回-1表示目录不存在。
Function DeleteFolder(str_path,str_folderName)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
tmpPath = str_path&"/"&str_folderName
If (fso.FolderExists(tmpPath)) Then
  fso.DeleteFolder(tmpPath)
  DeleteFolder = "1"
else
  DeleteFolder = "-1"
end if
set fso = nothing
End function

'=======得到一个目录文件大小
Function getFolderSize(str_path,str_folderName)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
tmpPath = str_path&"/"&str_folderName
getFolderSize = 100
set fso = nothing
End function

'读配置文件
function readConfigFile(var_filePath,var_fileName)
redim arr(0)
arr(0) = "empty"
Dim fso, fileObj
dim fullPath
fullPath = var_filePath & var_fileName
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileObj = fso.OpenTextFile(server.mappath(fullPath),1,false,-2)
Do While fileObj.AtEndOfStream <> True
  if ubound(arr) = 0 and arr(0)= "empty" then
   arr(0) = trim(fileObj.Readline)
  else
   redim preserve arr(ubound(arr)+1)
   arr(ubound(arr)) = trim(fileObj.Readline)
   'response.write arr(ubound(arr))
  end if
    Loop
set fso = nothing
set fileObj = nothing
readConfigFile = deleteNull(arr)
end function

'读配置文件的指定行
function readConfigFileLine(var_filePath,var_fileName,line)
Dim fso, fileObj
dim fullPath,temp_line
fullPath = var_filePath & var_fileName
Set fso = CreateObject("Scripting.FileSystemObject")
Set fileObj = fso.OpenTextFile(server.mappath(fullPath),1,false,-2)
for i = 2 to line
fileObj.SkipLine
if fileObj.AtEndOfStream = true then exit for
next
temp_line = trim(fileObj.Readline)
set fso = nothing
set fileObj = nothing
readConfigFileLine = temp_line
end function

'物理删除文件
function deletefile(fileName)
Dim erase_tag
erase_tag = false
Set fso = CreateObject("Scripting.FileSystemObject")
fileName=Server.mappath(fileName)
if fso.FileExists(fileName) then
  fso.DeleteFile fileName,True
  erase_tag = true
end If
If erase_tag = False Then
  response.write "删除失败，文件没找到"
  response.write filename
  response.End
End If
set fso = nothing
deletefile = erase_tag
end Function

'得到后缀名
function getDotFileName(longFileName)
tmp_arr = split(longFileName,".")
if isarray(tmp_arr) then
getDotFileName = tmp_arr(ubound(tmp_arr))
else
getDotFileName = ""
end if
end function

'得到不包含后缀名的短文件名
function getShortFileName(longFileName)
tmp_shorFileName = ""
tmp_arr = split(longFileName,".")
if isarray(tmp_arr) then
  for j=0 to ubound(tmp_arr)-1
   if tmp_shorFileName = "" then
    tmp_shorFileName = tmp_arr(j)
   else
    tmp_shorFileName = tmp_shorFileName&"."&tmp_arr(j)
   end if
  next
end if
getShortFileName = tmp_shorFileName
end function

'判断文件是否存在，存在就 file(1).xxx
Function getUniqueFileName(filePath,fileName)
Set fso = CreateObject("Scripting.FileSystemObject")
tmp_filePath = server.mappath(filePath)&"/"& fileName
if not fso.FileExists(tmp_filePath) then  '没有这个文件
  getUniqueFileName = fileName
else '有这个文件，则(1),(2)...去匹配
  for q=1 to 100
   getUniqueFileName = getShortFileName(fileName)&"("&cstr(q)&")."& getDotFileName(fileName)
   tmp_filePath = server.mappath(filePath)&"/"& getUniqueFileName
   if not fso.FileExists(tmp_filePath) then
    exit for
   end if
  next
end if
set fso = nothing
end function

'判断文件是否符合后缀名要求
function isPermission(dotFileName)
isPermission = false
tmp_arr = split(conf_formatPermission,",")
if isarray(tmp_arr) then
  for ini = 0 to ubound(tmp_arr)
   if UCase(tmp_arr(ini)) = UCase(dotFileName) then
    isPermission = true
    exit for
   end if
  next
end if
end function

'================================================'
'===================其他处理======================'
'================================================'
'变换1024为1k，1204k为1m。。。
Function getRegularSize(longSize)
oneK = 1024
oneM = oneK * oneK
oneG = oneM * oneK
if IsNumeric(longSize) then
  if longSize < oneK then
   getRegularSize = longSize & " B"
  elseif oneK <= longSize and longSize < oneM then
   getRegularSize = FormatNumber(longSize/oneK,2) & " KB"
  elseif oneM <= longSize and longSize <oneG then
   getRegularSize = FormatNumber(longSize/oneM,2) & " MB"
  else
   getRegularSize = FormatNumber(longSize/oneG,2) & " GB"
  end if
else
  getRegularSize = ""
end if
End Function

function showIcon(str_FileName) '显示图标
tmp_icon = "icon_unknow.gif"
tmp_arrF = to_array(str_FileName,".")
if isArray(tmp_arrF) then
  tmp_extName = tmp_arrF(ubound(tmp_arrF))
  Select Case UCase(tmp_extName)
           Case "BMP"    tmp_icon = "icon_bmp.gif"
           Case "DOC"    tmp_icon = "icon_doc.gif"
           Case "GIF"    tmp_icon = "icon_gif.gif"
           Case "HTM"    tmp_icon = "icon_htm.gif"
           Case "HTML"   tmp_icon = "icon_htm.gif"
           Case "JPG"    tmp_icon = "icon_jpg.gif"
           Case "PDF"    tmp_icon = "icon_pdf.gif"
           Case "PPT"    tmp_icon = "icon_ppt.gif"
           Case "RAR"    tmp_icon = "icon_rar.gif"
           Case "RM"     tmp_icon = "icon_rm.gif"
           Case "TXT"    tmp_icon = "icon_txt.gif"
           Case "VSD"    tmp_icon = "icon_vsd.gif"
           Case "XLS"    tmp_icon = "icon_xls.gif"
           Case "ZIP"    tmp_icon = "icon_zip.gif"
           Case Else     tmp_icon = "icon_unknow.gif"
        End Select
end if
showIcon = "<img border='0' src='../Images/"&tmp_icon&"' align='absmiddle'> "
end function

'显示条形图
sub putPercent(str1,str2,str3,str4) '分子，分母，图片，长度
strStr = (str1/str2)*100
strWidth = str4*strStr/100
response.write "<TABLE><TR ><TD><IMG src='/images/"&str3&"' width="&strWidth&" height='10' align='absmiddle'></TD><TD width='200' ><SPAN class='v1'> "&formatnumber(strStr,2)&"% "&str1&"票</SPAN></TD></TR></TABLE>"
end sub

'打印到页面
sub debug(field,value,breaktag)
response.write field&":["&value&"]<br>"
if breaktag = 1 then
response.end
end if
end sub

'打印到select的option中   只能是一唯数组
sub putOptionsFromArray(arr,selectedID,tag)
if isarray(arr) then
  if tag = 0 then
   for x=0 to ubound(arr)
    if trim(selectedID)= cstr(x) then
     response.write "<option value="&x&" selected>"&arr(x)&"</option>"
    else
     response.write "<option value="&x&" >"&arr(x)&"</option>"
    end if
   next
  else
   for x=0 to ubound(arr)
    tmpValue = Replace(Trim(arr(x))," ","")
    if trim(selectedID)= tmpValue then
     response.write "<option value="&tmpValue&" selected>"&arr(x)&"</option>"
    else
     response.write "<option value="&tmpValue&" >"&arr(x)&"</option>"
    end if
   next
  end if
end if
end Sub

'打印到select的option中   只能是2唯数组
'arr = (eleka,汪文海) (pucca,钱虹)
'<option value="eleka" selected>汪文海</option>
'<option value="pucca" selected>钱虹</option>
sub putOptionsFromArray2(arr,selectedID)
Dim x
if isarray(arr) then
  for x=0 to ubound(arr,2)
   if trim(selectedID)= cstr(arr(0,x)) then
    response.write "<option value='"&arr(0,x)&"' selected>"&arr(1,x)&"</option>"
   else
    response.write "<option value='"&arr(0,x)&"' >"&arr(1,x)&"</option>"
   end if
  next
end if
end Sub

'打印到select的option中   只能是2唯数组,去其中的一唯
'arr = (eleka,汪文海) (pucca,钱虹)
'<option value="汪文海" selected>汪文海</option>
'或<option value="pucca" selected>pucca</option>
sub putOptionsFromArray3(arr,selectedID,num)
Dim x
if isarray(arr) then
  for x=0 to ubound(arr,2)
   if trim(selectedID)= cstr(arr(num,x)) then
    response.write "<option value='"&arr(num,x)&"' selected>"&arr(num,x)&"</option>"
   else
    response.write "<option value='"&arr(num,x)&"' >"&arr(num,x)&"</option>"
   end if
  next
end if
end Sub
'将数字转换成对应数组中的内容
function getOptionsFromArray(ID,arr)
if isarray(arr) then
  for y = 0 to ubound(arr)
   if asc(ID) = asc(y) then temp_options = arr(y)
  next
end if
getOptionsFromArray = temp_options
end function

'生成N位随机数
function getRan(num)
Dim RanValue
if IsNumeric(num) then
  Randomize
  RanValue = Int((10^num * Rnd) + 1)
  RanValue = leftZero(num,RanValue)
  getRan = RanValue
else
  getRan = 0
end if
end function

'生成0到N的随机数
function getNRan(num)
if IsNumeric(num) then
  Randomize
  getNRan = Int((num * Rnd) + 1)
else
  getNRan = 0
end if
end function

'将一个数向上取整
function getMaxInt(num)
if IsNumeric(num) then
  if num > int(num) then
   getMaxInt = int(num) + 1
  else
   getMaxInt = num
  end if
else
  getMaxInt = 0
end if
end function

'Function IsValidEmail(Email)
'ValidFlag = False
'If (Email <> "") And (InStr(1, Email, "@") > 0) And (InStr(1, Email, ".") > 0) Then
'atCount = 0
'SpecialFlag = False
'For atLoop = 1 To Len(Email)
'atChr = Mid(Email, atLoop, 1)
'If atChr = "@" Then atCount = atCount + 1
'If (atChr >= Chr(32)) And (atChr <= Chr(44)) Then SpecialFlag = True
'If (atChr = Chr(47)) Or (atChr = Chr(96)) Or (atChr >= Chr(123)) Then SpecialFlag = True
'If (atChr >= Chr(58)) And (atChr <= Chr(63)) Then SpecialFlag = True
'If (atChr >= Chr(91)) And (atChr <= Chr(94)) Then SpecialFlag = True
'Next
'If (atCount = 1) And (SpecialFlag = False) Then
'BadFlag = False
'tAry1 = Split(Email, "@")
'UserName = tAry1(0)
'DomainName = tAry1(1)
'If (UserName = "") Or (DomainName = "") Then BadFlag = True
'If Mid(DomainName, 1, 1) = "." then BadFlag = True
'If Mid(DomainName, Len(DomainName), 1) = "." then BadFlag = True
'ValidFlag = True
'End If
'End If
'If BadFlag = True Then ValidFlag = False
'IsValidEmail = ValidFlag
'End Function

'求数组中最小值
function minFromArr(Arr)
Dim i,tmpMin
for i = 0 to ubound(Arr)
  if i = 0 then
   tmpMin = csng(Arr(i))
  else
   if csng(Arr(i)) < tmpMin then tmpMin = csng(Arr(i))
  end if
next
minFromArr = tmpMin
end function

'添加千位分隔符
function addSeparate(strEx,tag)
dim arrStrEx(2),index,tempStr
index = instr(1,cstr(strEx),".",1)
'response.write index
if index = 0 then
  arrStrEx(0) = cstr(strEx)
  arrStrEx(1) = "00"
else
  tempStr = split(strEx,".",-1)
  arrStrEx(0) = tempStr(0)
  arrStrEx(1) = tempStr(1)
end if
if len(arrStrEx(0))>=4 and len(arrStrEx(0))<=6 then
  strEx = cstr(left(arrStrEx(0),len(arrStrEx(0))-3))&tag&cstr(right(arrStrEx(0),3))&"."&arrStrEx(1)
elseif len(arrStrEx(0))>=7 and len(arrStrEx(0))<=9 then
  strEx = cstr(left(arrStrEx(0),len(arrStrEx(0))-6))&tag&cstr(mid(arrStrEx(0),len(arrStrEx(0))-5,3))&tag&cstr(right(arrStrEx(0),3))&"."&arrStrEx(1)
elseif len(arrStrEx(0))>=10 then
  strEx = cstr(left(arrStrEx(0),len(arrStrEx(0))-9))&tag&cstr(mid(arrStrEx(0),len(arrStrEx(0))-8,3))&tag&cstr(mid(arrStrEx(0),len(arrStrEx(0))-5,3))&tag&cstr(right(arrStrEx(0),3))&"."&arrStrEx(1)
else
  strEx = strEx
end if
addSeparate = strEx
end function