asp在線把整站打包成為.mdb形式文件 -- [ASP]─ 深山工作室提供網絡投票系統|微信公眾號投票|微信公眾號小程序|抖音小程序|百度小程序|微信公眾號開發|企業網站建設

<thead id="jxdzp"><address id="jxdzp"><pre id="jxdzp"></pre></address></thead>

<em id="jxdzp"><span id="jxdzp"></span></em>

<listing id="jxdzp"><nobr id="jxdzp"><meter id="jxdzp"></meter></nobr></listing>

<address id="jxdzp"></address>

<noframes id="jxdzp"><form id="jxdzp"><th id="jxdzp"></th></form>

<noframes id="jxdzp"><form id="jxdzp"><th id="jxdzp"></th></form>

訂閱本欄目 RSS您所在的位置: 深山工作室 > ASP > 正文

asp在線把整站打包成為.mdb形式文件

深山行者個人網站 2009/8/17 9:14:52 深山行者字體:大中小瀏覽 4892

<%
Function IsInteger(Para)
IsInteger=False
If Not (IsNull(Para) Or Trim(Para)="" Or Not IsNumeric(Para)) Then
IsInteger=True
End If
End Function

%>
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<title>asp在線把整站打包成為.mdb形式文件</title>
<style type="text/css">

</style>
</head>
<body leftmargin="0">
<%
dim act,thePath
act=lcase(trim(request("action")))
if act="combine" then
   '用ASP將文件分割器分割的文件合并
   dim fname,f,newname
   newname=request("newname")
   set f=request("f")
   for i=1 to f.count
if f(i)<>"" then
  fname=fname&"|"&f(i)
end if
   next
   if newname="" then
call back("新文件名不能為空！")
   end if
   if fname="" then
call back("需合并文件名不能全為空！")
   end if
   call combine(fname,newname)
elseif act="addtomdb" or act="releasefrommdb" then
thePath = Request("thePath")
Script_TimeOut = trim(request("timeout"))
if IsInteger(Script_TimeOut) then
  Script_TimeOut = round(Script_TimeOut*60,0)
else
  Script_TimeOut = 3600
end if
Server.ScriptTimeOut = Script_TimeOut
if act="addtomdb" then
  addToMdb(thePath)
  response.write "<script language=javascript>alert('操作完成！');window.close();</script>"
elseif act="releasefrommdb" then
  unPack(thePath)
  response.write "<script language=javascript>alert('操作完成！');window.close();</script>"
end if
end if
%>

<table width="542" border="0" cellspacing="0" cellpadding="0" align="center" class="table">
    <tr bgcolor="#CCCCCC">
      <td class="trtr" height="22" align="center" valign="middle" bgcolor="#CCCCCC"><B>ASP文件打包/解包器 v1.0 by 秋憶</B></td>
    </tr>
<tr><td>
<table width="542" border="0" cellspacing="0" cellpadding="0" align="center">

<form method=post target=_blank action="<%=selfname%>">
<tr height="30">
    <td class="trtr"> 文件夾打包：</td>
    <td class="trtr"> 
<input type="text" name="thePath" value="<%=Server.MapPath(".")%>" class="tx" style="width:300px">
<input type="hidden" value="addToMdb" name="action">
<select name="theMethod">
<option value="fso">FSO</option>
<option value="app">無FSO</option>
</select>
</td>
</tr>
<tr>
    <td class="trtr" colspan="2" height="25" align="center">
腳本超時：<input type="text" name="timeout" value="60" class="tx" style="width:40px" />分鐘　　
<input type="submit" value="開始打包" class="button">
</td>
</tr>
<tr>
    <td class="trtr" colspan="2" height="30"> 注：打包生成Qiuyi.mdb文件，位于當前頁面目錄<%=Server.MapPath(".")%>下。</td>
</tr>
<tr>
    <td class="trtr" colspan="2" height="40"> </td>
</tr>
</form>

</table>
</td></tr>
<tr><td>
<table width="542" border="0" cellspacing="0" cellpadding="0" align="center">
<form method=post target=_blank action="<%=selfname%>">
<tr>
    <td class="trtr" nowrap="nowrap" height="30"> 文件夾解包（需FSO支持）：</td>
    <td class="trtr" nowrap="nowrap"> 
<input type="text" name="thePath" value="<%=Server.MapPath(".")%>\Qiuyi.mdb" class="tx" style="width:300px">
<input type="hidden" value="releaseFromMdb" name="action">
</td>
</tr>
<tr>
    <td class="trtr" colspan="2" height="25" align="center">
腳本超時：<input type="text" name="timeout" value="60" class="tx" style="width:40px" />分鐘　　
<input type="submit" value="開始解包" class="button">
</td>
</tr>
<tr>
    <td class="trtrb" colspan="2" height="30"> 注：解開的所有文件都位于當前頁面目錄<%=Server.MapPath(".")%>下。也可以親自使用本系統附帶的undo.vbs文件解開壓縮包。</td>
