0

サルヴェテ！
私のサーバーでは 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
4

1 に答える 1

0

方法を考え出した！まず、送信先が machine2 の適切なユーザー アカウントに共有されていることを確認しました。次に、machine1 でスクリプトを作成して、ネットワーク ドライブをマップし、ファイルをコピーします。これは、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
于 2012-11-08T21:35:43.463 に答える