'==================取除左右括号============================
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