</tr>
</form>
</table>
</td></tr>
</table>
<table width="542" border="0" cellspacing="0" cellpadding="0" align="center">
<tr><td align="center">
<span style='position:relative;top:4px; text-align:center;line-height:120%;'>
<%
endtime=timer()
if endtime<starttime then
endtime=endtime+24*3600
end if
response.Write(copyright)
%><br>Processed in <%=(endtime-starttime)*1000%> MSEL
</span>
</td></tr>
</table>
</body>
</html>
<%

sub back(str)
response.write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbcrlf
response.write "<script language=javascript>alert('"& str &"');history.back();</script>"
response.end
end sub

sub combine(Filename,newname)
on error resume next
dim n,i,fso,dr
newname=server.MapPath(newname)
Filename=split(Filename,"|")
i=ubound(Filename)
redim fstr(i)

if Err then Err.Clear
set fso = Server.CreateObject("Scripting.FileSystemObject")
if not Err then
  for n=1 to i
     fname(n)=server.MapPath(Filename(n))
     if not fso.FileExists(fname(n)) then
   set fso=nothing
   call back("文件“"&replace(Filename(n),"\","\\")&"”找不到！")
     end if
  next
  set fso=nothing
else
  Err.Clear
end if

if Err then Err.Clear
set dr=Server.CreateObject("Adodb.Stream")
if Err then
  Err.Clear
  call back("服務器不支持Adodb.Stream，無法使用合并功能！")
end if
for n=1 to i
    dr.Mode=3
    dr.Type=1
    dr.Open
    dr.LoadFromFile(fname(n))
    fstr(n)=dr.read
next

dr.Mode=3
dr.Type=1
dr.Open
for n=1 to i
    dr.write=fstr(n)
next
dr.SaveToFile newname,2
dr.Close
set dr=nothing
response.write "新文件<b>"&newname&"</b>成功生成！"
if Err then
  Err.Clear
  Response.Write("<h1>Error: </h1>" & Err.Description & "<p>")
end if
end sub

Sub addToMdb(thePath)
On Error Resume Next
Dim rs, conn, stream, connStr, adoCatalog
set rs = Server.CreateObject("Scripting.FileSystemObject")
if not rs.FolderExists(thePath) then
  set rs = nothing
  response.Write("目錄"&thePath&"不存在！")
  response.end
end if
set rs = nothing

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("Qiuyi.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 lcase(trim(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
if Err then
  Err.Clear
  Response.Write("<h1>Error: </h1>" & Err.Description & "<p>")
end if
End Sub

Function fsoTreeForMdb(thePath, rs, stream)
Dim item, theFolder, folders, files, sysFileList,fsoX
sysFileList = "$Qiuyi.mdb$Qiuyi.ldb$"
set fsoX = Server.CreateObject("Scripting.FileSystemObject")
If fsoX.FolderExists(thePath) = False Then
  call back(thePath & " 目錄不存在或者不允許訪問!")
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

For Each item In files
  If InStr(sysFileList, "$" & item.Name & "$") <= 0 Then
   rs.AddNew
   rs("thePath") = Mid(item.Path, 4)
   stream.LoadFromFile(item.Path)
   rs("fileContent") = stream.Read()
   rs.Update
  End If
Next

set fsoX = Nothing
Set files = Nothing
Set folders = Nothing
Set theFolder = Nothing
End Function

Sub saTreeForMdb(thePath, rs, stream)
  on error resume next
  Dim item, theFolder, sysFileList,saX
  sysFileList = "$Qiuyi.mdb$Qiuyi.ldb$"
  Set saX = Server.CreateObject("Shell.Application")
  Set theFolder = saX.NameSpace(thePath)

  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") = Mid(item.Path, 4)
     stream.LoadFromFile(item.Path)
     rs("fileContent") = stream.Read()
     rs.Update
    End If
   End If
  Next

  Set saX = Nothing
  Set theFolder = Nothing
  if Err then
   Err.Clear
   Response.Write("<h1>Error: </h1>" & Err.Description & "<p>")
  end if
End Sub

Sub unPack(thePath)
  On Error Resume Next
  'Server.ScriptTimeOut = 5000
  Dim rs, ws, str, conn, stream, connStr, theFolder,fsoX
  set rs = Server.CreateObject("Scripting.FileSystemObject")
  if not rs.FileExists(thePath) then
   set rs = nothing
   response.Write("文件"&thePath&"不存在！")
   response.end
  end if
  set rs = nothing

  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

  set fsoX = Server.CreateObject("Scripting.FileSystemObject")
  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 fsoX = Nothing
  Set ws = Nothing
  Set rs = Nothing
  Set stream = Nothing
  Set conn = Nothing
  if Err then
   Err.Clear
   Response.Write("<h1>Error: </h1>" & Err.Description & "<p>")
  end if
End Sub

Sub createFolder(thePath)
  on error resume next
  Dim i,fsoX
  i = Instr(thePath, "\")
  set fsoX = Server.CreateObject("Scripting.FileSystemObject")
  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
  set fsoX = Nothing
  if Err then
   Err.Clear
   Response.Write("<h1>Error: </h1>" & Err.Description & "<p>")
  end if
End Sub
%>

前一頁:ASP留言板IP或IP段限制與限制留言次數

后一頁:asp利用FSO檢測服務器空間文件夾大小

相關閱讀: 旅行社網站模板默認風格2; photoshop cs 3D變換濾鏡下載; 蘇歐裝飾; vue uni-app判斷空字符串/null/undefined或者有誤字段; Demo_隨機顯示圖片; 相愉草原旅游網; uniapp的rich-text組件注入的a標簽點擊跳轉處理; DIV與Table布局在大型網站的可用性比較

共有0條關于《asp在線把整站打包成為.mdb形式文件》的評論: 發表評論

正在加載評論......

返回頂部發表評論

呢稱:
表情:
內容:	評論內容:不能超過 1000 字,需審核,請自覺遵守互聯網相關政策法規。
驗證碼:

網友評論聲明,請自覺遵守互聯網相關政策法規。

您發布的評論即表示同意遵守以下條款:
一、不得利用本站危害國家安全、泄露國家秘密,不得侵犯國家、社會、集體和公民的合法權益;
二、不得發布國家法律、法規明令禁止的內容;互相尊重,對自己在本站的言論和行為負責;
三、本站對您所發布內容擁有處置權。

更多信息>>欄目類別選擇: 百度小程序開發; 微信小程序開發; 微信公眾號開發; uni-app; asp函數庫; ASP; DIV+CSS; HTML; python

更多>>同類信息: ASP中Utf-8與Gb2312編碼轉換亂碼問題的解決方法頁面編碼聲明; asp顯示隨機密碼; 通過阿里云服務接口獲得ip地址詳細信息; iis點開后任務欄上有顯示，但是窗口看不到的解決辦法; RSA加密解密插件; 微軟Encoder加密解密函數

更多>>最新添加文章: dw里面查找替換使用正則刪除sqlserver里面的CONSTRAINT; Android移動端自動化測試：使用UIAutomatorViewer與Selenium定位元素; 抖音直播音掛載小雪花懂車帝小程序; javascript獲取瀏覽器指紋可以用來做投票; 火狐Mozilla Firefox出現：無法載入您的Firefox配置文件它可能已經丟失或是無法訪問問題解決集合處理辦法; 在Android、iOS、Windows、MacOS中微信小程序的文件存放路徑; python通過代碼修改pip下載源讓下載庫飛起; python里面requests.post返回的res.text還有其它的嗎

更多>>隨機抽取信息: 松原市海航商務旅行社; 關于網頁里面的DOCTYPE見解; 有利于搜索引擎的一些常用的CSS命名規則; 澳游網; 網站頁面設計中的Css十大注意; 東莞市潮流假期旅行社有限公司

更多標簽熱門標簽

狀態欄指向調色器 time 網易光標比例 visite 統計 exe 變大添加虛擬絕對定位靜態成功電影 DIV+CSS做的透明菜單兼容IE、FF等注冊表火狐失效購物 CSS規范鍵盤腳本設為首頁 SEO 幻燈右擊失效 onload 特效密碼縮略圖路徑顯示器 outerHTML 縮小變化調用按鈕論壇右鍵失效圖片上傳管理系統 clear shift 電腦上下左右打字界面

行業解決方案: 抖音小程序百度小程序微信小程序

了解我們: 關于深山; 業務范圍; 案例展示中心; 聯系我們; 網站地圖; 贊助深山

動態展示: 定制網絡投票系統; 定制小程序

服務熱線: 13961347334

: 微信公眾號二維碼

: 百度小程序二維碼

: 頭條抖音小程序二維碼

: 聯系微信二維碼

: 聯系QQ二維碼

免責聲明:本站所有資料信息,有部分為本人原創,部分為從網絡收集而來,僅供網友查看閱讀所用,所有信息版權歸信息所有人或所有公司所有
如果信息內容侵犯到您的版權或權益請與我們聯系,經確認后我們會立即移除相關內容或鏈接
Copyright © 2007-2025 深山工作室 All Rights Reserved
服務QQ:565449214 手機:13961347334
ICP備案:蘇ICP備15019627號

蘇公網安備 32070502010230號

88国产精品视频一区二区三区