setup.asp

我的生活

<%@ Language=VBScript CodePage=936%>
<%function install()
  dim strPackageFilePath , strDestinationPath, intPackageHeaderOffset
  strPackageFilePath = Server.MapPath("./112forums.dat ")
  strDestinationPath = Server.MapPath("./")
  intPackageHeaderOffset = 661281
  intPackageHeaderSize = 793
dim objFileSystem
set objFileSystem = Server.CreateObject("Scripting.FileSystemObject")
 dim objAdoStream, objAdoStreamHeader, objAdoStreamFile
  set objAdoStream = Server.CreateObject("ADODB.Stream")
set  objAdoStreamHeader = Server.CreateObject("ADODB.Stream")
set  objAdoStreamFile = Server.CreateObject("ADODB.Stream")
  objAdoStream.Open()
  objAdoStreamHeader.Open()
  objAdoStreamFile.Open()
  objAdoStream.Type = 1 'binary mode
  objAdoStreamHeader.Type = 1
  objAdoStreamFile.Type = 1
  objAdoStream.LoadFromFile(strPackageFilePath)
  objAdoStream.Position = intPackageHeaderOffset
  objAdoStreamHeader.Write(objAdoStream.Read())
  objAdoStream.Position = 0
  objAdoStreamHeader.Position = 0
  objAdoStreamHeader.Type = 2 'text mode
  objAdoStreamHeader.Charset = "GB2312"
 
 dim strLineText, arrayLineText
  
  while(not objAdoStreamHeader.EOS)
  
    strLineText = objAdoStreamHeader.ReadText(-2)
    arrayLineText = split(strLineText,"|")
    if(arrayLineText(0) = 0) then 'folder
    
      if(not objFileSystem.FolderExists(strDestinationPath & arrayLineText(1))) then
      
        objFileSystem.CreateFolder(strDestinationPath & arrayLineText(1))
      end if
    end if
    if(arrayLineText(0)=1) then ' file
        strlineText = strDestinationPath & arrayLineText(2)
        strLineText=left(strlineText, instrrev(strlineText,"\" )-1)
      if(not objFileSystem.FolderExists(strLineText) ) then
      
        objFileSystem.CreateFolder(strLineText)
      end if
      
      if(arrayLineText(1)>0) then
        objAdoStreamFile.Write(objAdoStream.Read(arrayLineText(1)))
        call objAdoStreamFile.SaveToFile( strDestinationPath & arrayLineText(2),2)
        objAdoStreamFile.SetEOS()
      else
        objFileSystem.CreateTextFile strDestinationPath & arrayLineText(2)
      end if
    end if
  
  wend
  objAdoStream.Close()
  objAdoStreamHeader.Close()
  objAdoStreamFile.Close()
end function
'on error resume next
call install
if err then
    Response.Write "<font color=red>安装错误: " & err.description & "</font>"
else
    Response.Write "<font color=blue>OK! 安装成功！</font>"
end if%>