论坛: 网站建设 标题: 这个论坛的原码在哪里修改数据库的路径啊 复制本贴地址    
作者: 中国黑客 [asusmlan2]    论坛用户   登录
以下的是leadbbs 3.14版论坛的SETUP.ASP文件.要修改数据库才能安装
-------------------------------------------------------------------------
<!-- #include file=inc/BBSsetup.asp -->
<%
Dim con,GBL_CHK_TempStr
Dim HomeUrl
Const Old_HomeUrl = "/LeadBBS/"

HomeUrl = Request.Servervariables("SCRIPT_NAME")
HomeUrl = Replace(HomeUrl,"\","/")
If inStr(HomeUrl,"/") Then HomeUrl = Left(HomeUrl,inStrRev(HomeUrl,"/")-1)

Dim GBL_FSOString
GBL_FSOString = DEF_FSOString
If GBL_FSOString = "" Then GBL_FSOString = "Scripting.FileSystemObject"

On error Resume Next
Dim Fs,FsFlag
FSFlag = 1
Set fs = Server.CreateObject(DEF_FSOString)
If Err Then
FSFlag = 0
Err.Clear
End If

Sub OpenDatabase

On error Resume Next
set con = Server.CreateObject("ADODB.Connection")
'Con.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
con.open
if Err Then
err.Clear
Set Con = Nothing
GBL_CHK_TempStr = GBL_CHK_TempStr & "数据连接错误!"
Response.Write GBL_CHK_TempStr
Response.End
End If

End Sub

Sub CloseDatabase

Con.Close
Set Con = Nothing

End Sub

Function CheckObjInstalled(strClassString)

On Error Resume Next
Dim Temp
Err = 0
Dim TmpObj
Set TmpObj = Server.CreateObject(strClassString)
Temp = Err
If Temp = 0 Then
CheckObjInstalled = True
GBL_CHK_TempStr = "<font color=green class=GreenFont>√</font>"
ElseIf Temp = -2147221005 Then
GBL_CHK_TempStr = "<font color=red class=RedFont>组件未安装</font>"
CheckObjInstalled = False
ElseIf Temp = -2147221477 Then
GBL_CHK_TempStr = "<font color=green class=GreenFont>√支持此组件</font>"
CheckObjInstalled = True
ElseIf Temp = 1 Then
GBL_CHK_TempStr = "<font color=red>×未知的错误,组件可能未正确安装</font>"
CheckObjInstalled = False
End If
Err.Clear
Set TmpObj = Nothing
Err = 0

End Function

Sub InstallLeadBBS_CSSFile

Dim fs,WriteFile,fileContent,n
For N = 0 to 15
If FSFlag = 1 Then
Set fs = Server.CreateObject(GBL_FSOString)
Set WriteFile = fs.OpenTextFile(Server.MapPath("inc/style" & N & ".css"),1,True)
If Not WriteFile.AtEndOfStream Then
fileContent = WriteFile.ReadAll
End If
WriteFile.Close
Set fs = Nothing

fileContent = GetNewStrCSS(fileContent & "")
Set fs = Server.CreateObject(GBL_FSOString)
Set WriteFile = fs.CreateTextFile(Server.MapPath("inc/style" & N & ".css"),True)
WriteFile.Write fileContent
WriteFile.Close
Set fs = Nothing
Else
fileContent = ADODB_LoadFile("inc/style" & N & ".css")
ADODB_SaveToFile GetNewStrCSS(fileContent),"inc/style" & N & ".css"
Response.Write GBL_CHK_TempStr
End If
Next

If DEF_MasterCookies = "yellowboard" Then
Dim RandomStr,StrLetter
StrLetter = "abcdefghijklmnopqrstuvwxyz"
Randomize
RandomStr = ""
For N = 1 to 5
RandomStr = RandomStr & Mid(StrLetter,Fix(Rnd*Len(StrLetter))+1,1)
Next
If FSFlag = 1 Then
Set fs = Server.CreateObject(GBL_FSOString)
Set WriteFile = fs.OpenTextFile(Server.MapPath("inc/BBSSetup.asp"),1,True)
If Not WriteFile.AtEndOfStream Then
fileContent = WriteFile.ReadAll
End If
WriteFile.Close
Set fs = Nothing

fileContent = Replace(fileContent,"yellowboard",RandomStr)
Set fs = Server.CreateObject(GBL_FSOString)
Set WriteFile = fs.CreateTextFile(Server.MapPath("inc/BBSSetup.asp"),True)
WriteFile.Write fileContent
WriteFile.Close
Set fs = Nothing
Else
fileContent = ADODB_LoadFile("inc/BBSSetup.asp")
ADODB_SaveToFile Replace(fileContent,"yellowboard",RandomStr),"inc/BBSSetup.asp"
Response.Write GBL_CHK_TempStr
End If
End If

End Sub

Function GetNewStrCSS(Str)

dim re
set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.Pattern="url\(([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/images/skin/"
Str=re.Replace(Str,"url(" & HomeUrl & "/images/skin/")
re.Pattern="BACKGROUND=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/images/skin/"
Str=re.Replace(Str,"BACKGROUND=""" & HomeUrl & "/images/skin/")
re.Pattern="BACKGROUND=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/images/skin/"
Str=re.Replace(Str,"BACKGROUND=" & HomeUrl & "/images/skin/")

re.Pattern="url\(([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/images/skin/"
Str=re.Replace(Str,"url(" & HomeUrl & "/images/skin/")
re.Pattern="BACKGROUND=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/images/skin/"
Str=re.Replace(Str,"BACKGROUND=""" & HomeUrl & "/images/skin/")
re.Pattern="BACKGROUND=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/images/skin/"
Str=re.Replace(Str,"BACKGROUND=" & HomeUrl & "/images/skin/")
Set Re = Nothing
GetNewStrCSS = Str

End Function

Sub InstallLeadBBS_Skin

Dim Temp_HomeUrl
Temp_HomeUrl = "http://"&Request.ServerVariables("server_name")
If Request.ServerVariables("SERVER_PORT") <> "80" Then Temp_HomeUrl = Temp_HomeUrl & ":" & Request.ServerVariables("SERVER_PORT")
Temp_HomeUrl = Lcase(Temp_HomeUrl & Request.Servervariables("SCRIPT_NAME"))
Temp_HomeUrl = Replace(Temp_HomeUrl,"\","/")
If inStr(Temp_HomeUrl,"/") Then Temp_HomeUrl = Left(Temp_HomeUrl,inStrRev(Temp_HomeUrl,"/")-1)

Dim Rs,Temp
Set Rs = Server.CreateObject("ADODB.RecordSet")
Rs.Open "Select * from LeadBBS_Skin",con,2,2
Do While Not Rs.Eof
Rs("SiteHeadString") = GetNewStr(Rs("SiteHeadString") & "",Temp_HomeUrl)
Rs("SiteBottomString") = GetNewStr(Rs("SiteBottomString") & "",Temp_HomeUrl)
Rs("TableHeadString") = GetNewStr(Rs("TableHeadString") & "",Temp_HomeUrl)
Rs("TableBottomString") = GetNewStr(Rs("TableBottomString") & "",Temp_HomeUrl)
Rs.Update
Rs.MoveNext
Loop
Rs.Close
Set Rs = Nothing

End Sub

Function GetNewStr(Str,Temp_HomeUrl)

dim re
set re = New RegExp
re.Global = True
re.IgnoreCase = True
re.Pattern="=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/images/skin/"
Str=re.Replace(Str,"=""" & HomeUrl & "/images/skin/")
re.Pattern="=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/images/skin/"
Str=re.Replace(Str,"=" & HomeUrl & "/images/skin/")
re.Pattern="\',\'\',\'([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/images/skin/"
Str=re.Replace(Str,"','','" & HomeUrl & "/images/skin/")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/user/help/about.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/user/help/about.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/user/help/about.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/user/help/about.asp")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/user/help/help.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/user/help/help.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/user/help/help.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/user/help/help.asp")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/User/UserJoin.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/User/UserJoin.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/User/UserJoin.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/User/UserJoin.asp")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/User/LookUserInfo.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/User/LookUserInfo.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/User/LookUserInfo.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/User/LookUserInfo.asp")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/User/UserTop.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/User/UserTop.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/User/UserTop.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/User/UserTop.asp")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/Search/Search.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/Search/Search.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/Search/Search.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/Search/Search.asp")

