<%
'==============================================
' 程式碼編寫：    江建 2004年2月17日
' 本程式碼功能：  用於開啟連線到資料庫
'==============================================
' 我的主頁 Http://vbcc.126.com
' 公司主頁 Http://www.ejet.com.cn
'==============================================
dim conn
dim connstr
dim connType,dbPath

connType=1
Set conn= Server.CreateObject("ADODB.Connection")

IF conn.State = 0 Then
 IF connType= 1 Then
  connstr = "Provider=SQLOLEDB;uid=shadow;pwd=XXXXXX;Initial Catalog=XXXXXX;server=(local);"
 Else
  dbPath = Server.Mappath("/") & "/hkcn/database/webhkcn.mdb"
  connstr = "Provider=Microsoft.JET.OLEDB.4.0;Data Source="& dbPath &";"
 End If
 conn.Open connstr
End If

Function SQLExecute(SqlStr)
 on error resume next
 Dim Rs
 Set Rs=Server.CreateObject("Adodb.Recordset")
 Rs.open SqlStr,conn,1,3
 Set SQLExecute=Rs
 If Err.Number <> 0 Then
  Response.Write("<font color=red>抱歉你在訪問本頁時出現一個錯誤以下是錯誤的詳細資訊。<br>")
  Response.Write("錯誤號:"&CStr(Hex(Err.Number))&"<br>")
  Response.Write("錯誤物件:"&Err.Source&"<br>")
  Response.Write("有關錯誤的詳細描述:"&Err.Description&"<br>")
  Response.Write("如果你始終無法訪問本頁請聯絡管理員。")
 End If
End Function
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
%>

<%
'=================================================
' Public Function
' Programmer by Jiang Jian(Shadow)
' Email:[email protected]
' Date: 2003-05-26
'=================================================

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'判斷使用者是否登入
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function ChkLogin(UserName,Pass)
 Dim Sql,Rs
 Sql="Select id,username,password FROM member WHERE username='"&UserName&"' And password='"&Pass&"'"
 Set Rs=SQLExecute(Sql)
 If Not (Rs.bof or Rs.eof) Then
  ChkLogin=Rs("ID")
 Else
  ChkLogin=False
 End If
 Rs.Close
 Set Rs=Nothing
End Function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'判斷是否非法提交資料 True 為正常 False 為非法提交
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function ChkPost()
 Dim server_v1,server_v2
 Chkpost=False
 server_v1=Cstr(Request.ServerVariables("HTTP_REFERER"))
 server_v2=Cstr(Request.ServerVariables("SERVER_NAME"))
 If Mid(server_v1,8,Len(server_v2))<>server_v2 Then
  Chkpost=False
 Else
  Chkpost=True
 End if
End function

'====================================================
'判斷使用者名稱是否包含非法字元 True 合法的字串
'====================================================
Function CheckString(Str1)
 Dim N
 Dim S
 For N = 1 To Len(Str1)
  S = Asc(Mid(Str1, N))
  If S > 47 And S < 58 Or S > 64 And S < 91 Or S > 96 And S < 122 Or S = 95 Then '合法的字串
   CheckString=True
  Else 
   CheckString=False
  End If
 Next
End Function

'====================================================
'判斷字元是否為中文 True 合法 False 非法
'====================================================
Function IsChinese(Str)
 Dim N
 Dim S
 For N = 1 To Len(Str)
  S = Asc(Mid(Str, N))
  If S => 0  Then   
   IsChinese=False
   Exit for
  Else
   IsChinese=True
  End If
 Next
End Function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'判斷是否為合法的電話號碼 True 合法 False 非法
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function IsPhone(Str)
 Dim strArray
 IsPhone=False
 strArray=Split(Str,"-",-1,1)
 IF Ubound(strArray)> 0 Then
  IF Len(strArray(0))>2 And Len(strArray(0))< 5 Then
   IF Len(strArray(1))>6 And Len(strArray(1))< 9 Then
    If IsNumeric(strArray(0))=True And  IsNumeric(strArray(1)) Then
     IsPhone=True
    End If
   End If
  End If
 End IF
