thbwn 发布留言 2008-7-23 21:41 [求助]网站打包解包程序（asp)以下代码是网站打包解包程序pack_mdb.asp，将所有网页打包成 mdb文件格式。但在本地测试与所购空间的效果不一样：在本地，写入数据库的路径不是绝对路径(如不写d:\wwwroot)，而在所购空间里却写入绝对路径(d:\host\thbwn0419\wwwroot\……） <%@LANGUAGE="VBSCRIPT" CODEPAGE="936"%>
<%
Option Explicit
'ASP Separation software bundles
dim fsoX
Const isDebugMode = False ''Does debugging mode
Sub createIt(fsoX)
If isDebugMode = False Then
On Error Resume Next
End If
Set fsoX = Server.CreateObject("Scripting.FileSystemObject")
If IsEmpty(fsoX) Then
Set fsoX = fso
End If
If Err Then
Err.Clear
End If
End Sub
Sub chkErr(Err)
If Err Then
echo ""
echo "
error: " & Err.Description & "error: " & Err.Source & "
"
echo "
Powered By thbwn"
Err.Clear
Response.End
End If
End Sub
Sub echo(str)
Response.Write(str)
End Sub
Function HtmlEncode(str)
If isNull(str) Then
Exit Function
End If
HtmlEncode = Server.HTMLEncode(str)
End Function
Sub alertThenClose(strInfo)
Response.Write ""
End Sub
Sub showErr(str)
Dim i, arrayStr
str = Server.HtmlEncode(str)
arrayStr = Split(str, "$$")
' Response.Clear
echo ""
echo "error:
"
For i = 0 To UBound(arrayStr)
echo " " & (i + 1) & ". " & arrayStr(i) & "
"
Next
echo ""
Response.End
End Sub
Call createIt(fsoX)
Call PageAddToMdb()
Set fsoX = Nothing
Sub PageAddToMdb()
Dim theAct, thePath
theAct = Request("theAct")
thePath = Request("thePath")
Server.ScriptTimeOut = 5000
If theAct = "addToMdb" Then
addToMdb(thePath)
alertThenClose("ok!")
Response.End
End If
If theAct = "releaseFromMdb" Then
unPack(thePath)
alertThenClose("ok!")
Response.End
End If
echo ""& vbNewLine
echo ""& vbNewLine
echo "Packing folders / untied device"& vbNewLine
echo "" & vbNewLine
echo ""& vbNewLine
echo ""& vbNewLine
echo "将文件打包成mdb:
"& vbNewLine
echo ""& vbNewLine
echo "
将mdb文件解包(FSO):
"& vbNewLine
echo ""& vbNewLine
echo ""
echo ""
End Sub
Sub addToMdb(thePath)
If isDebugMode = False Then
On Error Resume Next
End If
Dim rs, conn, stream, connStr, adoCatalog
Set rs = Server.CreateObject("ADODB.RecordSet")
Set stream = Server.CreateObject("ADODB.Stream")
Set conn = Server.CreateObject("ADODB.Connection")
Set adoCatalog = Server.CreateObject("ADOX.Catalog")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0; Data Source=" & Server.MapPath("thbwn.mdb")
adoCatalog.Create connStr
conn.Open connStr
conn.Execute("Create Table FileData(Id int IDENTITY(0,1) PRIMARY KEY CLUSTERED, thePath VarChar, fileContent Image)")
stream.Open
stream.Type = 1
rs.Open "FileData", conn, 3, 3
If Request("theMethod") = "fso" Then
fsoTreeForMdb thePath, rs, stream
Else
saTreeForMdb thePath, rs, stream
End If
rs.Close
Conn.Close
stream.Close
Set rs = Nothing
Set conn = Nothing
Set stream = Nothing
Set adoCatalog = Nothing
End Sub
Function fsoTreeForMdb(thePath, rs, stream)
Dim item, theFolder, folders, files, sysFileList
sysFileList = "$badwolf.mdb$badwolf.ldb$"
If fsoX.FolderExists(thePath) = False Then
showErr(thePath & " error!")
End If
Set theFolder = fsoX.GetFolder(thePath)
Set files = theFolder.Files
Set folders = theFolder.SubFolders
For Each item In folders
fsoTreeForMdb item.Path, rs, stream
Next
'川江号子加——————————————————————
dim thbwn,TBpath,itemPath,filen
thbwn=Request.ServerVariables("PATH_INFO")
filen = Right(thbwn,Len(thbwn)-InStrRev(thbwn,"/"))
TBpath=Replace(Server.mappath(thbwn),filen,"")'_________________________________________________________
For Each item In files
If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
rs.AddNew
rs("thePath") = Replace(item.Path,TBpath,"")
stream.LoadFromFile(item.Path)
rs("fileContent") = stream.Read()
rs.Update
End If
Next
Set files = Nothing
Set folders = Nothing
Set theFolder = Nothing
End Function
Sub unPack(thePath)
If isDebugMode = False Then
On Error Resume Next
End If
Server.ScriptTimeOut = 5000
Dim rs, ws, str, conn, stream, connStr, theFolder
str = Server.MapPath(".") & "\"
Set rs = CreateObject("ADODB.RecordSet")
Set stream = CreateObject("ADODB.Stream")
Set conn = CreateObject("ADODB.Connection")
connStr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & thePath & ";"
conn.Open connStr
rs.Open "FileData", conn, 1, 1
stream.Open
stream.Type = 1
Do Until rs.Eof
theFolder = Left(rs("thePath"), InStrRev(rs("thePath"), "\"))
If fsoX.FolderExists(str & theFolder) = False Then
createFolder(str & theFolder)
End If
stream.SetEos()
stream.Write rs("fileContent")
stream.SaveToFile str & rs("thePath"), 2
rs.MoveNext
Loop
rs.Close
conn.Close
stream.Close
Set ws = Nothing
Set rs = Nothing
Set stream = Nothing
Set conn = Nothing
End Sub
Sub createFolder(thePath)
Dim i
i = Instr(thePath, "\")
Do While i > 0
If fsoX.FolderExists(Left(thePath, i)) = False Then
fsoX.CreateFolder(Left(thePath, i - 1))
End If
If InStr(Mid(thePath, i + 1), "\") Then
i = i + Instr(Mid(thePath, i + 1), "\")
Else
i = 0
End If
Loop
End Sub
Sub saTreeForMdb(thePath, rs, stream)
Dim item, theFolder, sysFileList
sysFileList = "$badwolf.mdb$badwolf.ldb$"
Set theFolder = saX.NameSpace(thePath)
'川江号子加——————————————————————
dim thbwn,TBpath,itemPath,filen
thbwn=Request.ServerVariables("PATH_INFO")
filen = Right(thbwn,Len(thbwn)-InStrRev(thbwn,"/"))
TBpath=Replace(Server.mappath(thbwn),filen,"")'_________________________________________________________
For Each item In theFolder.Items
If item.IsFolder = True Then
saTreeForMdb item.Path, rs, stream
Else
If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
rs.AddNew
rs("thePath") = Replace(item.Path,TBpath,"")
stream.LoadFromFile(item.Path)
rs("fileContent") = stream.Read()
rs.Update
End If
End If
Next
Set theFolder = Nothing
End Sub
%> |
[ 本帖最后由 thbwn 于 2008-7-23 22:46 编辑 [/it]] multiple1902 发布留言 2008-7-23 21:57 那你打算怎么办？ 显然，思路是这样的：看看哪行代码是写入数据库的，在前面肯定要获得路径，在获得路径之后把站点根路径从获得的路径里删去。 站点根路径 Request.ServerVariables("APPL_PHYSICAL_PATH") thbwn 发布留言 2008-7-23 22:47 我采取替换的方法了，在本地测试是没有问题，可传到空间就不行了 thbwn 发布留言 2008-7-23 22:51 item.Path是网页文件的绝对路径 ------------------------------------------------ 以下代码是获取执行压缩的asp文件的绝对路径： dim thbwn,TBpath,itemPath,filen thbwn=Request.ServerVariables("PATH_INFO") filen = Right(thbwn,Len(thbwn)-InStrRev(thbwn,"/")) TBpath=Replace(Server.mappath(thbwn),filen,"") -------------------------------------------------------- 然后：Replace(item.Path,TBpath,"")，用空替换掉前面的路径，并把后面的路径写入数据库。 可是传到空间不成功，还是把网页的绝对路径写入了，在当地是行的。 页: [1]
特别说明：如网页特效代码中有引用图片文件等，请自己下载到本地调试！ |