re.Pattern="action=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/Search/Search.asp"
Str=re.Replace(Str,"action=""" & HomeUrl & "/Search/Search.asp")
re.Pattern="action=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/Search/Search.asp"
Str=re.Replace(Str,"action=" & HomeUrl & "/Search/Search.asp")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/Boards.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/Boards.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]?)/Boards.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/Boards.asp")

re.Pattern="http://www.leadbbs.com/"
Str=re.Replace(Str,Temp_HomeUrl)


re.Pattern="=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/images/skin/"
Str=re.Replace(Str,"=""" & HomeUrl & "/images/skin/")
re.Pattern="=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/images/skin/"
Str=re.Replace(Str,"=" & HomeUrl & "/images/skin/")
re.Pattern="\',\'\',\'([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/images/skin/"
Str=re.Replace(Str,"','','" & HomeUrl & "/images/skin/")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/user/help/about.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/user/help/about.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/user/help/about.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/user/help/about.asp")

re.Pattern="href=\""([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/user/help/help.asp"
Str=re.Replace(Str,"href=""" & HomeUrl & "/user/help/help.asp")
re.Pattern="href=([A-Za-z0-9\./=\%\-&_~`@[\]\':+!#\ ]+)/user/help/help.asp"
Str=re.Replace(Str,"href=" & HomeUrl & "/user/help/help.asp")
re.Pattern="http://www.leadbbs.com/"
Str=re.Replace(Str,Temp_HomeUrl)
Set Re = Nothing
GetNewStr = Str

End Function

function deletefiles()

  on error resume next
    dim fs
    Set fs=Server.CreateObject(GBL_FSOString)
    if fs.FileExists(Server.Mappath("setup.asp")) then
      fs.DeleteFile Server.Mappath("setup.asp"),True
      deletefiles = 1
      Response.Write "<p><b><font color=Green>成功删除Setup.asp文件,安装完成.</font></b>"
    else
      Response.Write "<p><b><font color=Green>Setup.asp文件已经不存在,不需要再作删除,安装完成.</font></b>"
      deletefiles = 0
    end if
    Set fs=nothing
       
end function

Sub Main

Response.Write "<p><b>当前安装绝对路径:</b>" & HomeUrl
OpenDatabase
InstallLeadBBS_Skin
Response.Write "<p><b><font color=green>完成风格更多参数定义的安装路径更新.</font></b>"
CloseDatabase
If FSFlag = 0 Then
Response.Write "<p><font color=Red>服务器不支持FSO,将不能完成inc目录下面的CSS文件的目录自动更新,请手动更改.<br>提示:打开所有的.css文件,将字符串 " & Old_HomeUrl & "images/ 更改为 " & HomeUrl & "images/</font></p>"
Else
InstallLeadBBS_CSSFile
Response.Write "<p><b><font color=green>成功完成16种风格的路径安装.</font></b>"
End If
Application.Lock
'Application.Contents.RemoveAll()
FreeApplicationMemory
Application.UnLock
Response.Write "<p><b><font color=green>成功完成论坛重新启动.</font></b>"
If FSFlag = 0 Then
Response.Write "<p><font color=Red>服务器不支持FSO,不能自动删除Setup.asp文件,请登录FTP手动删除此文件.(注意一定要删除Setup.asp以保证论坛正常)</font></p>"
Else
deletefiles
End If
Response.Write "<p><b><a href=" & HomeUrl & ">点击这里进入论坛.</a></b>"

End Sub

Sub Setup

'If Lcase(HomeUrl) = Lcase(Old_HomeUrl) Then
' Response.Write "安装路径已经是 " & Old_HomeUrl & ",不需要更新安装."
' Response.Write "<p><a href=" & Old_HomeUrl & ">点击这里进入论坛</a>"
'Else
If Request("submitflag") = "yes" then
Main
Else
%>
<p style=FONT-SIZE:9pt;>
  ==========================================================<br>
&nbsp;<b>LeadBBS v3.14初始化安装路径程序</b><br>
==========================================================<br></p>
<p style=FONT-SIZE:9pt;><br>
注意,此功能将完成以下功能:<br><br>
&nbsp; &nbsp; &nbsp; 1.自动完成更新更多风格的图片路径。<br>
&nbsp; &nbsp; &nbsp; 2.自动完成16种风格的CSS文件背景图片路径.<br>
&nbsp; &nbsp; &nbsp; 3.论坛重新启动.<br>
&nbsp; &nbsp; &nbsp; 4.删除安装文件.<br><br>
安装过程中需要服务器支持文件写入,如果不支持文件写入,将不能完成下列操作:<br><br>
&nbsp; &nbsp; &nbsp; 1.INC目录下面16个CSS文件的图片路径的自动更改.<br>
&nbsp; &nbsp; &nbsp; 2.不支持FSO将不能自动删除Setup.asp文件,请使用FTP手动删除此文件.<br>
<br>
<b><font color=ff0000 class=RedFont>确认信息: 真的要更新论坛安装路径么?</font></b><br><br>
<p>
<input type=button value="点击开始安装" onclick="javascript:document.location.href='Setup.asp?submitflag=yes';" class=fmbtn style=FONT-SIZE:9pt;>
<%
End If
'End If

End Sub

Function FreeApplicationMemory

'Response.Write "<p><b>释放论坛数据列表:</b><table>" & VbCrLf
Dim Thing
For Each Thing in Application.Contents
If Left(Thing,Len(DEF_MasterCookies)) = DEF_MasterCookies Then
'Response.Write "<tr><td><font color=Gray class=GrayFont>" & thing & "</font></td><td>&nbsp;"
If isObject(Application.Contents(Thing)) Then
Application.Contents(Thing).close
Set Application.Contents(Thing) = Nothing
Application.Contents(Thing) = null
'Response.Write "对象成功关闭"
ElseIf isArray(Application.Contents(Thing)) Then
Set Application.Contents(Thing) = Nothing
Application.Contents(Thing) = null
'Response.Write "数组成功释放"
Else
Response.Write htmlencode(Application.Contents(Thing))
Application.Contents(Thing) = null
End If
'Response.Write "</td></tr>"
End If
Next
'Response.Write "</table>"
on error resume next
Application.Contents.RemoveAll

End Function

Function htmlEncode(str)

If len(str)>0 Then
'htmlEncode=Replace(Replace(Replace(Replace(str,"&","&amp;"),">","&gt;"),"<","&lt;"),"""","&quot;")
htmlEncode=Replace(Replace(Replace(str,">","&gt;"),"<","&lt;"),"""","&quot;")
Else
htmlEncode=str
End If

End Function


Function ADODB_LoadFile(ByVal File)

Dim objStream
'On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
GBL_CHK_TempStr = "<div align='center'>您的主机不支持ADODB.Stream,无法完成操作,请手工进行</div>"
Err.Clear
Set objStream = Noting
Exit Function
End If
With objStream
.Type = 2
.Mode = 3
.Open
.LoadFromFile Server.MapPath(File)
If Err.Number<>0 Then
GBL_CHK_TempStr = "<div align='center'>文件<font color='#ff0000'>"&File&"</font>无法被打开,请检查是否存在!</font></div>"
Err.Clear
.Close
Set objStream = Noting
Exit Function
End If
.Charset = "GB2312"
.Position = 2
ADODB_LoadFile = .ReadText
.Close
End With
Set objStream = Nothing

End Function

'存储内容到文件
Sub ADODB_SaveToFile(ByVal strBody,ByVal File)

Dim objStream
On Error Resume Next
Set objStream = Server.CreateObject("ADODB.Stream")
If Err.Number=-2147221005 Then
GBL_CHK_TempStr = "<div align='center'>您的主机不支持ADODB.Stream,无法完成操作,请手工进行</div>"
Err.Clear
Set objStream = Noting
Exit Sub
End If
With objStream
.Type = 2
.Open
.Charset = "GB2312"
.Position = objStream.Size
.WriteText = strBody
.SaveToFile Server.MapPath(File),2
.Close
End With
Set objStream = Nothing

End Sub

Setup%>

地主 发表时间: 06-10-24 09:24

回复: 在20CN沦落 [poemail]   论坛用户   登录
MapPath后面是数据库对象路径,而你这里通过DEF_AccessDatabase再定义了数据库路径,在这段代码中,没有找到DEF_AccessDatabase的定义的语句,证明数据库链接文件不在这个程序中,
以下是你的代码:
------------------------------------
On error Resume Next
set con = Server.CreateObject("ADODB.Connection")
'Con.ConnectionString = "driver={Microsoft Access Driver (*.mdb)};dbq=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
Con.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath(DEF_BBS_HomeUrl & DEF_AccessDatabase)
con.open
if Err Then
------------------------------------------
不过看到你下面的代码:
----------------------------------------
If FSFlag = 1 Then
Set fs = Server.CreateObject(GBL_FSOString)
Set WriteFile = fs.OpenTextFile(Server.MapPath("inc/BBSSetup.asp"),1,True)
If Not WriteFile.AtEndOfStream Then
fileContent = WriteFile.ReadAll
-----------------------------------------
你打开上面MapPath后面的inc/BBSSetup.asp文件看一下有没有定义数据库的地址?

B1层 发表时间: 06-10-24 14:48

回复: 中国黑客 [asusmlan2]   论坛用户   登录
是的啊,是我打开文件打错了,不是这个文件

B2层 发表时间: 06-10-24 18:08

论坛: 网站建设

20CN网络安全小组版权所有
Copyright © 2000-2010 20CN Security Group. All Rights Reserved.
论坛程序编写:NetDemon

粤ICP备05087286号