End Function
 
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'判斷是否為合法的電子郵件地址 True 合法 False 非法
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function IsValidEmail(Email)
 Dim Names, name, i, c
 IsValidEmail = True
 Names = Split(Email, "@")
 
 If UBound(Names) <> 1 Then
  IsValidEmail = False
  Exit function
 End If
  
 For Each Name IN Names
  If Len(name) <= 0 Then
   IsValidEmail = False
   Exit Function
  End If
  For i = 1 To Len(name)
   c = Lcase(Mid(name, i, 1))
   If InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 And Not IsNumeric(c) Then
    IsValidEmail = False
    Exit Function
   End If
  Next
  If Left(name, 1) = "." or Right(name, 1) = "." Then
   IsValidEmail = False
   Exit Function
   End If
  Next
  
 If InStr(names(1), ".") <= 0 Then
  IsValidEmail = False
  Exit Function
 End If
 
 i = Len(names(1)) - InStrRev(names(1), ".")
 If i <> 2 And i <> 3 Then
  IsValidEmail = False
  Exit Function
 End If
 
 If InStr(Email, "..") > 0 Then
  IsValidEmail = False
 End If
End function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'資料分頁顯示 strUrl 設定成自己本頁
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Function PageSplit(objRs,strUrl,cssClass,listSize,cssSep)
 Dim pgnum,page
 page=Request("page")
 objRs.PageSize = listSize
 pgnum=objRs.Pagecount
 if page="" or clng(page)<1 then page=1
 if clng(page) > pgnum then page=pgnum
 if pgnum>0 then objRs.AbsolutePage=page
 If page=1 Then
  Response.Write " 首 頁 | 上一頁 | "
 Else
  Response.Write " <a class="& cssClass &" href="&strUrl&"page=1>首 頁</a><span class="& cssSep &"> | </span>"
  Response.Write "<a class="& cssClass &" href="&strUrl&"page="&page-1&"> 上一頁</a><span class="& cssSep &"> | </span>"
 End if
 If objRs.pagecount-page<1 Then
  Response.Write "下一頁 | 尾 頁"
 Else
  Response.Write "<a class="& cssClass &" href="&strUrl&"page="&page+1&">下一頁</a><span class="& cssSep &"> | </span>"
  Response.Write "<a class="& cssClass &" href="&strUrl&"page="&objRs.pagecount&">尾 頁</a>"
 End if
 Response.Write "　　　　　　　　　　　　　　第 "&page&" 頁/共 "&pgnum&" 頁"
End Function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'文章分頁顯示 strUrl 設定成自己本頁
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Function SplitPage(strContents)
 Dim Page,PageArray
 PageArray=SepPosition(strContents)
 Page=Request("page")
 pgnum=UBound(PageArray)
 IF page="" or clng(page)<0 Then page=0
 IF Clng(page) > pgnum Then page=pgnum
 
 IF pgnum = 0 Then '只有一頁
  SplitPage=strContents
  Exit Function
 End IF
 
 If Page = 0 Then
  SplitPage=Mid(strContents,1,PageArray(page)-1)
 ElseIf Clng(Page)=pgnum Then
  SplitPage=Mid(strContents,PageArray(page-1)+19,Len(strContents))
 Else
  SplitPage=Mid(strContents,PageArray(page-1)+19,PageArray(page)-(PageArray(page-1)+19))
 End if
End Function

Public Function NavPage(strPage)
 Page=Request("page")
 IF page="" or clng(page)<0 Then page=0
 IF pgnum > 0 Then
  IF Page = 0 Then
   Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page & """>上一頁</a> "
  Else
   Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page - 1 & """>上一頁</a> "
  End if
  
  If pgnum-Clng(Page)<1  Then
   Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page &""">下一頁</a> "
  Else
   Response.Write "<a class=""SepPage"" href="""&strPage&"&page=" & page + 1 & """>下一頁</a>"
  End If
  Response.Write "<span class=""I""> 共 " & pgnum + 1 & " 頁 當前第 " & page + 1 & " 頁</span>"
 End IF
End Function

Public Function SepPosition(strContents)
 Dim intPos,strPos
 Dim intPageArray,strTemp
 strTemp = "[PAGE]------[/PAGE]"
 intPos=Instr(strContents,strTemp)
  strPos = intPos
 Do While (intPos)
  intPos=Instr(intPos+19,strContents,strTemp) 
  strPos=strPos & "," & intPos
 Loop
 SepPosition=Split(strPos,",")
End Function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'擷取一定數量的文字輸出
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Public Function OutText(strText,intOutSize)
 IF Len(strText)>intOutSize Then
  OutText = Left(strText,intOutSize-3) & "..."
 Else
  OutText = strText
 End If
End Function
%>