<!--#include file="../../../inc/cms_admin.asp" -->
<%
dim act,filename,RangeStart,ResponseRange,TotalBytes,CurrentLastBytes,RemoteFileUrl,RemoteFileSize
dim  LocalFile,BlockSize,BlockTimeout,BlockStartTime,installpath,installfso,installsql
Dim FileDownStart,FileDownEnd ,FileDownBytes,DownStartTime,DownEndTime,DownAvgSpeed , BlockEndTime,BlockAvgSpeed,DownPercent, adosCacheSize
  act=getForm("act","get")
  BlockSize = 512*1024
 RemoteFileUrl=iif(ifstrin(verurl,"http"),verurl,"http://"&verurl)
 RemoteFileSize=getRemoteFileSize(RemoteFileUrl)
 filename=GetFileName(verurl)
select case act
  case "download"
  download()
  if UnTar(sitepath&uploadpath&filename&".tar")=1 then
	 	DownStartTime=now()
	   installpath= sitepath&uploadpath&filename&"/#install.inc"
	   if isfile(installpath) then
	 	echo "<script> parent.window.document.getElementById(""updataing"").innerHTML=""<i class='fa fa-spinner'></i> 安装中"";</script>" & vbNewLine
	 	dim newfso : Set newfso=Server.CreateObject("Scripting.FileSystemObject")
		set installfso=newfso.OpenTextFile(setfolder(installpath), 1)
		installsql = installfso.ReadAll : installfso.Close:	Set installfso = nothing
	 	Execute installsql
		if err then echop err.description
		echo "<script>document.getElementById(""downpercent"").innerHTML=""99%"";document.getElementById(""percentdone"").style.width=""99%"";$(""#status"").append(""<p><span>"&time&"</span><strong>安装完毕！用时：" & S2T(DateDiff("s",DownStartTime,now())) & "</strong></p>"");  parent.window.document.getElementById(""updataing"").innerHTML=""<i class='fa fa-check'></i> 安装完成，删除补丁"";</script>" & vbNewLine
		delfolder(sitepath&uploadpath&filename)
		delfile(sitepath&uploadpath&filename&".tar")
		echo "<script>document.getElementById(""downpercent"").innerHTML=""100%"";document.getElementById(""percentdone"").style.width=""100%"";$(""#status"").append(""<p><span>"&time&"</span><strong>升级完毕！已删除升级补丁</strong></p>"");parent.$(""#updataing"").attr(""onclick"",""window.parent.location.reload()"");  parent.$(""#updataing"").html(""<i class='fa fa-check'></i> 安装完成，请按F5刷新"");</script>" & vbNewLine
	   else
	    die "<script>document.getElementById(""downpercent"").innerHTML=""98%"";document.getElementById(""percentdone"").style.width=""98%"";$(""#status"").append(""<p><span>"&time&"</span><strong>安装失败，缺少安装文件</strong></p>"");  parent.window.document.getElementById(""updataing"").innerHTML=""<i class='fa fa-warning'></i> 安装失败"";</script>" & vbNewLine
	   end if
   end if
