创建文件夹
作者:cmscn 日期:2009-08-12
'==================================================
'函数名:BuildFolder
'作 用:创建文件夹
'参 数:path ----------要创建的文件夹(路径)
'==================================================
function BuildFolder(path)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.CreateFolder(Server.MapPath(path))
fso.Close
Set fso=Nothing
End Function
'==================================================
'函数名:Buildfile
'作 用:创建文件
'参 数:Htmlcode ------要创建的文件信息
'参 数:filex ----------要创建的文件名(路径)
'==================================================
function Buildfile(filex,Htmlcode)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set html = fso.CreateTextFile(Server.MapPath(filex))
html.WriteLine Htmlcode
html.close
Set html=Nothing
fso.Close
Set fso=Nothing
End Function
'==================================================
'函数名:Savefile
'作 用:修改文件
'参 数:file_body ------要创建的文件信息
'参 数:file_name ------要创建的文件名(路径)
'参 数:Cset -----------定义要创建的文件编码
'==================================================
Function Savefile(file_body,file_name,Cset)
Set OS=Server.CreateObject("ADODB.Stream")
OS.Type=2
OS.Open
OS.Charset = Cset
OS.Position=OS.Size
OS.WriteText=file_body
OS.SaveToFile Server.MapPath(file_name),2
OS.Close
Set OS=Nothing
End Function
'==================================================
'函数名:DelFolder
'作 用:删除文件夹
'参 数:FolderPath ------要删除的文件夹路径
'==================================================
Function DelFolder(FolderPath)
dim path
path=FolderPath
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set DeleteFolder = FSO.GetFolder(Server.MapPath(path))
DeleteFolder.Delete
fso.Close
Set fso=Nothing
Response.Write("<script language=""Javascript"">alert(""文件夹已删除"");history.go(-1);</script>")
End Function
'==================================================
'函数名:ChkFile
'作 用:检索文件是否存在
'参 数:FilePath ------要检索的文件路径
'==================================================
Function ChkFile(FilePath)
dim path
path=Server.MapPath(FilePath)
Set fso=Server.CreateObject("Scripting.FileSystemObject")
If fso.FileExists(path) then
ChkFile="OK!"
Else
ChkFile="文件不存在"
End IF
fso.Close
Set fso=Nothing
End Function
'==================================================
'函数名:DelFile
'作 用:删除文件
'参 数:FilePath ------要删除的文件的路径
'==================================================
Function DelFile(FilePath)
dim path
path=Server.MapPath(FilePath)
Set fso = Server.CreateObject("Scripting.FileSystemObject")
'用两种方法删除文件
fso.DeleteFile(path)'第一种方法
Set File= FSO.GetFile(path)'第二种方法
File.Delete
fso.Close
Set fso=Nothing
End Function
'===========================专门用来过滤Request的参数值===================================
function GetVariable(strVariableName)
if IsEmpty(Request(strVariableName)) then
GetVariable=empty
exit Function
end if
GetVariable=Replace(Request(strVariableName),"'","''")
GetVariable=Replace(GetVariable,";","")
GetVariable=Replace(GetVariable,"--","")
end function
function GetFormVariable(strVariableName)
if IsEmpty(Request.Form(strVariableName)) then
GetFormVariable=empty
exit Function
end if
GetFormVariable=Replace(Request.Form(strVariableName),"'","''")
GetFormVariable=Replace(GetFormVariable,"--","")
end function
function GetQueryString(strVariableName)
if IsEmpty(Request.QueryString(strVariableName)) then
GetQueryString=empty
exit Function
end if
GetQueryString=Replace(Request.QueryString(strVariableName),"'","''")
GetQueryString=Replace(GetQueryString,";","")
GetQueryString=Replace(GetQueryString,"--","")
end function
'===========================专门用来过滤Request的参数值===================================
'**********************************************************************************************
'函数名称: HTMLcode(fString)
'函数功能: 过滤表单的特殊字符
'参数说明: fString 要操作的字符串
'返回值 : 格式化的字符串
'**********************************************************************************************
Function HTMLcode(fString)
if not isnull(fString) then
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(9), " ")
fString = Replace(fString, CHR(34), """)
fString = Replace(fString, CHR(39), "'")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "</P><P> ")
fString = Replace(fString, CHR(10), "<BR> ")
HTMLcode = fString
end if
end Function
'**********************************************************************************************
'函数名称: GetTrueLength(strChinese, lenMaxWord, strSpaceBar)
'函数功能: 截取正确的英文/汉字长度
'参数说明: strChinese 为被检测字符串
' lenMaxWord 为限制的字符长度
' strSpaceBar 为要过滤(去掉)的字符
'返回 值 : 格式化的字符串(注:一个中文两个字符。)
'**********************************************************************************************
Function GetTrueLength(strChinese, lenMaxWord, strSpaceBar)
dim i, j, strTail, lenTotal, lenWord, lenNow
dim strWord, bOverFlow, RetString
if strChinese = "" or vartype(strChinese) = vbNull or CLng(lenMaxWord) <= 0 then
GetTrueLength = ""
exit function
end if
strTail = "..." '标题截取后的表示,如“…”
bOverFlow = False
lenTotal = 0
for i=1 to Len(strChinese)
strWord = mid(strChinese, i, 1)
if asc(strWord) < 0 or asc(strWord) > 127 then
lenTotal = lenTotal + 2
else
lenTotal = lenTotal + 1
end if
next
'判断字符是否溢出
if lenTotal > lenMaxWord then bOverFlow = True
strSpaceBar = ""
if bOverFlow = True then
'字符溢出,去尾
lenWord = 0
RetString = ""
for i=1 to Len(strChinese)
strWord = mid(strChinese, i, 1)
if asc(strWord) < 0 or asc(strWord) > 127 then lenNow = 2 else lenNow = 1
lenWord = lenWord + lenNow
'截掉多余部分
if lenWord <= (lenMaxWord - Len(strTail)) then
RetString = RetString + strWord
else
RetString = RetString + strTail
lenWord = lenWord + Len(strTail) - lenNow
if (lenMaxWord-lenWord)>0 then
for j =1 to lenMaxWord-lenWord
strSpaceBar = strSpaceBar + " "
next
end if
GetTrueLength = RetString
exit for
end if
next
else
'字符不溢出,填充空位
RetString = strChinese
if (lenMaxWord-lenTotal)>0 then
for i =1 to lenMaxWord-lenTotal
strSpaceBar = strSpaceBar + " "
next
end if
GetTrueLength = RetString ''''''''''& strSpaceBar
end if
end function