创建虚拟目录

<%

'**********************************************************************************
' 创建站点功能模块库
' Author [e-mail](Jack Lee)
' WriteDate 2002.03.26
' LastModify 2002.04.02
' Version 1.00
'**********************************************************************************
'
'
'**********************************************************************************
' 检查是否存在盘和类型
' 如果不存在或是CD-ROM返回0，是返回1
'**********************************************************************************
Function CheckDrive(drive)
Dim Fso,Dname,ReturnValue
ReturnValue=0
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
If Fso.DriveExists(drive) Then
Set Dname=Fso.GetDrive(drive)
If Dname.DriveType<>4 Then 
ReturnValue=1
End If
Set Dname=nothing
End If
Set Fso=nothing
CheckDrive=ReturnValue
End Function


'**********************************************************************************
' 检测目录已用空间
' 如果目录不存在，则返回-1，
' 根据所占空间大小，分别返回以GB,MB,KB,Bytes为单位的空间数
'**********************************************************************************
Function GetTotalSize(folder)
Dim Fso,ObjFld,ftotal
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
If Fso.folderExists(folder) Then
Set ObjFld=Fso.GetFolder(folder)
ftotal=ObjFld.Size
If ftotal<1024 Then
ftotal=ftotal&"Bytes"
Else
ftotal=int(ftotal/1024)
If ftotal<1024 Then
ftotal=ftotal&"KB"
Else
ftotal=int(ftotal/1024)
If Ftotal<1024 Then
ftotal=ftotal&"MB"
Else
ftotal=int(ftotal/1024)
ftotal=ftotal&"GB"
End If
End If
End If
FolderTotalSize=ftotal
Else
FolderTotalSize=-1
End If
End Function


'**********************************************************************************
' 判断可用空间是否已满
' 参数folder为测试目录，maxsize为最大允许空间，可以带MB,GB,KB等单位
' 当目录不存在时，返回-1，当小于可用空间时，返回0，当大于或等于可用空间时，返回1
'**********************************************************************************
Function IsFull(folder,maxsize)
Dim Fso,ObjFld,ftotal,unitFlag
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
If Fso.folderExists(folder) Then
unitFlag=Right(maxsize,2)
If Not IsNumeric(unitFlag) Then
maxsize=Left(maxsize,Len(maxsize)-2)
Select Case unitFlag
Case "KB"
maxsize=maxsize*1024
Case "MB"
maxsize=maxsize*1024*1024
Case "GB"
maxsize=maxsize*1024*1024*1024
End Select
End If
Set ObjFld=Fso.GetFolder(folder)
ftotal=ObjFld.Size
Set ObjFld=nothing
Set Fso=Nothing
If ftotal>=maxsize Then
IsFull=1
Else
IsFull=0
End If
Else
Set Fso=nothing
IsFull=-1
End If
End Function


'**********************************************************************************
' 用来创建新目录
' path为要创建的目录
' 当创建成功时，返回1，当目录已存在或不成功时，返回0
'**********************************************************************************
Function CreateFolder(path)
Dim ReturnValue
ReturnValue=0
If Checkdrive(Left(path,1))=1 Then
Dim Fso
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
If Not Fso.FolderExists(path) Then
Fso.CreateFolder(path)
ReturnValue=1
End If
Set Fso=nothing
End If
CreateFolder=ReturnValue
End Function



'**********************************************************************************
' 用来删除目录
' path为要删除的目录
' 当删除成功时，返回1，当目录不存在或不成功时，返回0
'**********************************************************************************
Function DelFolder(path)
On Error Resume Next
Dim ReturnValue
ReturnValue=0
If Checkdrive(Left(path,1))=1 Then
Dim Fso
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
If Fso.FolderExists(path) Then
Fso.DeleteFolder(path)
If Err.number=0 Then
ReturnValue=1
End If
End If
Set Fso=nothing
End If
Err.Clear()
DelFolder=ReturnValue
End Function


'**********************************************************************************
' COPY首页index.htm到domain下
' 如果成功返回1，否则返回0
'**********************************************************************************
Function CopyIndexhtm(domain)
Dim Fso,FilePath,ReturnValue
ReturnValue=0
FilePath="D:/index.htm"
Set Fso=Server.CreateObject("Scripting.FileSystemObject")
If Fso.FileExists(FilePath) Then
Fso.CopyFile filepath,domain&"/"
ReturnValue=1
End If
Set Fso=nothing
CopyIndexhtm=ReturnValue
End Function



