code.asp

本程序采用ACC数据核心构件！！ 功能介绍： 程序代码重新设计与优化

<%
'=====================================================================
' 文件名称：Code.Asp
' 更新日期：2007-5-23
function htmlencode(String1)
htmlencode=replace(String1,"'","")
'htmlencode=replace(htmlencode,"=","≡")
'htmlencode=replace(htmlencode,chr(13)&chr(10),"<br>")
htmlencode=replace(htmlencode," ","")
htmlencode=replace(htmlencode,"<","&lt;")
htmlencode=replace(htmlencode,">","&gt;")
end function

function htmldecode(String1)
htmldecode=replace(String1,chr(13),"<br>")
end function

Function GetRndPassword(PasswordLen)
    Dim Ran, i, strPassword
    strPassword = ""
    For i = 1 To PasswordLen
        Randomize
        Ran = CInt(Rnd * 2)
        Randomize
        If Ran = 0 Then
            Ran = CInt(Rnd * 25) + 97
            strPassword = strPassword & UCase(Chr(Ran))
        ElseIf Ran = 1 Then
            Ran = CInt(Rnd * 9)
            strPassword = strPassword & Ran
        ElseIf Ran = 2 Then
            Ran = CInt(Rnd * 25) + 97
            strPassword = strPassword & Chr(Ran)
        End If
    Next
    GetRndPassword = strPassword
End Function

'**************************************************
'函数名：ReplaceBadChar
'作  用：过滤非法的SQL字符
'参  数：strChar-----要过滤的字符
'返回值：过滤后的字符
'**************************************************
Public Function ReplaceBadChar(strChar)
    If strChar = "" Or IsNull(strChar) Then
        ReplaceBadChar = ""
        Exit Function
    End If
    Dim strBadChar, arrBadChar, tempChar, i
    strBadChar = "',%,^,&,?,(,),<,>,[,],{,},/,\,;,:," & Chr(34) & "," & Chr(0) & ""
    arrBadChar = Split(strBadChar, ",")
    tempChar = strChar
    For i = 0 To UBound(arrBadChar)
        tempChar = Replace(tempChar, arrBadChar(i), "")
    Next
    ReplaceBadChar = tempChar
End Function
'***************************************************
'检查组件是否已经安装
'***************************************************
Function IsObjInstalled(strClassString1)
	On Error Resume Next
	IsObjInstalled = False
	Err = 0
	Dim xTestObj
	Set xTestObj = Server.CreateObject(strClassString1)
	If 0 = Err Then IsObjInstalled = True
	Set xTestObj = Nothing
	Err = 0
End Function
'***************************************************
'保存远程文件
'***************************************************
Function GetRemoteFiels(RemotePath, LocalPath, FileName)
	Dim strBody
	Dim FilePath
	On Error Resume Next
	strBody = GetBodyUrl(RemotePath)
	FilePath = Server.MapPath(LocalPath & GetFileName(RemotePath, FileName))
	'保存文件
	if SaveToFile(strBody, FilePath) = true and err.Number = 0 then
		GetRemoteFiles = true
	else
		GetRemoteFiles = false
	end if
End Function 
Function GetBodyUrl(url)
	Dim Retrieval
	Set Retrieval = CreateObject("Microsoft.XMLHTTP")
	With Retrieval
	.Open "Get", url, False, "", ""
	.Send
	GetBodyUrl = .ResponseBody
	End With
	Set Retrieval = Nothing
End Function
Function GetFileName(RemotePath, FileName)
	'Dim arrTmp
	Dim strFileExt
	arrTmp = Split(RemotePath, ".")
	'strFileExt = arrTmp(UBound(arrTmp))
	GetFileName = FileName & ".html"
End Function
Function SaveToFile(Stream, FilePath)
	Dim objStream
	On Error Resume Next
	Set objStream = Server.CreateObject("ADODB.Stream")
	objStream.Type = 1
	objStream.Open
	objstream.write Stream
	objstream.SaveToFile FilePath, 2
	objstream.Close()
	Set objstream = Nothing
	if err.Number <> 0 then
		SaveToFile = false
	else
		SaveToFile = true
	end if
End Function
%>