学习首页 百科 人生课堂 办公软件 英语学习 操作系统 故事会 编程资料 软件学习 设计
铭瑶网 >> 学习首页 >> 系统 >> ADSI活动目录技术之二(IIS活动目录服务)
标题：ADSI活动目录技术之二(IIS活动目录服务)

【字体： 大中小】 时间:2008-4-11 来源:互联网 作者:study

ADSI活动目录技术之二(IIS活动目录服务)

自我写了些有关ADSI活动目录技术的程序后，有很多朋友都写信问我能不能把有关IIS的功能整合起来，呵呵，昨晚弄到快四点才睡觉，终于把第一版写出来了，在机器上条件调试节8次，全都成功，现把程序代码库列出来，供大家参考，由于程序不很少，因此整个应用程序我已打包放在这里,里面有详细的使用说明和注意事项，还有一些朋友在前些日子提出的问题也在里面一并回答了。代码库我力求做到最简单，即只返回值，在里面不放动作，所有动作都在主程序中做出，对程序的维护和修改更方便。 <%  

#&39;********************************************************************************** #&39; 创建站点功能模块库 #&39; Author nonepassby@163.com(Jack Lee) #&39; WriteDate 2002.03.26 #&39; LastModify 2002.04.02 #&39; Version 1.00 #&39;********************************************************************************** #&39; #&39; #&39;********************************************************************************** #&39; 检查是否存在盘和类型 #&39; 如果不存在或是CD-ROM返回0，是返回1 #&39;********************************************************************************** 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 
#&39;********************************************************************************** #&39; 检测目录已用空间 #&39; 如果目录不存在，则返回-1， #&39; 根据所占空间大小，分别返回以GB,MB,KB,Bytes为单位的空间数 #&39;********************************************************************************** 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 
#&39;********************************************************************************** #&39; 判断可用空间是否已满 #&39; 参数folder为测试目录，maxsize为最大允许空间，可以带MB,GB,KB等单位 #&39; 当目录不存在时，返回-1，当小于可用空间时，返回0，当大于或等于可用空间时，返回1 #&39;********************************************************************************** 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 
#&39;********************************************************************************** #&39; 用来创建新目录 #&39; path为要创建的目录 #&39; 当创建成功时，返回1，当目录已存在或不成功时，返回0 #&39;********************************************************************************** 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 

#&39;********************************************************************************** #&39; 用来删除目录 #&39; path为要删除的目录 #&39; 当删除成功时，返回1，当目录不存在或不成功时，返回0 #&39;********************************************************************************** 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 
#&39;********************************************************************************** #&39; COPY首页index.htm到domain下 #&39; 如果成功返回1，否则返回0 #&39;********************************************************************************** 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 

#&39;********************************************************************************** #&39; 创建一个WebServer #&39; 必须参数：oComputer为计算机;WRoot,为创建站点的主目录；WComment为站点说明； WPort为站点端口；ServerRun为是否自动运行 #&39; 当创建成功时返回1，否则提示出错信息并结束 #&39;********************************************************************************** Function CreateWebServer(oComputer,WRoot,WComment,WPort,ServerRun) On Error Resume Next Dim ServiceObj,ServerObj,VDirObj Set ServiceObj = GetObject("IIS://"&oComputer&"/W3SVC")#&39; 首先创建一个服务实例 
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)#&39; 然后创建一个WEB服务器 
If (Err.Number <> 0) Then#&39; 是否出错 #&39;Response.Write "错误:  创建Web服务器的ADSI操作失败！" CreateWebServer=0 Exit Function End If      #&39; 接着配置服务器   ServerObj.ServerSize = 1   #&39; 中型大小   ServerObj.ServerComment = WComment #&39;说明   ServerObj.ServerBindings = WPort #&39;端口   ServerObj.EnableDefaultDoc=True 
  #&39; 提交信息   ServerObj.SetInfo 
  #&39; 最后，建立虚拟目录   Set VDirObj = ServerObj.Create("IIsWebVirtualDir", "ROOT")          If (Err.Number <> 0) Then#&39; 是否出错 #&39;Response.Write "错误:  创建虚拟目录的ADSI操作失败！" Err.Clear() CreateWebServer=0 Exit Function     End If 
  #&39; 配置虚拟目录   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    #&39; Error！ #&39;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 