'**********************************************************************************
' 创建一个WebServer
' 必须参数：oComputer为计算机;WRoot,为创建站点的主目录；WComment为站点说明； WPort为站点端口；ServerRun为是否自动运行
' 当创建成功时返回1，否则提示出错信息并结束
'**********************************************************************************
Function CreateWebServer(oComputer,WRoot,WComment,WPort,ServerRun)
On Error Resume Next
Dim ServiceObj,ServerObj,VDirObj
Set ServiceObj = GetObject("IIS://"&oComputer&"/W3SVC")' 首先创建一个服务实例

WNumber=1
Do While IsObject(ServiceObj.GetObject("IIsWebServer",WNumber))
If Err.number<>0 Then 
Err.Clear()
Exit Do
End If
WNumber=WNumber+1
Loop

Set ServerObj = ServiceObj.Create("IIsWebServer", WNumber)' 然后创建一个WEB服务器

If (Err.Number <> 0) Then' 是否出错
'Response.Write "错误:  创建Web服务器的ADSI操作失败！"
CreateWebServer=0
Exit Function
End If
  
  ' 接着配置服务器
  ServerObj.ServerSize = 1   ' 中型大小
  ServerObj.ServerComment = WComment '说明
  ServerObj.ServerBindings = WPort '端口
  ServerObj.EnableDefaultDoc=True

  ' 提交信息
  ServerObj.SetInfo

  ' 最后，建立虚拟目录
  Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")
    
    If (Err.Number <> 0) Then' 是否出错
'Response.Write "错误:  创建虚拟目录的ADSI操作失败！"
Err.Clear()
CreateWebServer=0
Exit Function
    End If

  ' 配置虚拟目录
  VDirObj.Path = WRoot
  VDirObj.AccessRead = True
  VDirObj.AccessWrite = True
  VDirObj.EnableDirBrowsing = False
  VDirObj.EnableDefaultDoc=True
  VDirObj.AccessScript=True
  VDirObj.AppCreate2 2
  VDirObj.AppFriendlyName="默认应用程序"
  VDirObj.SetInfo

  If ServerRun = True Then
     ServerObj.Start
       If (Err.Number <> 0) Then    ' Error！
'Response.Write "错误:  起动服务器时出错！请手动启动WebServer "&WComment&"！<br>"
Err.Clear()
CreateWebServer=2
Exit Function
       End If
  End If
  Set VDirObj=Nothing
  Set ServerObj=Nothing
  Set ServiceObj=Nothing
  CreateWebServer=1
End Function


'**********************************************************************************
' 创建一个FtpServer
' 必须参数：oComputer为计算机;WRoot,为创建站点的主目录；WComment为站点说明；WPort为站点端口；ServerRun为是否自动运行
' 当创建成功时返回1，否则提示出错信息并结束
'**********************************************************************************
Function CreateFtpServer(oComputer,WRoot,WComment,WPort,ServerRun)
On Error Resume Next
Dim ServiceObj,ServerObj,VDirObj
Dim WNumber
Set ServiceObj = GetObject("IIS://"&oComputer&"/MSFTPSVC")' 首先创建一个服务实例

WNumber=1
Do While IsObject(ServiceObj.GetObject("IIsFtpServer",WNumber))
If Err.number<>0 Then 
Err.Clear()
Exit Do
End If
WNumber=WNumber+1
Loop

Set ServerObj = ServiceObj.Create("IIsFtpServer", WNumber)' 然后创建一个WEB服务器

If (Err.Number <> 0) Then' 是否出错
'Response.Write "错误:  创建Ftp服务器的ADSI操作失败！"
Err.Clear()
CreateFtpServer=0
Exit Function
End If
  
  ' 接着配置服务器
  ServerObj.ServerSize = 1   ' 中型大小
  ServerObj.ServerComment = WComment '说明
  ServerObj.ServerBindings = WPort '端口

  ' 提交信息
  ServerObj.SetInfo

  ' 最后，建立虚拟目录
  Set VDirObj = ServerObj.Create("IIsFtpVirtualDir", "ROOT")
    
    If (Err.Number <> 0) Then' 是否出错
