Хотите сделать каталог недоступным с vb6 - PullRequest
Новая
       17

Хотите сделать каталог недоступным с vb6

0 голосов
/ 02 декабря 2011

Я работаю над программой, которая отключит доступ к общим папкам на сервере документов, если жесткий диск приближается к заполнению.В настоящее время я просто переименовываю их во что-то другое, чтобы сервер приложений не мог отправлять больше документов.Мне интересно, есть ли способ каким-либо образом заблокировать папку программным путем, либо установив ее только для чтения, либо отключив ее общий ресурс.Из того, что я видел, изменение папки, доступной только для чтения, непосредственно в 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

Довольно просто, но я надеюсь, что смогу сделать это более тонким способом.

Ответы [ 2 ]

1 голос
/ 03 декабря 2011

погуглил и нашел что-то похожее на Daniweb, это не мой код, так что никаких гарантий.Я вставил код ниже.Предполагая, что это работает, попробуйте изменить разрешения, чтобы запретить учетные записи, используемые приложениями.Запретить разрешения переопределит разрешенные разрешения.Вы можете посмотреть на источник здесь . 

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
0 голосов
/ 11 января 2012

Для общей папки я закончил редактированием реестра, чтобы «переименовать» сам общий ресурс, а не папку. Я сделал это, прочитав данные записи реестра, удалив запись и записав данные в новую запись. Мне также пришлось перезапустить браузер компьютера и службы сервера, чтобы сервер получил новое имя общего ресурса. Это предотвращает отправку документов сервером приложений, поскольку он не может найти общий ресурс со старым именем. Мне также пришлось преобразовать значения записи безопасности из десятичного обратно в шестнадцатеричное, прежде чем записывать их в новую запись, и подождать между остановкой и перезапуском служб, чтобы убедиться, что они закончили, прежде чем перейти к следующему сервису. 

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
...