Как запустить команду для установки учетных данных из сценария vbs с использованием системной учетной записи?

Спасите!
На моем сервере запущен hMailServer, и эта служба использует учетную запись локальной системы.

Мне нужно скопировать файл на другую машину. Итак, у меня есть сценарий, который будет использовать cmdkey.exe для сохранения учетных данных, а затем скопировать файл.

Если я сам запускаю эту функцию (в отдельном файле vbs) при входе на сервер, она работает, но я являюсь администратором. Однако, если я позволю службе hMailServer запустить эту функцию, функция запустится, но всегда говорит, что пункт назначения не существует.

Обратите внимание, что я закомментировал удаление учетных данных. Если я зайду на сервер и запущу cmdkey /list, я увижу, что учетные данные никогда не устанавливались, что означает, что команда не удалась. Это означает, что первая установка учетных данных, вероятно, также не удалась, поэтому «objFSO» не может найти каталог.

Опять же, если все это поместить в отдельный файл и запустить как test.vbs двойным кликом по файлу, то работает. Но если я использую его из hMailServer, он не работает.

Я полагаю, это означает, что hMailServer (учетная запись локальной системы) не имеет прав для установки учетных данных? Как заставить это работать?

option explicit

dim SPcopyMessage
SPcopyMessage = CopyFileToRemoteMachine("SERVER", "mydomain\username", "password", "c:\test2.txt", "\\SERVER\somefolder\otherfolder")
MsgBox SPcopyMessage


function CopyFileToRemoteMachine(whatMachine, whatUsername, whatPassword, whatSourceFile, whatDestination)
    dim errormessage, CredentialCreate, CredentialDelete
    errormessage    = "Sharepoint Mail Delivered"
    CredentialCreate = "cmd.exe /c cmdkey /add:" & whatMachine & " /user:" & whatUsername & " /pass:" & whatPassword

    Dim objShell, objFSO
    Set objShell = CreateObject("WScript.Shell")
    Set objFSO = CreateObject("Scripting.FileSystemObject")

    CALL objShell.Run(CredentialCreate, 0, True)        'add username to the credentials list

    If objFSO.FileExists(whatSourceFile) Then
          If objFSO.FolderExists(whatDestination) Then
            If Right(whatDestination, 1) <> "\" Then
                  whatDestination = whatDestination & "\"
            End If        
            objFSO.CopyFile whatSourceFile, whatDestination, True
          Else
                errormessage = "Destination does not exist: " & whatDestination
          End If
    Else
          errormessage = "Source file does not exist: " & whatSourceFile
    End If

    'CredentialDelete = "cmd.exe /c cmdkey /delete:" & whatMachine
    'CALL objShell.Run(CredentialDelete, 0, True)

    set objFSO = nothing
    set objShell = nothing

    CopyFileToRemoteMachine = errormessage
end function

vbscript hmail-server
person bgmCoder    schedule 08.11.2012    source источник
comment
Удивительно, но учетная запись LOCAL SYSTEM ограничена LOCAL SYSTEM.   -  person Ansgar Wiechers    schedule 08.11.2012
comment
Я не признаю никакого удивления по этому поводу, но как мне решить проблему? Мне нужно, чтобы служба работала, даже если никто не вошел в систему, поэтому в первую очередь она работает как системная учетная запись. Что я МОГУ сделать?   -  person bgmCoder    schedule 08.11.2012

Ответы (1)


arrow_upward
0
arrow_downward

Придумал способ! Во-первых, я убедился, что место назначения было предоставлено нужной учетной записи пользователя на машине2. Затем сделал скрипт на машине1, чтобы подключить сетевой диск, а затем скопировать файл. Это будет работать до тех пор, пока диск N никогда не используется для чего-либо еще на этой машине.

Вот код, если кому пригодится!

function CopyFileToRemoteMachine(whatMachine, whatUsername, whatPassword, whatSourceFile, whatDestination)
    dim errormessage, mdrive
    errormessage    = "File successfully copied"

    mdrive = "N:"

    Dim objFSO, objNetwork
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objNetwork = CreateObject("Wscript.Network")

    If not objFSO.FileExists(mdrive)  Then
        objNetwork.MapNetworkDrive mdrive, whatDestination, False, whatUsername, whatPassword
    End If

    If Right(whatDestination, 1) <> "\" Then
          whatDestination = whatDestination & "\"
    End If  
    If objFSO.FileExists(whatSourceFile) Then
          If objFSO.FolderExists(whatDestination) Then  
            objFSO.CopyFile whatSourceFile, whatDestination, True
          Else
                errormessage = "Destination does not exist: " & whatDestination
          End If
    Else
          errormessage = "Source file does not exist: " & whatSourceFile
    End If

    objNetwork.RemoveNetworkDrive mdrive,TRUE,TRUE

    set objFSO = nothing
    set objNetwork = nothing

    CopyFileToRemoteMachine = errormessage
end function
person bgmCoder    schedule 08.11.2012