'Response.Write "错误:  创建虚拟目录的ADSI操作失败！"
Err.Clear()
CreateFtpServer=0
Exit Function
    End If

  ' 配置虚拟目录
  VDirObj.Path = WRoot
  VDirObj.AccessRead = True
  VDirObj.AccessWrite = True
  VDirObj.SetInfo

  ' 成功了！
  If ServerRun = True Then
     ServerObj.Start
       If (Err.Number <> 0) Then    ' Error！
'Response.Write "错误:  起动服务器时出错！"
Err.Clear()
CreateFtpServer=1
Exit Function
       End If
  End If
  Set VDirObj=Nothing
  Set ServerObj=Nothing
  Set ServiceObj=Nothing
  CreateFtpServer=1
End Function


'**********************************************************************************
' 创建一个默认FtpServer的虚拟目录
' 必须参数：oComputer为计算机;VDir,为创建虚拟目录的物理路径；VDirName为虚拟目录说明
' 当创建成功时返回1，否则提示出错信息并返回0
'**********************************************************************************
Function CreateFtpVDir(oComputer,WNumber,VDir,VDirName)
On Error Resume Next
Dim ServerObj,VDirObj
Set ServerObj = GetObject("IIS://"&oComputer&"/MSFTPSVC/"&WNumber&"/ROOT")' 得到FtpServer的主目录对象

  ' 建立虚拟目录
  Set VDirObj = ServerObj.Create("IIsFtpVirtualDir", VDirName)
    
    If (Err.Number <> 0) Then' 是否出错
'Response.Write "错误:  创建Ftp虚拟目录的ADSI操作失败！<br>"
Err.Clear()
CreateFtpVDir=0
Exit Function
    End If

  ' 配置虚拟目录
  VDirObj.Path = VDir
  VDirObj.AccessRead = True
  VDirObj.AccessWrite = True
  VDirObj.SetInfo

  ' 成功了！
  Set VDirObj=Nothing
  Set ServerObj=Nothing
  CreateFtpVDir=1
End Function


'**********************************************************************************
' 创建一个WebServer的虚拟目录
' 必须参数：oComputer为计算机;VDir,为创建虚拟目录的物理路径；WNumber为站点号;VDirName为虚拟目录名
' 当创建成功时返回1，否则提示出错信息并返回0
'**********************************************************************************
Function CreateWebVDir(oComputer,VDir,WNumber,VDirName)
On Error Resume Next
Dim ServerObj,VDirObj
Set ServerObj = GetObject("IIS://"&oComputer&"/W3SVC/"&WNumber&"/ROOT")' 得到FtpServer的主目录对象

  ' 建立虚拟目录
  Set VDirObj = ServerObj.Create("IIsWebVirtualDir", VDirName)
    
    If (Err.Number <> 0) Then' 是否出错
'Response.Write "错误:  创建Web虚拟目录的ADSI操作失败！<br>"
CreateWebVDir=0
Exit Function
    End If

  ' 配置虚拟目录
  VDirObj.Path = VDir
  VDirObj.AccessRead = True
  VDirObj.AccessWrite = False
  VDirObj.EnableDefaultDoc=True
  VDirObj.AccessScript=True
  VDirObj.AppCreate2 2
  VDirObj.AppFriendlyName="默认应用程序"
  VDirObj.SetInfo

  ' 成功了！
  Set VDirObj=Nothing
  Set ServerObj=Nothing
  CreateWebVDir=1
End Function

'**********************************************************************************
'用来增加一个WinNT的用户
'必须参数：oDomain为计算机域;NTuser，要创建的用户名;pwd，用户密码
'创建成功返回1，否则返回0
'**********************************************************************************
Function AddNtUser(oDomain,NTuser, pwd) 
on Error Resume Next
Dim ReturnValue
ReturnValue=0
Set oDomain = GetObject("WinNT://"&oDomain) 
    Set oUser = oDomain.Create("user", NTuser) 
    oUser.SetPassword pwd 
oUser.SetInfo 
    If Err.Number=0 Then      
        ReturnValue=1        
Set oUser=nothing
Set oDomain=nothing
    End If 
    AddNtUser=ReturnValue
End Function 
%>