|
'================================================
'函数名：CreatedPathEx
'作 用：FSO创建多级目录
'参 数：LocalPath ----原文件路径
'返回值：False ---- True
'================================================
Public Function CreatedPathEx(ByVal sPath)
sPath = Replace(sPath, "/", "\")
sPath = Replace(sPath, "\\", "\")
On Error Resume Next
Dim strHostPath,strPath
Dim sPathItem,sTempPath
Dim i,fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
strHostPath = Server.MapPath("/")
If InStr(sPath, ":") = 0 Then sPath = Server.MapPath(sPath)
If fso.FolderExists(sPath) Or Len(sPath) < 3 Then
CreatedPathEx = True
Exit Function
End If
strPath = Replace(sPath, strHostPath, vbNullString,1,-1,1)
sPathItem = Split(strPath, "\")
If InStr(LCase(sPath), LCase(strHostPath)) = 0 Then
sTempPath = sPathItem(0)
Else
sTempPath = strHostPath
End If
For i = 1 To UBound(sPathItem)
If sPathItem(i) <> "" Then
sTempPath = sTempPath & "\" & sPathItem(i)
If fso.FolderExists(sTempPath) = False Then
fso.CreateFolder sTempPath
End If
End If
Next
Set fso = Nothing
If Err.Number <> 0 Then Err.Clear
CreatedPathEx = True
End Function
'--删除文件
Public Function DeleteFiles(ByVal sFilePath)
On Error Resume Next
Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
fso.DeleteFile sFilePath, True
DeleteFiles = True
Set fso = Nothing
Exit Function
End Function
'=============================================================
'函数名：ChkFormStr
'作 用：过滤表单字符
'参 数：str ----原字符串
'返回值：过滤后的字符串
'=============================================================
Public Function FormatStr(ByVal str)
Dim fString
fString = str
If Len(str) = 0 Then
FormatStr = ""
Exit Function
End If
fString = Replace(fString, "'", "'")
fString = Replace(fString, Chr(34), """)
fString = Replace(fString, Chr(13), "")
fString = Replace(fString, Chr(10), "")
fString = Replace(fString, Chr(9), "")
fString = Replace(fString, ">", ">")
fString = Replace(fString, "<", "<")
fString = Replace(fString, "%", "％")
FormatStr = Trim(fString)
End Function
End Class
Public Sub OutErrors(msg)
Response.Write "<script language=""javascript"">" & vbCrLf
Response.Write "alert(""" & Replace(Replace(Replace(msg, "<li>", "", 1, -1, 1), "</li>", "\n", 1, -1, 1), """", "\""") & """);"
Response.Write "history.back();" & vbCrLf
Response.Write "</script>" & vbCrLf
Response.Flush
End Sub
Public Sub OutScript(msg)
Response.Write "<script language=""javascript"">" & vbCrLf
Response.Write "alert(""" & Replace(Replace(Replace(msg, "<li>", "", 1, -1, 1), "</li>", "\n", 1, -1, 1), """", "\""") & """);"
Response.Write "location.replace(""" & Request.ServerVariables("HTTP_REFERER") & """);" & vbCrLf
Response.Write "</script>" & vbCrLf
Response.Flush: Response.End
End Sub
Public Sub ReturnError(ErrMsg)
Response.Write "<br><br><table cellpadding=5 cellspacing=1 border=0 align=center class=tableBorder1>" & vbCrLf
Response.Write " <tr><th colspan=2>错误提示信息!</th></tr>" & vbCrLf
Response.Write " <tr><td colspan=2 align=center height=50 class=TableRow1>" & ErrMsg & "</td></tr>" & vbCrLf
Response.Write "</table><br>" & vbCrLf
Response.Flush
End Sub
'================================================
'函数名：ShowListPage
'作 用：通用分页
'================================================
Public Function ShowListPage(ByVal CurrentPage, ByVal Pcount, ByVal totalrec, ByVal PageNum, ByVal strLink, ByVal ListName)
With Response
.Write "<script>"
.Write "ShowListPage("
.Write CurrentPage
.Write ","
.Write Pcount
.Write ","
.Write totalrec
.Write ","
.Write PageNum
.Write ",'"
.Write strLink
.Write "','"
.Write ListName
.Write "');"
.Write "</script>" & vbNewLine
End With
End Function
'-- 连接数据库
Sub DatabaseConnection()
On Error Resume Next
Set MyConn = Server.CreateObject("ADODB.Connection")
MyConn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & ChkMapPath(DBPath)
If Err Then
Err.Clear
Set MyConn = Nothing
Response.Write "数据库连接出错，请打开conn.asp检查采集数据库连接字串。"
Response.End
End If
IsConnection = True
End Sub
%>
共7页: 上一页 [1] [2] [3] [4] [5] [6] 7 下一页
|
