幾個有用的ASP Function

< %@ Language = VBScript CODEPAGE = 950 % >
< %  Option   Explicit  % >
< %

'  ============================================
'  常用全局變量
'  ============================================
'  數據庫對像
Dim  oConn, oRs, sSql


'  ============================================
'  初始數據處理
'  ============================================
'  執行每天隻需處理一次的事件
' Call BrandNewDay()

'  初始化數據庫連接
' Call DBConnBegin()


'  ********************************************
'  以下為初始函數
'  ********************************************
'  ============================================
'  執行每天隻需處理一次的事件
'  ============================================
Sub  BrandNewDay()
     Dim  sDate, y, m, d, w
     Dim  sDateChinese
    sDate  =   Date ()
     If  Application( " date_today " )  =  sDate  Then   Exit Sub

    y  =   CStr ( Year (sDate))
    m  =   CStr ( Month (sDate))
     If   Len (m)  =   1   Then  m  =   " 0 "   &  m
    d  =   CStr ( Day (sDate))
     If   Len (d)  =   1   Then  d  =   " 0 "   &  d
    w  =   WeekdayName ( Weekday (sDate))
    sDateChinese  =  y  &   " 年 "   &  m  &   " 月 "   &  d  &   " 日&nbsp; "   &  w

    Application.Lock
    Application( " date_today " )  =  sDate
    Application( " date_chinese " )  =  sDateChinese         ' 今天的中文樣式
    Application.Unlock
End Sub



'  ********************************************
'  以下為數據庫相關函數
'  ********************************************
'  ============================================
'  初始化數據庫連接對像
'  使用原則：最遲調用，最早釋放
'  ============================================
Sub  DBConnBegin()
     '  如果數據庫對像已打開，不要再打開
     If  IsObject(oConn)  =   True   Then   Exit Sub

     '  你可以不需要打開數據庫連接對像而直接打開記錄集對像，但如果你需要打開多個記錄集對像的話，效率是很低的。
     '  如果你不創建一個數據庫連接對像，ADO會在每個記錄集打開時自動創建一個新的數據庫連接對像，就算你用的是相同的SQL語句。
     Set  oConn  =  Server.CreateObject( " ADODB.Connection " )

     On   Error   Resume   Next
     '  Access數據庫
    oConn.Open  " Provider=Microsoft.Jet.OLEDB.4.0; Data Source= "   &  Server.MapPath( " db/ewebeditor.mdb " )
     '  SQL Server 2000數據庫
     ' oConn.Open "Provider=SQLOLEDB.1;Server=localhost;UID=ewebeditor;PWD=123456;Database=ewebeditor"
    
     If  Err.Number  >   0   Then
         '  顯示錯誤信息,並且發送郵件通知管理員
         ' Call DBConnError(Err)
        
         '  完全地退出正在運行的腳本
        Response.End
     End   If

     '  創建一個記錄集
     Set  oRs  =  Server.CreateObject(  " ADODB.Recordset "  )
End Sub

'  ============================================
'  釋放數據庫連接對像
'  ============================================
Sub  DBConnEnd()
     On   Error   Resume   Next
    oRs.Close
     Set  oRs  =   Nothing
    oConn.Close
     Set  oConn  =   Nothing
End Sub



'  ********************************************
'  以下為常用函數
'  ********************************************
'  ============================================
'  錯誤返回處理
'  ============================================
Sub  Go_Error( str )
     Call  DBConnEnd()
    Response.Write  " <script language=javascript>alert(' "   &   str   &   " \n\n系統將自動返回前一頁面');history.back();</script> "
    Response.End
End Sub

'  ============================================
'  格式化時間(顯示)
'  參數：n_Flag
'     1:"yyyy-mm-dd hh:mm:ss"
'     2:"yyyy-mm-dd"
'     3:"hh:mm:ss"
'     4:"yyyy年mm月dd日"
'     5:"yyyymmdd"
'  ============================================
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
     End   Select
End Function

'  ============================================
'  把字符串進行HTML解碼,替換server.htmlencode
'  去除Html格式，用於顯示輸出
'  ============================================
Function  outHTML( str )
     Dim  sTemp
    sTemp  =   str
    outHTML  =   ""
     If  IsNull(sTemp)  =   True   Then
         Exit Function
     End   If
    sTemp  =   Replace (sTemp,  " & " ,  " &amp; " )
    sTemp  =   Replace (sTemp,  " < " ,  " &lt; " )
    sTemp  =   Replace (sTemp,  " > " ,  " &gt; " )
    sTemp  =   Replace (sTemp,  Chr ( 34 ),  " &quot; " )
    sTemp  =   Replace (sTemp,  Chr ( 10 ),  " <br> " )
    outHTML  =  sTemp
End Function

'  ============================================
'  去除Html格式，用於從數據庫中取出值填入輸入框時
'  注意：value="?"這邊一定要用雙引號
'  ============================================
Function  inHTML( str )
     Dim  sTemp
    sTemp  =   str
    inHTML  =   ""
     If  IsNull(sTemp)  =   True   Then
         Exit Function
     End   If
    sTemp  =   Replace (sTemp,  " & " ,  " &amp; " )
    sTemp  =   Replace (sTemp,  " < " ,  " &lt; " )
    sTemp  =   Replace (sTemp,  " > " ,  " &gt; " )
    sTemp  =   Replace (sTemp,  Chr ( 34 ),  " &quot; " )
    inHTML  =  sTemp
End Function

'  ============================================
'  檢測上頁是否從本站提交
'  返回: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

'  ============================================
'  得到安全字符串,在查詢中使用
'  ============================================
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


% >