0

Salvete!
On my server I am running hMailServer, and that service uses the local system account.

I need to copy a file to another machine. So I have this a script that will use cmdkey.exe to save the credentials and then copy the file.

If I run this function myself (in a standalone vbs file) whilst logged into the server, it works, but I am admin. However, if I let the hMailServer service run this function, the function runs, but it always says the destination does not exist.

Notice I have commented out the deletion of the credentials. If I go to the server and run cmdkey /list I see that the credentials were never set, which means the command failed. That means the first setting of the credentials probably failed too, which is why 'objFSO' cannot find the directory.

Again, if I put all this in a separate file and run it as test.vbs by double-clicking the file, it works. But if I use it from within hMailServer, it fails.

I suppose this means the hMailServer (local system account) doesn't have rights to set credentials? How do I get this to work?

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
bgmCoder
  • 6,205
  • 8
  • 58
  • 105
  • Perhaps surprisingly the *LOCAL SYSTEM* account is restricted to the *LOCAL SYSTEM*. – Ansgar Wiechers Nov 08 '12 at 18:22
  • I don't admit any *surprise* about that, but how do I solve the problem? I need the service to run even if nobody is logged in, which is why it runs as the system account in the first place. What *CAN* I do? – bgmCoder Nov 08 '12 at 19:55

1 Answers1

0

Figured out a way! First, I made sure the destination was shared to the right user account on machine2. Then made the script on machine1 to map the network drive and then copy the file. This will work as long as the N drive is never used for anything else on that machine.

Here is the code is if be helpful to anyone!

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
bgmCoder
  • 6,205
  • 8
  • 58
  • 105