#&39;********************************************************************************** #&39; 创建一个FtpServer #&39; 必须参数：oComputer为计算机;WRoot,为创建站点的主目录；WComment为站点说明；WPort为站点端口；ServerRun为是否自动运行 #&39; 当创建成功时返回1，否则提示出错信息并结束 #&39;********************************************************************************** Function CreateFtpServer(oComputer,WRoot,WComment,WPort,ServerRun) On Error Resume Next Dim ServiceObj,ServerObj,VDirObj Dim WNumber Set ServiceObj = GetObject("IIS://"&oComputer&"/MSFTPSVC")#&39; 首先创建一个服务实例 
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)#&39; 然后创建一个WEB服务器 
If (Err.Number <> 0) Then#&39; 是否出错 #&39;Response.Write "错误:  创建Ftp服务器的ADSI操作失败！" Err.Clear() CreateFtpServer=0 Exit Function End If      #&39; 接着配置服务器   ServerObj.ServerSize = 1   #&39; 中型大小   ServerObj.ServerComment = WComment #&39;说明   ServerObj.ServerBindings = WPort #&39;端口 
  #&39; 提交信息   ServerObj.SetInfo 
  #&39; 最后，建立虚拟目录   Set VDirObj = ServerObj.Create("IIsFtpVirtualDir", "ROOT")          If (Err.Number <> 0) Then#&39; 是否出错 #&39;Response.Write "错误:  创建虚拟目录的ADSI操作失败！" Err.Clear() CreateFtpServer=0 Exit Function     End If 
  #&39; 配置虚拟目录   VDirObj.Path = WRoot   VDirObj.AccessRead = True   VDirObj.AccessWrite = True   VDirObj.SetInfo 
  #&39; 成功了！   If ServerRun = True Then      ServerObj.Start        If (Err.Number <> 0) Then    #&39; Error！ #&39;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 
#&39;********************************************************************************** #&39; 创建一个默认FtpServer的虚拟目录 #&39; 必须参数：oComputer为计算机;VDir,为创建虚拟目录的物理路径；VDirName为虚拟目录说明 #&39; 当创建成功时返回1，否则提示出错信息并返回0 #&39;********************************************************************************** Function CreateFtpVDir(oComputer,WNumber,VDir,VDirName) On Error Resume Next Dim ServerObj,VDirObj Set ServerObj = GetObject("IIS://"&oComputer&"/MSFTPSVC/"&WNumber&"/ROOT")#&39; 得到FtpServer的主目录对象 
  #&39; 建立虚拟目录   Set VDirObj = ServerObj.Create("IIsFtpVirtualDir", VDirName)          If (Err.Number <> 0) Then#&39; 是否出错 #&39;Response.Write "错误:  创建Ftp虚拟目录的ADSI操作失败！<br>" Err.Clear() CreateFtpVDir=0 Exit Function     End If 
  #&39; 配置虚拟目录   VDirObj.Path = VDir   VDirObj.AccessRead = True   VDirObj.AccessWrite = True   VDirObj.SetInfo 
  #&39; 成功了！   Set VDirObj=Nothing   Set ServerObj=Nothing   CreateFtpVDir=1 End Function 
#&39;********************************************************************************** #&39; 创建一个WebServer的虚拟目录 #&39; 必须参数：oComputer为计算机;VDir,为创建虚拟目录的物理路径；WNumber为站点号;VDirName为虚拟目录名 #&39; 当创建成功时返回1，否则提示出错信息并返回0 #&39;********************************************************************************** Function CreateWebVDir(oComputer,VDir,WNumber,VDirName) On Error Resume Next Dim ServerObj,VDirObj Set ServerObj = GetObject("IIS://"&oComputer&"/W3SVC/"&WNumber&"/ROOT")#&39; 得到FtpServer的主目录对象 
  #&39; 建立虚拟目录   Set VDirObj = ServerObj.Create("IIsWebVirtualDir", VDirName)          If (Err.Number <> 0) Then#&39; 是否出错 #&39;Response.Write "错误:  创建Web虚拟目录的ADSI操作失败！<br>" CreateWebVDir=0 Exit Function     End If 
  #&39; 配置虚拟目录   VDirObj.Path = VDir   VDirObj.AccessRead = True   VDirObj.AccessWrite = False   VDirObj.EnableDefaultDoc=True   VDirObj.AccessScript=True   VDirObj.AppCreate2 2   VDirObj.AppFriendlyName="默认应用程序"   VDirObj.SetInfo 
  #&39; 成功了！   Set VDirObj=Nothing   Set ServerObj=Nothing   CreateWebVDir=1 End Function 
#&39;********************************************************************************** #&39;用来增加一个WinNT的用户 #&39;必须参数：oDomain为计算机域;NTuser，要创建的用户名;pwd，用户密码 #&39;创建成功返回1，否则返回0 #&39;********************************************************************************** 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  %> 

查看/参与:讨论/评论 相关文章：服务器