end select
 'UnTar sitepath&uploadpath&filename&".tar"	
 Function UnTar(TarFilename)
	  Dim objHeadStream, objBinStream, objOutStream, sHeader, sFilename, sFlag, lFileSize, iPadSize, i
	  DownStartTime = Now()
	  Set objHeadStream = Server.CreateObject("ADODB.Stream") 'The stream for file header
	  Set objBinStream = Server.CreateObject("ADODB.Stream") 'The stream for file contents
	  Set objOutStream = Server.CreateObject("ADODB.Stream") 'The ouput stream for file
	  objHeadStream.Type = 2
	  objHeadStream.Charset = "x-ansi"
	  objHeadStream.Open
	  objHeadStream.LoadFromFile(Server.Mappath(TarFilename))
	  
	  objBinStream.Type = 1
	  objBinStream.Open
	  objBinStream.LoadFromFile(Server.Mappath(TarFilename))
	  
	  objOutStream.Type = 1
	  objOutStream.Open	 
		do
		  sHeader = objHeadStream.ReadText(135)		  
		  sFilename = CheckFileName(Replace(Left(sHeader,100),Chr(0),""))		
		  sFlag = Mid(sHeader,101,3)
		  lFileSize = Clng(Right(sHeader,11))
		  lFileSize = Bin2Dec(Oct2Bin(lFileSize)) 'folder has a size 4096
		  objHeadStream.ReadText(377)
			objBinStream.Read(BlockSize/1024) 'skip the header stuff				
			if sFlag = "100" then 'flag of files, 40=folder			
			  objHeadStream.ReadText(lFileSize)
			  objOutStream.SetEOS()			
			  objOutStream.Write objBinStream.Read(lFileSize)
			  objOutStream.savetofile Server.Mappath(sFilename),2
			end if
		  
		  iPadSize = 0
		  do while (objHeadStream.ReadText(1) = Chr(0))
		  	iPadSize = iPadSize + 1
		  loop
			if objHeadStream.eos then
				exit do
			end if
		  objHeadStream.Position = objHeadStream.Position - 1
		  if iPadSize > 0 then
		   objBinStream.Read(iPadSize) 'Padding to the nearest block byte boundary
		  end if
		loop
		echo "<script>document.getElementById(""downpercent"").innerHTML=""98%"";document.getElementById(""percentdone"").style.width=""98%"";$(""#status"").append(""<p><span>"&time&"</span><strong>解压完毕！用时：" & S2T(DateDiff("s",DownStartTime,now())) & "</strong></p>"");  parent.window.document.getElementById(""updataing"").innerHTML=""<i class='fa fa-gears'></i> 解压完成,开始安装"";</script>" & vbNewLine
	  objHeadStream.Close
	  objBinStream.Close
	  objOutStream.Close
	  Set objHeadStream = Nothing
	  Set objBinStream = Nothing
	  Set objOutStream = Nothing
	  UnTar = 1
	End Function

  Function CheckFileName(sPath)
	  Dim aPaths, i, tmpPath,SaveToPath
	  Dim objFileSystem
	  Set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")
		SaveToPath = sitepath&uploadpath&filename
	  if Instr(sPath,"\") then
		  aPaths = Split(Replace(SaveToPath,"/","\")&"\"&sPath,"\")
	  else
		  aPaths = Split(Replace(SaveToPath,"\","/")&"/"&sPath,"/")
	  end if
	  tmpPath = ""
	  for i = 0 to UBound(aPaths)-1
		  tmpPath = tmpPath & aPaths(i) & "/"
	if(not objFileSystem.FolderExists(Server.MapPath(tmpPath))) then
	  objFileSystem.CreateFolder(Server.MapPath(tmpPath))
	end if
	  next
	  CheckFileName = Join(aPaths,"/")
  End Function
	
 Function Oct2Bin(num)
		Dim OcBstr, i
		OcBstr=""
		if len(num)>0 and isnumeric(num) then
		for i=1 to len(num)
			select case (mid(num,i,1))
				case "0" OcBstr=OcBstr&"000"
				case "1" OcBstr=OcBstr&"001"
				case "2" OcBstr=OcBstr&"010"
				case "3" OcBstr=OcBstr&"011"
				case "4" OcBstr=OcBstr&"100"
				case "5" OcBstr=OcBstr&"101"
				case "6" OcBstr=OcBstr&"110"
				case "7" OcBstr=OcBstr&"111"
			end select
		next
		end if
		Oct2Bin=OcBstr
 End Function
 
 Private Function Bin2Dec(num)
		Dim cDecstr, i
		cDecstr=0
		if len(num)>0 and isnumeric(num) then
			for i=0 to len(num)-1
				cDecstr=cDecstr+2^i*cint(mid(num,len(num)-i,1))
			next
		end if
		Bin2Dec=cDecstr
	End Function
	
function download()	
 dim http,ados,adosCache,downfso
  Set http = Server.CreateObject("Msxml2.ServerXMLHTTP")
  Set adosCache = Server.CreateObject("Adodb.Stream")
  Set ados = Server.CreateObject("Adodb.Stream")	
	BlockTimeout = 64
	'On Error Resume Next	
	LocalFile=setfolder(sitepath&uploadpath&filename&".tar")
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
	If Err Then  die "服务器不支持Msxml，本程序无法运行！"&err.number&err.description
	Set downfso = Server.CreateObject("Scripting.FileSystemObject")
	If downfso.FileExists(LocalFile) Then  '判断要下载的文件是否已经存在
		RangeStart = downfso.GetFile(LocalFile).Size  '若存在,以当前文件大小作为开始位置
	Else
		RangeStart = 0  '若不存在,一切从零开始
		downfso.CreateTextFile(LocalFile).Close  '新建文件
	End If	
	Set downfso = Nothing
	'echop LocalFile
	'if not isfile(LocalFile) then die "文件创建失败"&LocalFile
	  
	FileDownStart = RangeStart
	
	adosCache.Type = 1  '数据流类型设为字节
	adosCache.Mode = 3  '数据流访问模式设为读写
	adosCache.Open
	adosCacheSize = 4 * 1024 * 1024  '设为4M,获取的数据先放到(内存)缓冲区中,当缓冲区满的时候数据写入磁盘	
	DownStartTime = Now()
	
	Response.Clear
	%>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
<script src="<%=sitepath%>js/jquery.min.js"></script>
<link href="<%=sitepath%>css/bootstrap.min.css" rel="stylesheet">
<link href="<%=sitepath&adminPath%>css/adminstyle.css" rel="stylesheet">
<div class="wrapper wrapper-content fadeInUp">
  <div class="ibox-content">
    <div class="col-sm-12">
      <div>已完成：<span id="downsize" style="color:red">0</span>&nbsp;/&nbsp;<span id="totalbytes" ><%=RemoteFileSize%></span>字节</div>
      <div>速度：<span id="blockavgspeed">0</span>K/秒</div>
      <div class="progress progress-striped active m-b-sm" id="percent">
        <div style="width:0%;" id="percentdone" class="progress-bar"></div>
        <span id="downpercent"></span> </div>
      <div id="status">
        <p><span><%=time()%></span>开始下载！请稍后...</p>
      </div>
    </div>
  </div>
</div>
<%
Response.Flush	
Do
  BlockStartTime = Timer() 
  http.open "GET",RemoteFileUrl,true,"",""  '用异步方式调用serverxmlhttp
  '构造http头
  http.setRequestHeader "Referer",""
  http.setRequestHeader "Accept","*/*"
  http.setRequestHeader "User-Agent","Baiduspider+(+http://www.baidu.com/search/spider.htm)"  '伪装成Baidu
  'http.setRequestHeader "User-Agent","Googlebot/2.1 (+http://www.google.com/bot.html)"  '伪装成Google
  http.setRequestHeader "Range","bytes=" & RangeStart & "-" & Cstr(RangeStart + BlockSize - 1)  '分段关键
  http.setRequestHeader "Content-Type","application/octet-stream"
  http.setRequestHeader "Pragma","no-cache"
  http.setRequestHeader "Cache-Control","no-cache"
  http.send  '发送 
   While (http.readyState <> 4)
    '判断是否块超时
    temp = Timer() - BlockStartTime
    If (temp > BlockTimeout) Then
      http.abort
      echo "<script>$(""#status"").append(""<p><span>"&time&"</span><strong>错误：数据下载超时，建议重试。</strong></p>"");</script>" & vbNewLine & "</body></html>"
      Call ErrHandler()
   adosCache.Close
  Set ados = Nothing
  Set http = Nothing
  Set adosCache = Nothing
	    Response.End
    End If
    http.waitForResponse 1000  '等待1000毫秒
  Wend


  '循环等待数据接收
  While (http.readyState <> 4)
    '判断是否块超时
    temp = Timer() - BlockStartTime
    If (temp > BlockTimeout) Then
      http.abort	  
      echo "<script>$(""#status"").append(""<p><span>"&time&"</span><strong>错误：数据下载超时，建议重试。</strong></p>"");</script>" & vbNewLine & "</body></html>"
	  Call ErrHandler()
   adosCache.Close
  Set ados = Nothing
  Set http = Nothing
  Set adosCache = Nothing
      Response.End
    End If

    http.waitForResponse 1000  '等待1000毫秒
  Wend

  '检测状态
  If http.status = 416 Then  '服务器不能满足客户在请求中指定的Range头。应当是已下载完毕。
    FileDownEnd = FileDownStart  '设置一下FileDownEnd，免得后面的FileDownBytes计算出错
 adosCache.Close
  Set ados = Nothing
  Set http = Nothing
  Set adosCache = Nothing
    Exit Do
  End If

  '检测状态
  If http.status > 299 Then  'http出错
    echo "<script>$(""#status"").append(""<p><span>"&time&"</span><strong>http错误：" & http.status & "&nbsp;" & http.statusText & "</strong></p>"");</script>" & vbNewLine & "</body></html>"
    Call ErrHandler()
 adosCache.Close
  Set ados = Nothing
  Set http = Nothing
  Set adosCache = Nothing
    Response.End
  End If

  '检测状态
  If http.status <> 206 Then  '服务器不支持断点续传
    echo "<script>$(""#status"").append(""<p><span>"&time&"</span><strong>错误：服务器不支持断点续传！</strong></p>"");</script>" & vbNewLine & "</body></html>"
    Call ErrHandler()
 adosCache.Close
  Set ados = Nothing
  Set http = Nothing
  Set adosCache = Nothing
    Response.End
  End If

  '检测缓冲区是否已满
  If adosCache.Size >= adosCacheSize Then
    '打开磁盘上的文件
    ados.Type = 1  '数据流类型设为字节
    ados.Mode = 3  '数据流访问模式设为读写
    ados.Open
    ados.LoadFromFile LocalFile  '打开文件
    ados.Position = ados.Size  '设置文件指针初始位置

    '将缓冲区数据写入磁盘文件
    adosCache.Position = 0
    ados.Write adosCache.Read
    ados.SaveToFile LocalFile,2  '覆盖保存
    ados.Close

    '缓冲区复位
    adosCache.Position = 0
    adosCache.SetEOS
  End If
  
  '保存块数据到缓冲区中
  adosCache.Write http.responseBody  '写入数据
  ResponseRange = http.getResponseHeader("Content-Range")  '获得http头中的"Content-Range"
    '判断是否全部(块)下载完毕  
  If ResponseRange = "" Then  '没有它就不知道下载完了没有
    echo "<script>$(""#status"").append(""<p><span>"&time&"</span><strong>错误：文件长度未知！</strong></p>"");</script>" & vbNewLine & "</body></html>"
 adosCache.Close
  Set ados = Nothing
  Set http = Nothing
  Set adosCache = Nothing
    Response.End
  End If
	temp = Mid(ResponseRange,Instr(ResponseRange,"-")+1)  'Content-Range是类似123-456/789的样子
	CurrentLastBytes = Clng(Left(temp,Instr(temp,"/")-1))  '123是开始位置，456是结束位置
	TotalBytes = Clng(Mid(temp,Instr(temp,"/")+1))  '789是文件总字节数
    If TotalBytes - CurrentLastBytes = 1 Then
    FileDownEnd = TotalBytes

    '将缓冲区数据写入磁盘文件
    ados.Type = 1  '数据流类型设为字节
    ados.Mode = 3  '数据流访问模式设为读写
    ados.Open
    ados.LoadFromFile LocalFile  '打开文件
    ados.Position = ados.Size  '设置文件指针初始位置
    adosCache.Position = 0
    ados.Write adosCache.Read
    ados.SaveToFile LocalFile,2  '覆盖保存
    ados.Close

    echo "<script>document.getElementById(""downsize"").innerHTML=""" & TotalBytes & """;</script>" & vbNewLine
    Response.Flush
  adosCache.Close
  Set ados = Nothing
  Set http = Nothing
  Set adosCache = Nothing
    Exit Do  '结束位置比总大小少1就表示传输完成了
  End If
  
  '调整块开始位置，准备下载下一个块
  RangeStart = RangeStart + BlockSize

  '计算块下载速度、进度条宽度、已下载的百分比
  BlockEndTime = Timer()
  temp = (BlockEndTime - BlockStartTime)
  If temp > 0 Then
    BlockAvgSpeed = Int(BlockSize/1024 / temp)
  Else
    BlockAvgSpeed = ""
  End If
  DownPercent = Int(100 * RangeStart / TotalBytes)
  if DownPercent>90 then DownPercent=90
  '更新进度条
  echo "<script>document.getElementById(""downpercent"").innerHTML=""" & DownPercent & "%"";document.getElementById(""downsize"").innerHTML=""" & RangeStart & """;document.getElementById(""totalbytes"").innerHTML=""" & TotalBytes & """;document.getElementById(""blockavgspeed"").innerHTML=""" & BlockAvgSpeed & """;document.getElementById(""percentdone"").style.width=""" & DownPercent & "%"";</script>" & vbNewLine
  Response.Flush
Loop While Response.IsClientConnected

If Not Response.IsClientConnected Then
  Response.End
End If

DownEndTime = Now()
FileDownBytes = FileDownEnd - FileDownStart
temp = DateDiff("s",DownStartTime,DownEndTime)
If (FileDownBytes <> 0) And (temp <> 0) Then
  DownAvgSpeed = Int((FileDownBytes / 1024) / temp)
Else
  DownAvgSpeed = ""
End If

'全部下载完毕后更新进度条
echo "<script>document.getElementById(""downsize"").innerHTML="""&RemoteFileSize&""";document.getElementById(""downpercent"").innerHTML=""93%"";document.getElementById(""percentdone"").style.width=""93%"";$(""#status"").append(""<p><span>"&time&"</span><strong>下载完毕！用时：" & S2T(DateDiff("s",DownStartTime,DownEndTime)) & "，平均下载速度：" & DownAvgSpeed & "K/秒</strong></p>"");  parent.window.document.getElementById(""updataing"").innerHTML=""<i class='fa fa-folder-open'></i> 下载完成,开始解压"";</script>" & vbNewLine
end function

Function getRemoteFileSize(url)
Dim xmlHTTP
Set xmlHTTP = Server.CreateObject("MSXML2.XMLHTTP")
xmlHTTP.open "get", url, false
'下一句非常关键，否则要预加载全部的文件信息后才返回header头信息
xmlHTTP.setRequestHeader "range", "bytes=-1"
xmlHTTP.send()
getRemoteFileSize = Split(xmlHTTP.GetResponseHeader("Content-Range"),"/")(1)
Set xmlHTTP = Nothing
End Function

Sub ErrHandler()
  Dim fso:  Set fso = Server.CreateObject("Scripting.FileSystemObject")
  If fso.FileExists(LocalFileFullPhysicalPath) Then  '判断要下载的文件是否已经存在
    If fso.GetFile(LocalFileFullPhysicalPath).Size = 0 Then  '若文件大小为0
      fso.DeleteFile LocalFileFullPhysicalPath  '删除文件
    End If
  End If
  Set fso = Nothing
End Sub

Function S2T(ByVal s)
  Dim x,y,z,t
  If s < 1 Then
    S2T = (s * 1000) & "毫秒"
  Else
    s = Int(s)
    x = Int(s / 3600)
    t = s - 3600 * x
    y = Int(t / 60)
    z = t - 60 * y
    If x > 0 Then
      S2T = x & "小时" & y & "分" & z & "秒"
    Else
      If y > 0 Then
        S2T = y & "分" & z & "秒"
      Else
        S2T = z & "秒"
      End If
    End If
  End If
End Function
%>
