分类： 系统运维
2008-06-27 09:08:49
'option explicit
'001.function lpad(desstr,padchar,lenint) 左填充
'002.function rpad(desstr,padchar,lenint) 右填充
'003.function MakeRndPass(passlen,passtype) 生成随机密码
'004.function readFile(filepath) 读文件
'005.function WriteFile(filepath,fileContent) 写文件
'006.function DelFile(filepath) 删除文件
'007.sub alert(str,weburl) 弹出对话框
'008.function max(info) 取最大值
'009.function min(info) 取最小值
'010.function get1stMonth() 返回本月第一天的日期
'011.function get1stYear() 返回本年第一天的日期
'012.function get1stWeek() 返回本周第一天的日期
'013.function get1stQua() 返回本季度第一天的日期
'014.function ShowArticleContent() 分页显示长文章内容
'015.function IsObjInstalled() 检查组件是否已经安装
'016.function isHTTP() 检查字符串是否以HTTP开头或以"/"开头
'017.function strLength() 求字符串长度
'018.function checkNull() 检查str是否为空
'019.function getHTTPPage() 获取远程的网页内容
'020.function SendMailEx() 例如利用Jmail发信，适合于smtp需要验证的情况
'021.Function nohtml(str,strlen) 去掉所有html标记,并截取相应长度的字符串
'022.Function splitCount(str,splitchar) 拆分字符串,取拆分后的子串数
'023.function checkIMG(str) 检查字符中是否有IMG字样
'024.function doWrap() 解决DW显示字段值不能换行的问题
'025.function deleteparm() 删除指定网页参数中的某一项
'026.function findStr() 按分隔符查找字符串，找到返回True
'027.function makeID() 产生20位长度的唯一标识ID
'028.function findparm() 查询网页参数字符中某项的值
'029.function showIMG() 显示图片
'030.function showSWF() 显示flash,rm等
'031.function showRm() 播放rm
'032.function orderImg() 用于列标题排序时后面加上下箭头
'033.function orderURL() 用于列标题排序时生成相应地址
'034.function showPage() 用于显示翻页导航
'035.function DoDelFile() 删除文件,必须使用虚拟路径
'036.function Format_Time() 格式化日期
'037.function outHTML() 显示输出html代码
'038.function inHTML() 显示输出html代码,一般放在input框的值中
'039.IsSelfRefer() 是否从本站提交
'040.Get_SafeStr() 取得安全字符
'041.JimmyCode() 过滤html相关标记
'042.Function makeMonthDir() 上传时生成自动目录
'043.Function imgUpload() 利用aspJpeg,aspUpload上传图片,并自动生成缩略图
'上传图片(需要aspupload,aspjpeg支持,上传时会自动根据参数,按比例)
'参数:
'with small :上传图片时,是否同步生成小的缩略图(true是 false否)
'bigwidth:大图片的规定宽度
'bigheight:大图片的规定高度
'smallwidth:小图片的规定宽度
'smallheight:小图片的规定高度
'virturaluploadPath:上传的虚拟路径
'maxsize:上传图片的最大尺寸(字节,1K=1024字节)
'response.write imgUpload(true,700,400,150,200,"/upload",1024*100)
Function imgUpload(withSmall,bigWidth,bigHeight,smallWidth,smallHeight,virturluploadPath,maxSize)
imgUpload = ""
dim Upload,Jpeg,tempFile,File,scale
if (not IsObjInstalled("Persits.Upload")) or (not IsObjInstalled("Persits.Jpeg")) then
response.write "尚未安装 ASPUpload 和 ASPJpeg组件 !"
exit function
end if
Set Upload = Server.CreateObject("Persits.Upload")
Set Jpeg = Server.CreateObject("Persits.Jpeg")
Upload.OverwriteFiles = True '如果存在文件,强制overwrite
Upload.SetMaxSize maxSize, True '设置最大上传值 1K为1024,100K为100*1024
on error resume next
Upload.Save '上传到服务器内存中
if Err.Number = 8 then
response.write "文件太大,只允许上传" & formatnumber(maxSize/1024,0) & "K以内的图片文件!"
exit function
end if
For Each File in Upload.Files
If not(File.ImageType = "JPG" or File.ImageType = "GIF" or File.ImageType ="PNG") Then
Response.Write "只允许上传有效的图片文件(如GIF,PNG,JPEG,JPG)."
File.Delete '如果是非法图片,则删除掉
Response.End
Else
tempfile =makeMonthDir(virturluploadPath,true) & MakeID() & File.Ext
imgupload = imgupload & "|" & tempfile
File.SaveAs server.mappath(tempFile) '自动重命名并保存到指定路径中
End If
Jpeg.Open File.Path
scale = resizeImg(Jpeg.OriginalWidth,Jpeg.OriginalHeight,bigwidth,bigheight)
Jpeg.Width = Jpeg.OriginalWidth * Scale
Jpeg.Height = Jpeg.OriginalHeight * Scale
Jpeg.Save makeMonthDir(virturluploadPath,false) & File.FileName '调整大图片大小
if withSmall then
scale = resizeImg(Jpeg.OriginalWidth,Jpeg.OriginalHeight,smallWidth,smallheight)
Jpeg.Width = Jpeg.OriginalWidth * Scale
Jpeg.Height = Jpeg.OriginalHeight * Scale
Jpeg.Save makeMonthDir(virturluploadPath,false) & "small_" & File.FileName '调整小图片大小
end if
Next
Set Upload = Nothing
Set Jpeg = Nothing
if left(imgUpload,1)="|" then imgUpload = right(imgupload,len(imgupload)-1)
End Function
'重新设定图片大小,返回百分比
function resizeImg(ox,oy,nx,ny)
resizeimg = 1
If ox<=nx And oy<=ny Then Exit function
dim x,y
'先算x
x = ny * ox / oy
if x > nx then 'x不行
y = nx * oy / ox
resizeImg = y / oy
else
resizeImg = x / ox
end if
resizeImg = formatNumber(resizeImg,4)
end function
'042
'上传时生成自动目录(以2005_6 类似的名称)
Function makeMonthDir(vitualRoot,virtual)
Dim dirName,dirNameV,fso
dirNameV = vitualRoot & "/" & Year(Now()) & "_" & Month(Now())
dirName = server.MapPath(dirNameV)
'response.write DirName & "
"
Set fso = server.CreateObject("Scripting.FileSystemObject")
if not fso.FolderExists(dirName) then
fso.CreateFolder(dirName)
end if
set fso = Nothing
If virtual Then
makeMonthDir = dirNameV & "/"
Else
makeMonthDir = dirName & "\"
End if
End Function
'035
' 删除指定的文件,必须传入虚拟路径
Sub DoDelFile(sPathFile)
On Error Resume Next
Dim oFSO
Set oFSO = Server.CreateObject("Scripting.FileSystemObject")
'response.write "
" & Server.MapPath(sPathFile)
oFSO.DeleteFile(Server.MapPath(sPathFile))
Set oFSO = Nothing
End Sub
'036
' ============================================
' 格式化时间(显示)
' 参数：n_Flag
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' 6:"MM/DD"
' ============================================
Function Format_Time(s_Time, n_Flag)
Dim y, m, d, h, mi, s
Format_Time = ""
If IsDate(s_Time) = False Then Exit Function
y = cstr(year(s_Time))
m = cstr(month(s_Time))
If len(m) = 1 Then m = "0" & m
d = cstr(day(s_Time))
If len(d) = 1 Then d = "0" & d
h = cstr(hour(s_Time))
If len(h) = 1 Then h = "0" & h
mi = cstr(minute(s_Time))
If len(mi) = 1 Then mi = "0" & mi
s = cstr(second(s_Time))
If len(s) = 1 Then s = "0" & s
Select Case n_Flag
Case 1
' yyyy-mm-dd hh:mm:ss
Format_Time = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
Format_Time = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
Format_Time = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
Format_Time = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
Format_Time = y & m & d
Case 6
'mm/dd
Format_Time = m & "/" & d
case 7
Format_Time = m & "/" & d & "/" & right(y,2)
End Select
End Function
'037
' ============================================
' 把字符串进行HTML解码,替换server.htmlencode
' 去除Html格式，用于显示输出
' ============================================
Function outHTML(str)
Dim sTemp
sTemp = str
outHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
sTemp = Replace(sTemp, Chr(10), "
")
outHTML = sTemp
End Function
'038
' ============================================
' 去除Html格式，用于从数据库中取出值填入输入框时
' 注意：value="?"这边一定要用双引号
' ============================================
Function inHTML(str)
Dim sTemp
sTemp = str
inHTML = ""
If IsNull(sTemp) = True Then
Exit Function
End If
sTemp = Replace(sTemp, "&", "&")
sTemp = Replace(sTemp, "<", "<")
sTemp = Replace(sTemp, ">", ">")
sTemp = Replace(sTemp, Chr(34), """)
inHTML = sTemp
End Function
'039
' ============================================
' 检测上页是否从本站提交
' 返回:True,False
' ============================================
Function IsSelfRefer()
Dim sHttp_Referer, sServer_Name
sHttp_Referer = CStr(Request.ServerVariables("HTTP_REFERER"))
sServer_Name = CStr(Request.ServerVariables("SERVER_NAME"))
If Mid(sHttp_Referer, 8, Len(sServer_Name)) = sServer_Name Then
IsSelfRefer = True
Else
IsSelfRefer = False
End If
End Function
'040
' ============================================
' 得到安全字符串,在查询中使用
' ============================================
Function Get_SafeStr(str)
Get_SafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "")
End Function
' ============================================
' 取实际字符长度
' ============================================
Function Get_TrueLen(str)
Dim l, t, c, 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
Next
Get_TrueLen = t
End Function
' ============================================
' 判断是否安全字符串,在注册登录等特殊字段中使用
' ============================================
Function IsSafeStr(str)
Dim s_BadStr, n, i
s_BadStr = "' &<>?%,;:()`~!@#$^*{}[]|+-=" & Chr(34) & Chr(9) & Chr(32)
n = Len(s_BadStr)
IsSafeStr = True
For i = 1 To n
If Instr(str, Mid(s_BadStr, i, 1)) > 0 Then
IsSafeStr = False
Exit Function
End If
Next
End Function
'================================================
' 显示解释函数，返回根据参数允许显示的格式字符串，具体调用方法可从后台管理获得
' 输入参数：
' s_Content : 要转换的数据字符串
' s_Filters : 要过滤掉的格式集，用逗号分隔多个
'================================================
Function jimmycode(s_Content, sFilters)
Dim a_Filter, i, s_Result, s_Filters
jimmycode = s_Content
If IsNull(s_Content) Then Exit Function
If s_Content = "" Then Exit Function
's_Content = Replace(s_Content, Chr(10), "
")
s_Result = s_Content
s_Filters = sFilters
' 设置默认过滤
If sFilters = "" Then s_Filters = "script,object"
a_Filter = Split(s_Filters, ",")
For i = 0 To UBound(a_Filter)
s_Result = jimmycodeFilter(s_Result, a_Filter(i))
Next
jimmycode = s_Result
End Function
' ===============================================
' 初始化下拉框
' s_FieldName : 返回的下拉框名
' a_Name : 定值名数组
' a_Value : 定值值数组
' v_InitValue : 初始值
' s_Sql : 从数据库中取值时,select name,value from table
' s_AllName : 空值的名称,如:"全部","所有","默认"
' ===============================================
Function InitSelect(s_FieldName, a_Name, a_Value, v_InitValue, s_Sql, s_AllName,s_onchange)
Dim i
InitSelect = ""
End Function
%>
