<%
'*************************************************
'函數名:HTMLEncode
'作 用:用於輸出的字符串,將文本格式轉爲HTML格式
'參 數:str ----原字符串
'返回值:格式後的字符串
'*************************************************
Function HTMLEncode(Str)
if str<>"" then
Str=Replace(Str,"<","<")
Str=Replace(Str,">",">")
Str=Replace(Str," "," ")
Str=Replace(Str,Chr(10),"<br>")
HTMLEncode=Str
end if
End Function
'*************************************************
'函數名:HTMLEncode
'作 用:用於輸出的字符串,將HTML格式轉爲文本格式
'參 數:str ----原字符串
'返回值:格式後的字符串
'*************************************************
Function HTMLEncode(Str)
if str<>"" then
Str=Replace(Str,"<","<")
Str=Replace(Str,">",">")
Str=Replace(Str," "," ")
Str=Replace(Str,"<br>",Chr(10))
HTMLEncode=Str
end if
End Function
'*************************************************
'函數名:GetSafeStr
'作 用:得到安全字符串,'防止SQL注入
'****************************************************
Function GetSafeStr(ParaName,ParaType)
'--- 傳入參數 ---
'ParaName:參數名稱-字符型
'ParaType:參數類型-數字型(1表示以上參數是數字,0表示以上參數爲字符)
if ParaName<>"" then
If ParaType=1 then
If not isNumeric(ParaName) then
GetSafeStr=0
'response.write("<script language='javascript'>")
'Response.write "alert('非法操作!')"
'response.Write("/script>")
'Response.end
else
GetSafeStr=ParaName
End if
Else
ParaName=trim(ParaName)
ParaName=replace(ParaName,"'","’")
ParaName=replace(ParaName,";",";")
ParaName=replace(ParaName,",",",")
ParaName=replace(ParaName,"/"," ")
ParaName=replace(ParaName,"%","")
ParaName=replace(ParaName,"<","<")
ParaName=replace(ParaName,">",">")
ParaName=replace(ParaName," "," ")
ParaName=replace(ParaName,Chr(10),"<br>")
GetSafeStr=ParaName
End if
else
GetSafeStr=ParaName
end if
End function
'*************************************************
'函數名:IsSafeStr
'作 用:判斷是否安全字符串,在註冊登錄等特殊字段中使用
'參 數:str ----原字符串
'返回值:true,false
'*************************************************
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
'*************************************************
'函數名:gotTopic
'作 用:截字符串,漢字一個算兩個字符,英文算一個字符
'參 數:str ----原字符串
' strlen ----截取長度
'返回值:截取後的字符串
'*************************************************
function gotTopic(str,strlen)
if str="" then
gotTopic=""
else
dim l,t,c, i
str=replace(replace(replace(replace(str," "," "),""",chr(34)),">",">"),"<","<")
l=len(str)
t=0
for i=1 to l
c=Abs(Asc(Mid(str,i,1)))
if c>255 then
t=t+2
else
t=t+1
end if
if t>=strlen then
gotTopic=left(str,i) & "..."
exit for
else
gotTopic=str
end if
next
gotTopic=replace(replace(replace(replace(gotTopic," "," "),chr(34),"""),">",">"),"<","<")
end if
end function
' ============================================
'函數名:IsSelfRefer
'作 用:檢測上頁是否從本站提交
'返回值: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
'**************************************************
'函數名:Get_TrueLen
'作 用:求字符串實際長度。漢字算兩個字符,英文算一個字符。
'參 數:str ----求長度的字符串
'返回值:字符串長度
'**************************************************
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
'********************************************
'函數名:IsValidEmail
'作 用:檢查Email地址合法性
'參 數:email ----要檢查的Email地址
'返回值:True ----Email地址合法
' False ----Email地址不合法
'********************************************
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
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
end function
'********************************************
'函數名:FormatTime
'作 用 格式化時間(顯示)
' 參數:-----n_Flag 1-5
' 1:"yyyy-mm-dd hh:mm:ss"
' 2:"yyyy-mm-dd"
' 3:"hh:mm:ss"
' 4:"yyyy年mm月dd日"
' 5:"yyyymmdd"
' -------s_Time 時間
'********************************************
Function FormatTime(s_Time, n_Flag)
Dim y, m, d, h, mi, s
FormatTime = ""
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
FormatTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case 2
' yyyy-mm-dd
FormatTime = y & "-" & m & "-" & d
Case 3
' hh:mm:ss
FormatTime = h & ":" & mi & ":" & s
Case 4
' yyyy年mm月dd日
FormatTime = y & "年" & m & "月" & d & "日"
Case 5
' yyyymmdd
FormatTime = y & m & d
End Select
End Function
'***************************************************
'函數名:isFilename
'作 用:判斷文件名是否合法
'參 數:aFilename ----文件名
'返回值:true,false
'***************************************************
Function isFilename(aFilename)
Dim sErrorStr,iNameLength,i
isFilename=TRUE
sErrorStr=Array("/","/",":","*","?","""","<",">","|")
iNameLength=Len(aFilename)
If iNameLength<1 Or iNameLength=null Then
isFilename=FALSE
Else
For i=0 To 8
If instr(aFilename,sErrorStr(i)) Then
isFilename=FALSE
End If
Next
End If
End Function
'***************************************************
'函數名:CheckCardId
'作 用:檢查身份證號碼
'參 數:e ----身份證號碼
'返回值:錯誤信息,若正確值無反映
'***************************************************
Function CheckCardId(e)
arrVerifyCode = Split("1,0,x,9,8,7,6,5,4,3,2", ",")
Wi = Split("7,9,10,5,8,4,2,1,6,3,7,9,10,5,8,4,2", ",")
Checker = Split("1,9,8,7,6,5,4,3,2,1,1", ",")
If Len(e) < 15 Or Len(e) = 16 Or Len(e) = 17 Or Len(e) > 18 Then
CheckCardId= "身份證號共有 15 碼或18位"
CheckCardId = False
Exit Function
End If
Dim Ai
If Len(e) = 18 Then
Ai = Mid(e, 1, 17)
ElseIf Len(e) = 15 Then
Ai = e
Ai = Left(Ai, 6) & "19" & Mid(Ai, 7, 9)
End If
If Not IsNumeric(Ai) Then
CheckCardId= "身份證除最後一位外,必須爲數字!"
Exit Function
End If
Dim strYear, strMonth, strDay
strYear = CInt(Mid(Ai, 7, 4))
strMonth = CInt(Mid(Ai, 11, 2))
strDay = CInt(Mid(Ai, 13, 2))
BirthDay = Trim(strYear) + "-" + Trim(strMonth) + "-" + Trim(strDay)
If IsDate(BirthDay) Then
If DateDiff("yyyy",Now,BirthDay) <-140 or cdate(BirthDay)> date() Then
CheckCardId= "身份證輸入錯誤!"
Exit Function
End If
If strMonth > 12 Or strDay > 31 Then
CheckCardId= "身份證輸入錯誤!"
Exit Function
End If
Else
CheckCardId= "身份證輸入錯誤!"
Exit Function
End If
Dim i, TotalmulAiWi
For i = 0 To 16
TotalmulAiWi = TotalmulAiWi + CInt(Mid(Ai, i + 1, 1)) * Wi(i)
Next
Dim modValue
modValue = TotalmulAiWi Mod 11
Dim strVerifyCode
strVerifyCode = arrVerifyCode(modValue)
Ai = Ai & strVerifyCode
CheckCardId = Ai
If Len(e) = 18 And e <> Ai Then
CheckCardId= "身份證號碼輸入錯誤!"
Exit Function
End If
End Function
'***************************************************
'函數名:MyRandc
'作 用:生成隨機字符
'參 數:n 爲字符的個數
'返回值:隨機字符
'***************************************************
function MyRandc(n)
dim thechr
thechr = ""
for i=1 to n
dim zNum,zNum2
Randomize
zNum = cint(25*Rnd)
zNum2 = cint(10*Rnd)
if zNum2 mod 2 = 0 then
zNum = zNum + 97
else
zNum = zNum + 65
end if
thechr = thechr & chr(zNum)
next
MyRandc = thechr
end function
'***************************************************
'函數名:MyRandn
'作 用:生成隨機數字
'參 數:n 爲數字的個數
'返回值:隨機數字
'***************************************************
function MyRandn(n)
dim thechr
thechr = ""
for i=1 to n
dim zNum,zNum2
Randomize
zNum = cint(9*Rnd)
zNum = zNum + 48
thechr = thechr & chr(zNum)
next
MyRandn = thechr
end function
'***************************************************
'函數名:IsObjInstalled
'作 用:檢查組件是否已經安裝
'參 數:strClassString ----組件名
'返回值:True ----已經安裝
' False ----沒有安裝
'***************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'****************************************************
'過程名:WriteErrMsg
'作 用:顯示錯誤提示信息
'參 數:無
'****************************************************
sub WriteErrMsg()
'dim strErr
'strErr=strErr & "<html><head><title>錯誤信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
'strErr=strErr & "<link href='style.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
'strErr=strErr & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
'strErr=strErr & " <tr align='center'><td height='20' class='title'><strong>錯誤信息</strong></td></tr>" & vbcrlf
'strErr=strErr & " <tr><td height='100' class='tdbg' valign='top'><b>產生錯誤的可能原因:</b><br>" & errmsg &"</td></tr>" & vbcrlf
'strErr=strErr & " <tr align='center'><td class='title'><a href='javascript:history.go(-1)'><< 返回上一頁</a></td></tr>" & vbcrlf
'strErr=strErr & "</table>" & vbcrlf
'strErr=strErr & "</body></html>" & vbcrlf
'response.write strErr
%>
<br />
<br />
<table width="400" height="237" border="1" align="center" cellpadding="5" cellspacing="0" bordercolor="#FAA401" bordercolordark="#FFFFFF" background="../images/ER044_L.jpg" bgcolor="#FDF0C6">
<tr>
<th height="30" bgcolor="#FDCE6C"><span style="color:#FF0000; font-size:14px">出 錯 啦!</span></th>
</tr>
<tr>
<td height="205" align="center"><table width="96%" height="180" border="0" align="center" cellpadding="0" cellspacing="0" style="line-height:2">
<tr>
<td align="center"style="color:#3366FF; font-size:14px"><%=errmsg%></td>
</tr>
<tr>
<td height="20" align="center"style="color:#FF0000; font-size:14px"><a href='javascript:history.go(-1)' style="font-size:12px;">返回上一頁</a></td>
</tr>
</table>
</td>
</tr>
</table>
<%
response.end
end sub
'****************************************************
'過程名:WriteSuccessMsg
'作 用:顯示成功提示信息
'參 數:無
'****************************************************
sub WriteSuccessMsg(SuccessMsg)
dim strSuccess
strSuccess=strSuccess & "<html><head><title>成功信息</title><meta http-equiv='Content-Type' content='text/html; charset=gb2312'>" & vbcrlf
strSuccess=strSuccess & "<link href='css.css' rel='stylesheet' type='text/css'></head><body>" & vbcrlf
strSuccess=strSuccess & "<table cellpadding=2 cellspacing=2 border=0 width=400 class='border' align=center>" & vbcrlf
strSuccess=strSuccess & " <tr align='center'><td height='20' class='title'><strong>恭喜你!</strong></td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr><td height='100' class='tdbg' valign='top'><br>" & SuccessMsg &"</td></tr>" & vbcrlf
strSuccess=strSuccess & " <tr align='center'><td class='title'><a href='javascript:window.close()'>【關 閉】</a></td></tr>" & vbcrlf
strSuccess=strSuccess & "</table>" & vbcrlf
strSuccess=strSuccess & "</body></html>" & vbcrlf
response.write strSuccess
end sub
'***********************************************
'過程名:showpage
'作 用:顯示“上一頁 下一頁”等信息
'參 數:sfilename ----鏈接地址
' totalnumber ----總數量
' maxperpage ----每頁數量
' ShowTotal ----是否顯示總數量
' ShowAllPages ---是否用下拉列表顯示所有頁面以供跳轉。有某些頁面不能使用,否則會出現JS錯誤。
' strUnit ----計數單位
'***********************************************
sub showpage(sfilename,totalnumber,maxperpage,ShowTotal,ShowAllPages,strUnit)
dim n, i,strTemp,strUrl
if totalnumber mod maxperpage=0 then
n= totalnumber / maxperpage
else
n= totalnumber / maxperpage+1
end if
strTemp= "<table align='center'><form name='showpages' method='Post' action='" & sfilename & "'><tr><td>"
if ShowTotal=true then
strTemp=strTemp & "共 <b>" & totalnumber & "</b> " & strUnit & " "
end if
strUrl=JoinChar(sfilename)
if CurrentPage<2 then
strTemp=strTemp & "首頁 上一頁 "
else
strTemp=strTemp & "<a href='" & strUrl & "page=1'>首頁</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage-1) & "'>上一頁</a> "
end if
if n-currentpage<1 then
strTemp=strTemp & "下一頁 尾頁"
else
strTemp=strTemp & "<a href='" & strUrl & "page=" & (CurrentPage+1) & "'>下一頁</a> "
strTemp=strTemp & "<a href='" & strUrl & "page=" & n & "'>尾頁</a>"
end if
strTemp=strTemp & " 頁次:<strong><font color=red>" & CurrentPage & "</font>/" & n & "</strong>頁 "
strTemp=strTemp & " <b>" & maxperpage & "</b>" & strUnit & "/頁"
if ShowAllPages=True then
strTemp=strTemp & " 轉到:<select name='page' size='1' onchange='javascript:submit()'>"
for i = 1 to n
strTemp=strTemp & "<option value='" & i & "'"
if cint(CurrentPage)=cint(i) then strTemp=strTemp & " selected "
strTemp=strTemp & ">第" & i & "頁</option>"
next
strTemp=strTemp & "</select>"
end if
strTemp=strTemp & "</td></tr></form></table>"
response.write strTemp
end sub
'****************************************************
'CDONTS.NewMail 郵件發送
'****************************************************
function SendMail2(mailfrom,mailto,mailsubject,mailbody)
Set mail = Server.CreateObject("CDONTS.NewMail")
mail.To = mailto
mail.From = "[email protected]"
mail.Subject = mailsubject
mail.Body = mailbody
Mail.Send
'Set mail = Server.CreateObject("CDONTS.NewMail")
'mail.to = mailto
'mail.From = mailfrom
'mail.Subject = mailsubject
'mail.Body = mailbody
'mail.Send
end function
'****************************************************
'jmail發信
'****************************************************
function SendMail (FriendEmail,title,bodystr)
Set jmail = Server.CreateObject("JMAIL.Message") '建立發送郵件的對象
jmail.silent = true '屏蔽例外錯誤,返回FALSE跟TRUE兩值j
jmail.logging = true '啓用郵件日誌
jmail.Charset = "GB2312" '郵件的文字編碼爲國標
jmail.ContentType = "text/html" '郵件的格式爲HTML格式
jmail.MailServerUserName = "[email protected]" '登錄郵件服務器所需的用戶名
jmail.MailServerPassword = "webmaster" '登錄郵件服務器所需的密碼
jmail.AddRecipient (FriendEmail) '郵件收件人的地址
jmail.From = "[email protected]" '發件人的E-MAIL地址
jmail.FromName = "模具採購網" ' 發送者姓名
jmail.Subject = title ' 郵件主題
jmail.Body = bodystr '郵件的內容
JMail.Priority = 1 '郵件的緊急程序,1 爲最快,5 爲最慢, 3 爲默認值
jmail.Send("mail.abc.com") '執行郵件發送(通過郵件服務器地址)
jmail.Close() '關閉對象
end function
'****************************************************
'文件刪除函數
'****************************************************
Function deletefile(filename)
if filename<>"" then
filename=server.mappath(filename)
set fso=server.CreateObject("scripting.filesystemobject")
if fso.FileExists(filename) then
fso.DeleteFile filename
'else
'Response.Write "<script language=JavaScript>alert(' 該文件不存在 ');< /script>"
end if
end if
End Function
'刪除文件夾
'strfile=server.MapPath("fileName")
'deletefile(strfile)
%>