Question

我正在开发一个程序，如果硬盘驱动器接近满，将禁止访问文档服务器上的共享文件夹。目前，我只是将它们重命名为不同的东西，以防止应用服务器能够发送更多文档。我想知道是否有办法以某种方式以编程方式锁定文件夹，将其设置为只读，或禁用其共享状态。从我所看到的，直接在Windows中将文件夹更改为只读不会阻止将新文件复制到其中。任何人对如何做到这一点都有任何想法？我目前的代码如下：

Private Function MoveShares(ByVal strOldLocation As String, ByVal strNewLocation As String) As Boolean

    Dim objFSO As New FileSystemObject
    If objFSO.FolderExists(strOldLocation) Then
        LogAction "Moving " & strOldLocation & " to " & strNewLocation
        objFSO.MoveFolder strOldLocation, strNewLocation
    End If
    Set objFSO = Nothing

End Function

非常基本，但我希望我能以更微妙的方式做到这一点。

Answer 1

用谷歌搜索并在Daniweb上找到类似的东西，这不是我的代码所以没有保证。我粘贴了下面的代码。假设这有效，请尝试修改权限以拒绝应用程序使用的帐户。拒绝权限将覆盖允许的权限。您可以查看来源here。

Dim strHomeFolder, strHome, strUser
Dim intRunError, objShell, objFSO
strHomeFolder = "C:\Test"
strUser="srikanth"

Set objShell = CreateObject("Wscript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")
If objFSO.FolderExists(strHomeFolder) Then
    intRunError = objShell.Run("%COMSPEC% /c Echo Y| cacls " & strHomeFolder & " /t /c /g everyone:F ", 2, True)
    wscript.echo "The File " & strHomeFolder & ". Permissions changed to Every One."
    If intRunError <> 0 Then
        Wscript.Echo "Error assigning permissions for user " & strUser & " to home folder " & strHomeFolder
    End If
End If

Answer 2

对于共享文件夹，我最终编辑注册表以“重命名”共享本身，而不是文件夹。我这样做是通过读取注册表项数据，删除条目，并将数据写入新条目。我还必须重新启动计算机浏览器和服务器服务，以便服务器获取新的共享名称。这会阻止应用服务器发送文档，因为它无法找到具有旧名称的共享。我还必须将安全性条目值从十进制转换回十六进制，然后再将它们写入新条目，并在停止和重新启动服务之间等待，以确保它们在转移到下一个服务之前已完成。

Private Function RenameShare(ByVal strOldName As String, ByVal strNewName As String) As Boolean

Dim objRegAccess As Object
Dim varValues() As Variant
Dim varItem As Variant
Dim strSharePath As String
Dim strSecurityPath As String
Dim strValues As String
Dim strCmd As String

Set objRegAccess = CreateObject("Wscript.Shell")
strSharePath = "HKLM\SYSTEM\CurrentControlSet\services\LanmanServer\Shares\"
strSecurityPath = strSharePath & "Security\"
strValues = ""
varValues = objRegAccess.RegRead(strSharePath & strOldName)
strValues = ""
For Each varItem In varValues
    strValues = strValues & varItem & "~"
Next
RunCommand "REG ADD " & strSharePath & " /v " & strNewName & " /t REG_MULTI_SZ /s ~ /d " & strValues & " /f", False
RunCommand "REG DELETE " & strSharePath & " /v " & strOldName & " /f", False
strValues = ""
varValues = objRegAccess.RegRead(strSecurityPath & strOldName)
For Each varItem In varValues
    strValues = strValues & varItem & "~"
Next
strValues = ConvertDecToHex(strValues)
RunCommand "REG ADD " & strSecurityPath & " /v " & strNewName & " /t REG_BINARY /d " & strValues & " /f", False
RunCommand "REG DELETE " & strSecurityPath & " /v " & strOldName & " /f", False
RunCommand "NET STOP ""Computer Browser"" ", True
RunCommand "NET STOP ""Server"" ", True
RunCommand "NET START ""Server"" ", True
RunCommand "NET START ""Computer Browser"" ", False

End Function

想要使用vb6无法访问目录

2 个答案: