?? function.asp
字號:
for i=0 to ubound(arrShowLine)
arrShowLine(i)=False
next
sqlClass="Select * From MenuClass order by RootID,OrderID"
set rsClass=server.CreateObject("adodb.recordset")
rsClass.open sqlClass,conn,1,1
if rsClass.bof and rsClass.bof then
response.write "<option value=''>請先添加欄目</option>"
else
do while not rsClass.eof
tmpDepth=rsClass("Depth")
if rsClass("NextID")>0 then
arrShowLine(tmpDepth)=True
else
arrShowLine(tmpDepth)=False
end if
if ShowType=1 then
if rsClass("LinkUrl")<>"" then
strTemp="<option value=''"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & "style='background-color:#ff0000'"
elseif ShowType=2 then
if rsClass("LinkUrl")<>"" then
strTemp="<option value=''"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & "style='background-color:#ff0000'"
elseif ShowType=3 then
if rsClass("Child")>0 then
strTemp="<option value=''"
elseif rsClass("LinkUrl")<>"" then
strTemp="<option value='0'"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & "style='background-color:#ff0000'"
elseif ShowType=4 then
if rsClass("Child")>0 then
strTemp="<option value=''"
elseif rsClass("LinkUrl")<>"" then
strTemp="<option value='0'"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & ">"
if tmpDepth>0 then
for i=1 to tmpDepth
strTemp=strTemp & " "
if i=tmpDepth then
if rsClass("NextID")>0 then
strTemp=strTemp & "├ "
else
strTemp=strTemp & "└ "
end if
else
if arrShowLine(i)=True then
strTemp=strTemp & "│"
else
strTemp=strTemp & " "
end if
end if
next
end if
if Language=1 then
strTemp=strTemp & rsClass("ClassNameEn")
else
strTemp=strTemp & rsClass("ClassName")
end if
if rsClass("LinkUrl")<>"" then
strTemp=strTemp & "(外)"
end if
strTemp=strTemp & "</option>"
response.write strTemp
rsClass.movenext
loop
end if
rsClass.close
set rsClass=nothing
end sub
sub Admin_ShowClass_Optionen(ShowType,CurrentID,Language)
if ShowType=0 then
response.write "<option value='0'"
if CurrentID=0 then response.write " selected"
response.write ">無（作為一級欄目）</option>"
end if
dim rsClass,sqlClass,strTemp,tmpDepth,i
dim arrShowLine(20)
for i=0 to ubound(arrShowLine)
arrShowLine(i)=False
next
sqlClass="Select * From enMenuClass order by RootID,OrderID"
set rsClass=server.CreateObject("adodb.recordset")
rsClass.open sqlClass,conn,1,1
if rsClass.bof and rsClass.bof then
response.write "<option value=''>請先添加欄目</option>"
else
do while not rsClass.eof
tmpDepth=rsClass("Depth")
if rsClass("NextID")>0 then
arrShowLine(tmpDepth)=True
else
arrShowLine(tmpDepth)=False
end if
if ShowType=1 then
if rsClass("LinkUrl")<>"" then
strTemp="<option value=''"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & "style='background-color:#ff0000'"
elseif ShowType=2 then
if rsClass("LinkUrl")<>"" then
strTemp="<option value=''"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & "style='background-color:#ff0000'"
elseif ShowType=3 then
if rsClass("Child")>0 then
strTemp="<option value=''"
elseif rsClass("LinkUrl")<>"" then
strTemp="<option value='0'"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & "style='background-color:#ff0000'"
elseif ShowType=4 then
if rsClass("Child")>0 then
strTemp="<option value=''"
elseif rsClass("LinkUrl")<>"" then
strTemp="<option value='0'"
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
else
strTemp="<option value='" & rsClass("ClassID") & "'"
end if
strTemp=strTemp & ">"
if tmpDepth>0 then
for i=1 to tmpDepth
strTemp=strTemp & " "
if i=tmpDepth then
if rsClass("NextID")>0 then
strTemp=strTemp & "├ "
else
strTemp=strTemp & "└ "
end if
else
if arrShowLine(i)=True then
strTemp=strTemp & "│"
else
strTemp=strTemp & " "
end if
end if
next
end if
if Language=1 then
strTemp=strTemp & rsClass("ClassNameEn")
else
strTemp=strTemp & rsClass("ClassName")
end if
if rsClass("LinkUrl")<>"" then
strTemp=strTemp & "(外)"
end if
strTemp=strTemp & "</option>"
response.write strTemp
rsClass.movenext
loop
end if
rsClass.close
set rsClass=nothing
end sub
'**************************************************
'函數名：SendMail
'作 用：用Jmail組件發送郵件
'參 數：MailtoAddress ----收信人地址
' MailtoName -----收信人姓名
' Subject -----主題
' MailBody -----信件內容
' FromName -----發信人姓名
' MailFrom -----發信人地址
' Priority -----信件優先級
'**************************************************
function SendMail(MailtoAddress,MailtoName,Subject,MailBody,FromName,MailFrom,Priority)
on error resume next
Dim JMail
Set JMail=Server.CreateObject("JMAIL.Message")
if err then
SendMail= "<br><li>沒有安裝JMail組件</li>"
err.clear
exit function
end if
JMail.Charset="gb2312" '郵件編碼
JMail.silent=true
JMail.ContentType = "text/html" '郵件正文格式
JMail.ServerAddress=MailServer '用來發送郵件的SMTP服務器
'如果服務器需要SMTP身份驗證則還需指定以下參數
JMail.MailServerUserName = MailServerUserName '登錄用戶名
JMail.MailServerPassWord = MailServerPassword '登錄密碼
JMail.MailDomain = MailDomain '域名（如果用“name@domain.com”這樣的用戶名登錄時，請指明domain.com
JMail.AddRecipient MailtoAddress,MailtoName '收信人
JMail.Subject=Subject '主題
JMail.HMTLBody=MailBody '郵件正文（HTML格式）
JMail.Body=MailBody '郵件正文（純文本格式）
JMail.FromName=FromName '發信人姓名
JMail.From = MailFrom '發信人Email
JMail.Priority=Priority '郵件等級，1為加急，3為普通，5為低級
JMail.Send(MailServer)
SendMail =JMail.ErrorMessage
JMail.Close
Set JMail=nothing
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
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='style.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:history.back()'>【返 回】</a></td></tr>" & vbcrlf
strSuccess=strSuccess & "</table>" & vbcrlf
strSuccess=strSuccess & "</body></html>" & vbcrlf
response.write strSuccess
end sub
%>
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -