📄 conn.asp

📁 网人分类信息5.0商业版。非常优秀的分类信息系统。比较少见。
💻 ASP
字号:
<%
   Option Explicit
   Response.Charset = "GB2312"
   On Error Resume Next

   Dim ConnTypeStr,SystemVersionType,Server_Url,ConnTime,UrlPath
   Dim ACCDB,DBServer,DBuid,DBpwd,DBname
   Dim eStarTime,eEndTime,eRunTime,eViewTime
   
   Dim URLParameter,Page,ListNum,PagesCount,PageContent,PageName,LineNum,sintTmp,CrePagePath,ContentPage,arrPage,ClsPageList,strPageList '分页
   Dim Conn,ConnData,Rs,Sql,Rss,Rsu,Rso,Rst
   Dim SitePath,Content,SinglePage,AreaList,DefaultArea,TempStr,TempID,ai,c,ComeUrl
   Dim Fso,UpDir,aDir
   Dim Re,regEx,regE,Match,Matches,ExTagStr,ExAnalyseStr,Matchs,Matchess  '正则
   Dim WRMPS,WRTemp,WRUser,WRPage,WRCre,WRClass,ClsPage,ClsCre,WRDB,ClsLabel,ClsUser,ClsGift,ClsCoupon
   Dim WR_Setting,WR_Mail,WR_UpLoad,WR_ClassAD,WR_Other,WR_User,WR_Company,WR_Area,WR_Prop,WR_Faith,WR_Code,WR_CodeQA
   Dim W_UserNum,W_NewUser,W_ClassNum,W_ArticleNum,W_CompanyNum,W_UserFaith,W_CompanyReNum,W_CouponNum
   Dim Email,Mailbody,FromName,Subject,SendMailResult
   
   Dim AgentID,AgentList,AgentAllList,AgentCity,AgentTime '代理
   Dim MemName,MemID,MemGroupID,MemFlag,UserFlag,FlagCom,FlagArticle,FlagClass,FlagMsg  '用户

   Dim AreaID,Author,Module,revert,MetaKey,MetaContent,CreateHTML,StructureType,FileNameType,FileExt_Index,FileExt_Item,Key
   Dim ClassID,ClassName,ChannelID,ChannelName,ChannelDir,ChannelLogo,ChannelTitle

   eStarTime = Timer()

%>
<!--#include file="Data.asp"-->
<%
   Const SystemVersion = "5.0.0"

   Public Sub DBConnBegin()
	 If Not IsObject(Conn) and IsEmpty(Conn) Then
       Set Conn = Server.CreateObject("ADODB.Connection")
          If ConnTypeStr=0 then
             ConnData="Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(ACCDB)
          Else
             ConnData="driver={SQL Server};server="&DBServer&";uid="&DBuid&";pwd="&DBpwd&";database="&DBname&""
          End If
          On Error Resume Next
		  Conn.Open ConnData
          If Err Then Set Conn = Nothing:Call AspErr()
     End If
   End Sub
   Public Sub DBConnEnd()
	 If IsObject(Conn) Then Conn.Close
     Set Conn = Nothing
   End Sub
   Public Sub ClassEnd()
     MyCity = Empty
     MyCityID = Empty
     MyCityEng = Empty
     MyCityTempID = Empty
     Set regEx = Nothing
     Set WRDB = Nothing
     Set WRCre = Nothing
	 Set ClsLabel = Nothing
	 Set ClsUser = Nothing
	 Set ClsGift = Nothing
	 Set ClsCoupon = Nothing
	 Set WRPage = Nothing
	 Set WRTemp = Nothing
     Set WRUser = Nothing
     Set WRMPS = Nothing
   End Sub
   Public Sub AspErr()
      Response.Write "<body style='font-size:14px'>"
	  Response.Write "错 误 号：" & Err.Number & "<BR>"
      Response.Write "错误描述：" & Err.Description & "<BR>"
      Response.Write "错误来源：" & Err.Source & "<BR><br>"
      Response.Write "<font color=red>解决参考：<br>1，如果您是初次使用，请先运行 <a href='Install'><font color=blue>Install</font></a> 进行系统初始安装"
      Select Case ConnTypeStr
	    Case 0 'ACC
		  Dim DBpath,DBLink,DBi
		  DBLink = Request.ServerVariables("url")
		  DBLink = Split(DBLink,"/")
		  For DBi = 0 To Ubound(DBLink)-1
		    DBpath = DBpath&DBLink(DBi)&"/"
		  Next
          Response.Write "<br>2，如果您没有对数据库路径或名称进行修改，请试试修改 /Inc/Data.asp 里 ACCDB 的值为 "&DBpath&"Data/wrmps.mdb，反之请按我们的安装说明进行修改"
		Case 1 'SQL
          Response.Write "<br>2，"
		  Select Case Err.Number
		    Case -2147217843
			  Response.write "请修改 /Inc/Data.asp 里 DBuid(登录用户名) 或 DBpwd(登录密码) 的值"
			Case -2147467259
			  If Instr(Err.Description,"[DBNETLIB]") > 0 Or Instr(Err.Description,"[DBMSLPCN]") > 0 Then
			    Response.write "请修改 /Inc/Data.asp 里 DBServer(数据库服务器IP地址) 的值，如和程序在同一服务器，请填写为 <strong>(Local)</strong>"
			  Else
			    Response.write "请修改 /Inc/Data.asp 里 DBname(数据库名称) 的值"
			  End If
		  End Select
	  End Select
      Err.Clear
	  Response.Write "</font>"
      Response.end
   End Sub
%>
⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -