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

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

作者：nonepassby 点击：读取中... 次

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

引用代码：<%

'**********************************************************************************
' 创建站点功能模块库
' Author nonepassby@163.com(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
%>

转自:http://www.moon-soft.com/program/bbs/readelite463646.htm

收藏此文章　　　　　打印更新　　　　　编辑此文章　　　　『关闭窗口』


	家园个人文集		http://www.5x54.com