?? inc_function.asp
字號:
<%
'┌─ 風云ASP在線 ────────────────────────┐
'│ │
'│ 作者：趙振波. http://www.fyasp.com │
'│ │
'│ Q Q：185623333 │
'│ │
'│ Email：fy96@163.com │
'│ │
'│ 程序定做，系統開發，網站制作，提供高質量的網絡產品、技術和服務！│
'│ │
'│【版權聲明】 │
'│ │
'│ 本程序版權歸坐看風云所有，未經授權擅自修改、復制或散布本程序│
'│ │
'│的部分或全部，將承受嚴厲的民事和刑事處罰，對已知的違反者將給予法 │
'│ │
'│律范圍內的全面制裁。對非法使用此程序所造成的一切后果本人概不負責!│
'│ │
'└─────────────────── http://www.fyasp.com ──┘
%>
<%
'/判斷用戶是否超時/
Function IsTimeOut(vUserName,vUserPwd)
dim rdsUser,sqlUser
Set rdsUser = Server.CreateObject("ADODB.Recordset")
sqlUser = "Select * From Sys_Account Where Account ='"& vUserName &"' And PassWord ='"& vUserPwd &"'"
rdsUser.Open sqlUser,conn
If Not rdsUser.EOF Then
IsTimeOut = False
Else
IsTimeOut = True
End if
rdsUser.Close
set rdsUser = nothing
End Function
'/獲得信息分類的名稱/
Function getClassName(nClassID)
Dim rdsClassName
Dim sqlClassName
set rdsClassName = Server.CreateObject("ADODB.Recordset")
sqlClassName = "Select * From Dat_Class Where ClsID = "& nClassID
rdsClassName.Open sqlClassName,Conn
if not rdsClassName.EOF then
getClassName = rdsClassName("CnName")
else
getClassName = ""
end if
rdsClassName.Close
set rdsClassName = nothing
End Function
'/格式化時間/
Function FormatTime(TestTime,style)
Dim n,y,r,s,f,m
n = Year(TestTime)
y = Month(TestTime)
r = Day(TestTime)
s = Hour(TestTime)
f = Minute(TestTime)
m = Second(TestTime)
if len(n) = 2 then n = "20" & n
if len(y) = 1 then y = "0" & y
if len(r) = 1 then r = "0" & r
if len(s) = 1 then s = "0" & s
if len(f) = 1 then f = "0" & f
if len(m) = 1 then m = "0" & m
If style = 1 Then
FormatTime = "<font color=""#FF0000"">"& n &"</font>年<font color=""#FF0000"">"& y &"</font>月<font color=""#FF0000"">"& r &"</font>日<font color=""#FF0000"">"& s &"</font>時"
Elseif style = 2 Then
FormatTime = r &"日 "& s & ":" & f & ":" & m
Elseif style = 3 Then
FormatTime = n &"年"& y &"月"& r &"日"
Elseif style = 4 Then
FormatTime = n & "/" & y & "/" & r
Elseif style = 5 then
FormatTime = y &"-"& r &" " & s & ":" & f
Elseif style = 6 then
FormatTime = n &"年"& y &"月"& r &"日" & s &":"& f
Elseif style = 7 then
FormatTime = n & y & r & s & f & m
End if
End Function
'/刪除一個貼子的附件/
Sub deleteArtAffix(nArtID)
dim strDelAffix,sqlDelAffix,sqlDeleteFavor
set strDelAffix = Server.CreateObject("ADODB.Recordset")
sqlDelAffix = "Select * From ProjectContent Where ProjectID = "& nArtID
strDelAffix.Open sqlDelAffix,Conn
if not strDelAffix.EOF then
if not IsNull(strDelAffix("Affix")) then
Set Upload = Server.CreateObject("Persits.Upload.1")
Upload.DeleteFile strUploadFilePath & strDelAffix("Affix")
Set Upload = nothing
end if
end if
strDelAffix.Close
set strDelAffix = nothing
End Sub
'/字符串轉換函數/
function Htmlencode2(strMsgString)
strMsgString = replace(strMsgString, ">", ">")
strMsgString = replace(strMsgString, "<", "<")
strMsgString = replace(strMsgString, chr(34), """)
'strMsgString = replace(strMsgString, "&", "&")
strMsgString = replace(strMsgString, chr(32), " ")
strMsgString = replace(strMsgString, chr(9), " ")
strMsgString = replace(strMsgString, chr(13), "<br>")
strMsgString = replace(strMsgString, "[br]", "<br>")
Htmlencode2 = strMsgString
end function
'/在一個表中判斷用戶輸入的一個字段的值是否已存在/
Function SearchFieldValue(vTableName,vFieldName,vFieldValue)
Dim rdsField
Dim sqlField
set rdsField = Server.CreateObject("ADODB.Recordset")
sqlField = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
rdsField.Open sqlField,Conn
if not rdsField.EOF then
SearchFieldValue = True
else
SearchFieldValue = False
end if
rdsField.Close
set rdsField = nothing
end Function
Function bbHTMLDecode(reString) '轉換HTML代碼
Dim Str:Str=reString
If Not IsNull(Str) Then
Str = Replace(Str, "&", "&")
Str = Replace(Str, ">", ">")
Str = Replace(Str, "<", "<")
Str = Replace(Str, " ", CHR(32))
Str = Replace(Str, " ", CHR(9))
Str = Replace(Str, "    ", CHR(9))
Str = Replace(Str, """, CHR(34))
Str = Replace(Str, "'", CHR(39))
Str = Replace(Str, "", CHR(13))
Str = Replace(Str, "<br>", CHR(10))
Str = Replace(Str, "<BR>", CHR(10))
bbHTMLDecode = Str
End If
End Function
function dvHTMLEncode(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> ")
dvHTMLEncode = fString
end if
End Function
Function RtnReplaceInt(iCheck,iDefault)
If Trim(iCheck)="" Then
RtnReplaceInt = iDefault
Exit Function
End If
If IsNumeric(iCheck)=false Then
RtnReplaceInt = iDefault
Exit Function
End If
RtnReplaceInt = iCheck
End Function
'/在一個表中判斷用戶輸入的一個字段是否與其它字段重名，除了他本身以外/
Function SearchEditFieldValue(vTableName,vFieldname,vFieldValue,vIDName,intIDValue)
Dim rdsField1
Dim sqlField1
set rdsField1 = Server.CreateObject("ADODB.Recordset")
sqlField1 = "Select * From "& vTableName &" Where "& vFieldName &" = '"& vFieldValue &"'"
rdsField1.Open sqlField1,Conn
if not rdsField1.EOF then
do while not rdsField1.EOF
if int(intIDValue) <> rdsField1(vIDName) then
SearchEditFieldValue = 1
exit Function
end if
rdsField1.MoveNext
loop
SearchEditFieldValue = 0
end if
rdsField1.Close
set rdsField1 = nothing
End Function
'/獲得一個目錄的父目錄編號/
Function getRootID(nClassID)
Dim rdsRootID
Dim sqlRootID
set rdsRootID = Server.CreateObject("ADODB.Recordset")
sqlRootID = "Select * From Dat_Class Where ClsID = "& nClassID
rdsRootID.Open sqlRootID,Conn
if not rdsRootID.EOF then
getRootID = rdsRootID("RootID")
else
getRootID = 0
end if
rdsRootID.Close
set rdsRootID = nothing
End Function
'/刪除一個目錄下的子目錄及產品/
Function DeleteClass(nClsID)
Dim sqlDelClsPro
Dim sqlDelClass
Dim sqlDelClsClass
if getRootID(nClsID) = 0 then
'sqlDelClsPro = "Delete From Dat_Products Where RootID = "& nClsID
sqlDelClass = "Delete From Dat_Class Where ClsID = "& nClsID
sqlDelClsClass = "Delete From Dat_Class Where RootID = "& nClsID
Conn.Execute sqlDelClsClass
else
'sqlDelClsPro = "Delete From Dat_Products Where ClsID = "& nClsID
sqlDelClass = "Delete From Dat_Class Where ClsID = "& nClsID
end if
'Conn.Execute sqlDelClsPro
Conn.Execute sqlDelClass
End Function
'/取得當前文件名稱/
Function getFileName()
dim strScrName,MarkStr,DelStr,LastStr
strScrName = Request.ServerVariables("SCRIPT_NAME")
MarkStr = "/"
Do While Instr(strScrName,MarkStr) > 0
DelStr = Instr(1,strScrName,MarkStr)
LastStr = mid(strScrName,1,DelStr - 1)
strScrName = mid(strScrName,DelStr + 1,Len(strScrName) - DelStr)
Loop
getFileName = strScrName
End Function
'/取字符串函數/
Function OutStr(SourceString,MarkStr,Num)
SourceStr = SourceString
If Len(SourceStr) = 0 Then
OutStr = "無"
Else
Dim StrCount,DelStr,LastStr
If Mid(SourceStr,Len(SourceStr),1) <> MarkStr Then
SourceStr = SourceStr + MarkStr
End if
StrCount = 1
Do While Len(SourceStr) > 0
DelStr = Instr(1,SourceStr,MarkStr)
LastStr = Mid(SourceStr,1,DelStr - 1)
SourceStr = Mid(SourceStr,DelStr + 1,Len(SourceStr) - DelStr)
If StrCount = Num Then
If LastStr <> "" Then
OutStr = LastStr
End if
Exit Do
End if
StrCount = StrCount + 1
Loop
End if
End Function
'/根據產品ID獲得產品編號/
Function getProductNumber(intProductKey)
Dim rdsProductNumber
Dim sqlProductNumber
set rdsProductNumber = Server.CreateObject("ADODB.Recordset")
sqlProductNumber = "Select * From Dat_Products Where ProductKey = "& intProductKey
rdsProductNumber.Open sqlProductNumber,Conn
if not rdsProductNumber.EOF then
getProductNumber = rdsProductNumber("Number")
else
getProductNumber = ""
end if
rdsProductNumber.Close
set rdsProductNumber = nothing
End Function
'/根據產品ID獲得產品名稱/
Function getProductName(nintProductKey)
Dim rdsProductName
Dim sqlProductName
set rdsProductName = Server.CreateObject("ADODB.Recordset")
sqlProductName = "Select * From Dat_Products Where ProductKey = "& nintProductKey
rdsProductName.Open sqlProductName,Conn
if not rdsProductName.EOF then
getProductName = rdsProductName("EnName")
else
getProductName = ""
end if
rdsProductName.Close
set rdsProductName = nothing
End Function
'/出錯提示函數/
Sub ShowMessage()
if strMsgTitle = "" then strMsgTitle = "異常出錯"
if strMsg = "" then strMsg = "未知錯誤"
%>
<br>
<table border="0" width="60%" cellspacing="0" cellpadding="0" align="center">
<tr>
<td width="100%" class="booktable">
<table border="0" width="100%" cellspacing="1">
<tr>
<td width="100%" align="center" class="bottom" height="30"><%=strMsgTitle%></td>
</tr>
<tr>
<td width="100%" align="center" height="68" class="banma2" style="line-height:200%"><%=strMsg%></td>
</tr>
<%if strError then%>
<tr>
<td width="100%" align="center" height="25" class="banma2"><input onclick="parent.location.href='Javascript:history.back()'" type="button" value="返 回" class="face" id=button1 name=button1></td>
</tr>
<%else%>
<meta HTTP-EQUIV="refresh" Content="2;url=<%=strGoFile%>">
<%end if%>
</table>
</td>
</tr>
</table>
<br>
<%End Sub%>?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -