I have a similar problem and I got tired of fighting with it. Most of these cameras also will send a screen shot to an ftp server so I wrote a vbscript that polls the server and then sends an email using my workplace smtp server. Obviously, you need an external ftp and smtp server that will accept your requests, and I run the script on my workstation at work. I am a beginner at script writing and I am sure that a real programmer could come up with a more elegant solution, but I was able to get the script to work well enough so that I feel more secure leaving my house unoccupied. I loop the script once a minute and send the email to my work address that is automatically forwarded to my blackberry with the first and last images as attachments. The ftpdownload function that I found online is unchanged. The script runs until it finds a specially named text file in the working folder. (I have a separate script to create that file sitting on my desktop.) All images are saved to an archive folder for later review if necessary.
Function FTPDownload(sSite, sUsername, sPassword, sLocalPath, sRemotePath, _
sRemoteFile)
'This script is provided under the Creative Commons license located
'at http://creativecommons.org/licenses/by-nc/2.5/ . It may not
'be used for commercial purposes with out the expressed written consent
'of NateRice.com
Const OpenAsDefault = -2
Const FailIfNotExist = 0
Const ForReading = 1
Const ForWriting = 2
Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
Set oFTPScriptShell = CreateObject("WScript.Shell")
sRemotePath = Trim(sRemotePath)
sLocalPath = Trim(sLocalPath)
'----------Path Checks---------
'Here we will check the remote path, if it contains
'spaces then we need to add quotes to ensure
'it parses correctly.
If InStr(sRemotePath, " ") > 0 Then
If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
sRemotePath = """" & sRemotePath & """"
End If
End If
'Check to ensure that a remote path was
'passed. If it's blank then pass a "\"
If Len(sRemotePath) = 0 Then
'Please note that no premptive checking of the
'remote path is done. If it does not exist for some
'reason. Unexpected results may occur.
sRemotePath = "\"
End If
'If the local path was blank. Pass the current
'working direcory.
If Len(sLocalPath) = 0 Then
sLocalpath = oFTPScriptShell.CurrentDirectory
End If
If Not oFTPScriptFSO.FolderExists(sLocalPath) Then
'destination not found
FTPDownload = "Error: Local Folder Not Found."
Exit Function
End If
sOriginalWorkingDirectory = oFTPScriptShell.CurrentDirectory
oFTPScriptShell.CurrentDirectory = sLocalPath
'--------END Path Checks---------
'build input file for ftp command
sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
sFTPScript = sFTPScript & sPassword & vbCRLF
sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
sFTPScript = sFTPScript & "binary" & vbCRLF
sFTPScript = sFTPScript & "prompt n" & vbCRLF
sFTPScript = sFTPScript & "mget " & sRemoteFile & vbCrLf
sFTPScript = sFTPScript & "mdel " & sRemoteFile & vbCrLf
'sFTPScript = sFTPScript & "ls" & vbCrLf
sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF
sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
'Write the input file for the ftp command
'to a temporary file.
Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
fFTPScript.WriteLine(sFTPScript)
fFTPScript.Close
Set fFTPScript = Nothing
oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
" > " & sFTPResults, 0, TRUE
Wscript.Sleep 1000
'Check results of transfer.
Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
FailIfNotExist, OpenAsDefault)
sResults = fFTPResults.ReadAll
'WScript.Echo(sResults)
fFTPResults.Close
oFTPScriptFSO.DeleteFile(sFTPTempFile)
oFTPScriptFSO.DeleteFile (sFTPResults)
If InStr(sResults, "226 Transfer complete.") > 0 Then
FTPDownload = True
ElseIf InStr(sResults, "File not found") > 0 Then
FTPDownload = "Error: File Not Found"
ElseIf InStr(sResults, "cannot log in.") > 0 Then
FTPDownload = "Error: Login Failed."
Else
FTPDownload = "Error: Unknown."
End If
Set oFTPScriptFSO = Nothing
Set oFTPScriptShell = Nothing
End Function
'Set up array
Dim fileAttach()
'On Error Resume next
'Check date and see if [download](/wiki/#download) folder exists
strdate = date
strdate = Split(strdate,"/")
strFolderName = strdate(2) + strdate(0) + strdate(1)
strFTPFolder = "/camera/snapshot/"
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Create archive folder and reset working folder
If Not objFSO.FolderExists("C:\SecurityCam") Then
objFSO.CreateFolder("C:\SecurityCam")
End If
If Not objFSO.FolderExists("C:\SecurityCam\Archive") Then
objFSO.CreateFolder("C:\SecurityCam\Archive")
End If
If Not objFSO.FolderExists("C:\SecurityCam\WorkingFolder") Then
objFSO.CreateFolder("C:\SecurityCam\WorkingFolder")
Else 'delete any subfolder
objFSO.DeleteFolder("C:\SecurityCam\WorkingFolder")
objFSO.CreateFolder("C:\SecurityCam\WorkingFolder")
End If
strArchiveFolder = "C:\SecurityCam\Archive\" + strFolderName
If Not objFSO.FolderExists(strArchiveFolder) Then
objFSO.CreateFolder(strArchiveFolder)
End If
loops = 0
Do While True
'Check for stop request
Set objFExists = CreateObject("Scripting.FileSystemObject")
If objFExists.FileExists("C:\SecurityCam\WorkingFolder\Stop FTP Monitor.txt") Then
'WScript.Echo(" Script Ended. Loops= " & loops)
WScript.Quit
End if
'Move files from working folder if it exists
strWorkingFolder = "C:\SecurityCam\WorkingFolder\" + strFolderName
If objFSO.FolderExists(strWorkingFolder) Then
Set objFolder = objFSO.GetFolder(strWorkingFolder)
Set filecoll = objFolder.Files
If filecoll.Count > 0 Then
objFSO.CopyFile strWorkingFolder + "\*.*", strArchiveFolder, True
objFSO.DeleteFile strWorkingFolder + "\*.*", True
End if
Else
Set objFolder = objFSO.CreateFolder(strWorkingFolder)
End if
Call FTPDownload("yourftpsite.com", "ftpusername", "password", strWorkingFolder, strFTPFolder + strFolderName,"*.*")
Set filecoll = objFolder.Files
If filecoll.Count > 0 then
ReDim fileAttach(filecoll.Count - 1)
Set objShell = CreateObject ("Shell.Application")
Set objFolder = objShell.Namespace ("C:\SecurityCam\WorkingFolder\" + strFolderName)
x = 0
For Each strFileName in objFolder.Items
fileAttach(x) = objFolder.GetDetailsOf(strFileName, FILE_NAME)
x = x + 1
Next
strMailBody = "Living Room [Camera](/wiki/#camera) has had a motion detect event!"
strFileAttach = strWorkingFolder + "\" + fileAttach(0)
Set myMail=CreateObject("CDO.Message")
myMail.Subject="Camera Event"
myMail.From="[joeblogs](/wiki/#blog)@anywhere.com"
myMail.To="joesecurity@sillywalks.com"
myMail.TextBody= strMailBody
myMail.AddAttachment strFileAttach
If x > 1 then
strFileAttach = strWorkingFolder + "\" + fileAttach(x - 1)
myMail.AddAttachment strFileAttach
End if
myMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing")=2
myMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver")="smtpserveraddress"
myMail.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport")=25
myMail.Configuration.Fields.Update
myMail.Send
set myMail=nothing
End if
loops = loops + 1
WScript.sleep(60000)
loopmark
💬 Thanks Mark, I hope someone finds that helpful
Paul Clarke's weblog - I live in A small town. Married + father to 2, I am a full-stack web engineer, and I do mostly javascript / Node, some ruby, python, php etc. I like pubs, parkrun, eating, home automation and other diy jiggery-pokery, history, family tree stuff, TV, squirrels, pirates, lego, + TIME TRAVEL.