Mar 20

SyncToy21.vbs

'=========================================================================
' SyncToy21.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 3/20/20114
' REQUIREMENTS: You must install SyncToy on the Workstation and manually run it to click on
' the agreement statement, otherwise this script will lock up and NEVER back up!!!
'=========================================================================
Option Explicit

' ------ SCRIPT CONFIGURATION ------
Const strContact = "backup@domain.com"
Dim syncToyExe: syncToyExe = ExpandEnv("%PROGRAMFILES%\SyncToy 2.1\SyncToy.exe")
Dim syncToyExeX86: syncToyExeX86 = ExpandEnv("%PROGRAMFILES(X86)%\SyncToy 2.1\SyncToy.exe")
Dim syncToyCmdExe: syncToyCmdExe = ExpandEnv("%PROGRAMFILES%\SyncToy 2.1\SyncToyCmd.exe")
Dim syncToyCmdExeX86: syncToyCmdExeX86 = ExpandEnv("%PROGRAMFILES(X86)%\SyncToy 2.1\SyncToyCmd.exe")
Dim blnAutoRun: blnAutoRun = True
Dim syncOperation: syncOperation = "echo"
Dim strBackupPath: strBackupPath = ExpandEnv("\\server\backups\%USERNAME%\")
Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
' ------ END CONFIGURATION ------

Call Main()

Private Sub Main()

    ' Create Objects
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

    ' Set Folders for Backups
    Dim strDocuments: strDocuments = objShell.SpecialFolders("MyDocuments")
    Dim strMusic: strMusic = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Music")
    Dim strPictures: strPictures = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Pictures")
    Dim strVideos: strVideos = objShell.RegRead("HKCU\Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\My Video")

    ' Ensure Backup Path Ends with Slash
    If Right(strBackupPath,1) <> "\" Then
        strBackupPath = strBackupPath & "\"
    End If

    ' Validate Folders for Backup
    Dim strResult: strResult = ""
    If Not objFSO.FolderExists(strDocuments) Then
        strResult = strResult & "- Missing Documents Folder" & vbCrLf
    End If
    If Not objFSO.FolderExists(strMusic) Then
        strResult = strResult & "- Missing Music Folder" & vbCrLf
    End If
    If Not objFSO.FolderExists(strPictures) Then
        strResult = strResult & "- Missing Pictures Folder" & vbCrLf
    End If
    If Not objFSO.FolderExists(strBackupPath) Then
        strResult = strResult & "- Missing Backup Folder" & vbCrLf
    End If

    ' Validate SyncToy Path
    If Not objFSO.FileExists(syncToyExe) Then
        If Not objFSO.FileExists(syncToyExeX86) Then
            strResult = strResult & "- Missing SyncToy.exe" & vbCrLf
        Else
            syncToyExe = syncToyExeX86
        End If
    End If
    If Not objFSO.FileExists(syncToyCmdExe) Then
        If Not objFSO.FileExists(syncToyCmdExeX86) Then
            strResult = strResult & "- Missing SyncToyCmd.exe" & vbCrLf
        Else
            syncToyCmdExe = syncToyCmdExeX86
        End If
    End If

    ' Ensure Everything Validated
    If strResult <> "" Then
        objShell.Popup "An ERROR occurred backing up your files" & vbCrLf & _
            strResult & vbCrLf & _
            "Please contact " & strContact _
            , 30, "ERROR Backing Up Documents!", vbOkOnly + vbCritical
        Wscript.Quit
    End If

    ' Determine Which Folders To Backup and Prompt to Backup
    Dim intAnswer
    Dim blnDocuments: blnDocuments = True
    Dim blnMusic: blnMusic = False
    Dim blnPictures: blnPictures = False
    Dim blnVideos: blnVideos = False
    If InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strPictures,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
    Elseif InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strPictures,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    Elseif InStr(1,strMusic,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
    Elseif InStr(1,strPictures,strDocuments,1) > 0 AND InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
    Elseif InStr(1,strMusic,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
         Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    Elseif InStr(1,strPictures,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
        ' Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    Elseif InStr(1,strVideos,strDocuments,1) > 0 Then
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
    Else
        ' Backup Documents
        intAnswer = objShell.Popup("Do you want to Backup your documents now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnDocuments = False
        End If
        ' Backup Music
        intAnswer = objShell.Popup("Do you want to Backup your music now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnMusic = False
        End If
        ' Backup Pictures
        intAnswer = objShell.Popup("Do you want to Backup your pictures now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnPictures = False
        End If
        ' Backup Videos
        intAnswer = objShell.Popup("Do you want to Backup your videos now? This may take several minutes...", 30, "Backup Files?", vbYesNo + vbQuestion)
        If intAnswer = vbNo Then
            blnVideos = False
        End If
    End If

    'Validate Backup Folder Exists Or Try to Create Them
    strResult = ""
    If blnDocuments = True Then
        If ValidateFolder(strBackupPath & "Documents") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Documents" & vbCrLf
        End If
    End If
    If blnMusic = True Then
        If ValidateFolder(strBackupPath & "Music") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Music" & vbCrLf
        End If 
    End If
    If blnPictures = True Then
        If ValidateFolder(strBackupPath & "Pictures") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Pictures" & vbCrLf
        End If
    End If
    If blnVideos = True Then
        If ValidateFolder(strBackupPath & "Videos") = False Then
            strResult = strResult & "- Missing " & strBackupPath & "Videos" & vbCrLf
        End If
    End If

    ' Ensure Everything Validated
    If strResult <> "" Then
        objShell.Popup "An ERROR occurred backing up your files" & vbCrLf & _
            strResult & vbCrLf & _
            "Please contact " & strContact _
            , 30, "ERROR Backing Up Documents!", vbOkOnly + vbCritical
        Wscript.Quit
    End If

    ' Create Folder Pairs
    Call CreateSyncToyPairs(blnDocuments, strDocuments, blnMusic, strMusic, blnPictures, strPictures, blnVideos, strVideos)

    ' Run SyncToy Backup
    If blnDocuments = True Then
        Call RunSyncToy("Documents")
    End If
    If blnMusic = True Then
        Call RunSyncToy("Music")
    End If
    If blnPictures = True Then
        Call RunSyncToy("Pictures")
    End If
    If blnVideos = True Then
        Call RunSyncToy("Videos")
    End If

    ' Cleanup
    Set objFSO = Nothing
    Set objShell = Nothing

End Sub

Private Function ValidateFolder(ByVal strFolder)

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim blnResult: blnResult = True
    On Error Resume Next
    If Not objFSO.FolderExists(strFolder) Then
        objFSO.CreateFolder(strFolder)
    End If
    If Err.Number <> 0 Then
        Err.Clear
        blnResult = False
    End If
    On Error Goto 0

    ValidateFolder = blnResult

End Function

Private Sub CreateSyncToyPairs(ByVal bDoc, ByVal sDoc, ByVal bMus, ByVal sMus, ByVal bPic, ByVal sPic, ByVal bVid, ByVal sVid)

    ' Create Objects
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

    ' Attempt to Delete Folder Pairs
    Call DeleteSyncToyPair(sDoc,"Documents")
    Call DeleteSyncToyPair(sMus,"Music")
    Call deleteSyncToyPair(sPic,"Pictures")
    Call deleteSyncToyPair(sVid,"Videos")

    ' Create Folder Pairs
    If bDoc = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sDoc & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Documents" & chr(34) & _
        ",name=Documents" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true  
    End If
    If bMus = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sMus & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Music" & chr(34) & _
        ",name=Music" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true
    End If
    If bPic = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sPic & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Pictures" & chr(34) & _
        ",name=Pictures" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true
    End If
    If bVid = True Then
        objShell.Run chr(34) & syncToyExe & Chr(34) & _
        " -d(left=" & chr(34) & sVid & chr(34) & _
        ",right=" & chr(34) & strBackupPath & "Videos" & chr(34) & _
        ",name=Videos" & _
        ",operation=" & syncOperation & _
        ",excluded=*.jpg;*.jpeg;*.gif;*.bmp;*.png;*.mp3;*.m4a;*.mid;*.mpg;*.mpeg;*.divx;*.mov" & ")", 0, true
    End If

    Set objShell = Nothing

End Sub

Private Sub DeleteSyncToyPair(ByVal strPath, ByVal strPair)

    ' Detect if a Config File Exists in the leftFolder and try to Delete Folder Pair
    ' This will ensure all Left Folder Files Write to the Right Folder and Will Skip
    ' Duplicates.  Otherwise Files on the left will not write to the right if they are
    ' deleted from the right
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )
    Dim colFiles: Set colFiles = objFSO.GetFolder(strPath).Files
    Dim File, strErr
    For Each File in colFiles
        If InStr(1,File.Name,"SyncToy",1) > 0 AND StrComp(objFSO.GetExtensionName(File.Name),"dat",1) = 0 Then
            'SyncToy File Exists, Try to Delete Pair
            Call KillProcess("SyncToy.exe") 'Terminate SyncToy Processes Else a Delete Fails
            Call KillProcess("SyncToyCmd.exe")
            strErr = objShell.Run(chr(34) & syncToyExe & Chr(34) & " -u" & strPair, 0, false)
            'Cheap hack if it errors because the pair doesnt exist to kill the window
            Wscript.Sleep 10000
            Call KillProcess("SyncToy.exe")
            Call KillProcess("SyncToyCmd.exe")
        End If
    Next

    Set objFSO = Nothing
    Set objShell = Nothing

End Sub

Private Sub RunSyncToy(ByVal folderPair)

    ' Create Objects
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )

    ' Run SyncToy as Manual or Automated
    If blnAutoRun = False Then
        objShell.Run chr(34) & syncToyExe & chr(34)
    Else
        ' Set Path to SyncToyLog and Clear Log
        Dim syncToyLog: syncToyLog = ExpandEnv("%LOCALAPPDATA%\Microsoft\SyncToy\2.0\SyncToyLog.log")
        If InStr(1,syncToyLog,"%",1) > 0 Then
            syncToyLog = ExpandEnv("%USERPROFILE%\Local Settings\Application Data\Microsoft\SyncToy\2.0\SyncToyLog.log")
        End If
        If InStr(1,syncToyLog,"%",1) > 0 Then
            syncToyLog = "!~ERROR~!"
        End If
        If objFSO.FileExists(syncToyLog) Then
            Call Logger(syncToyLog, "", True)
        End If 

        ' Run Automated SyncToy Backup
        objShell.Run chr(34) & syncToyCmdExe & Chr(34) & " -R " & chr(34) & folderPair & chr(34), 1, true

        ' Parse SyncToyLog to Ensure It Successfully Ran
        Dim strError: strError = ""
        If objFSO.FileExists(syncToyLog) Then
            strError = ParseSyncToyLog(syncToyLog)
            If strError <> "" Then
                ' Error Detected in Sync
                objShell.Popup "An ERROR occurred backing up folder pair: " & folderPair & vbCrLf & _
                strError & vbCrLf & _
                "Please contact " & strContact _
                , 30, "ERROR Backing Up Files!", vbOkOnly + vbCritical
            End If
        Else
            ' Error Getting Log to Parse
            objShell.Popup "An ERROR occurred obtaining log file to check for errors after backing up folder pair: " & folderPair & vbCrLf & _
            "Please contact " & strContact _
            , 30, "ERROR Backing Up Files!", vbOkOnly + vbCritical
        End If

        'Copy SyncToy Log to Backup Path
        If objFSO.FIleExists(syncToyLog) Then
            objFSO.CopyFile syncToyLog, strBackupPath, True
        End If
    End If

    ' Cleanup
    Set objFSO = Nothing
    Set objShell = Nothing

End Sub

Private Function ParseSyncToyLog(ByVal strLog)

    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Const ForReading = 1
    Dim objFile: Set objFile = objFSO.OpenTextFile(strLog, ForReading)
    Dim strLine
    Dim strResult: strResult = ""
    Dim blnAction: blnAction = True
    Dim blnWarning: blnWarning = False
    Dim blnError: blnError = False
    Do Until objFile.AtEndOfStream
        strLine = objFile.ReadLine
        If Len(strLine) > 0 Then
            ' Backup SyncToyLog for Archiving
            Call Logger(Replace(strLog,"SyncToyLog.log","SyncToyLog_Full.txt",1,1,1),strLine,False)

            ' Check If Actions Were Performed
            If InStr(1,strLine,"Found 0 actions to perform",1) > 0 Then
                blnAction = False
            End If

            ' Check If Warning Was Logged
            If InStr(1,strLine,"Warning:",1) > 0 Then
                blnWarning = True
                If strResult = "" Then
                    strResult = strLine
                Else
                    strResult = strResult & vbcrlf & strLine
                End If
            End If

            ' Check If Error Was Logged
            If InStr(1,strLine,"Error:",1) > 0 Then
                blnError = True
                If strResult = "" Then
                    strResult = strLine
                Else
                    strResult = strResult & vbcrlf & strLine
                End If
            End If
        End If
    Loop
    objFile.Close

    Set objFSO = Nothing

    ParseSyncToyLog = strResult

End Function

Private Sub KillProcess(ByVal strProcess)
    Dim strComputer: strComputer = "."
    Dim objWMIService: Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
    Dim colItems: Set colItems = objWMIService.ExecQuery("Select * From Win32_Process")
    Dim objItem
    For Each objItem in colItems
        If StrComp(objItem.Name, strProcess, 1) = 0 Then
            objItem.Terminate()
        End If
    Next
End Sub

Private Function ExpandEnv(ByVal strPath)

    Dim objShell: Set objShell = CreateObject( "WScript.Shell" )
    ExpandEnv = objShell.ExpandEnvironmentStrings(strPath)
    Set objShell = Nothing

End Function

Private Sub Logger(fileName, logMessage, blnNewLog)

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

End Sub

 

Oct 08

Modify Proxyaddresses Domain

This powershell snippet is used to replace a domain in all values in a user’s proxyAddresses attribute.  It requires using Microsoft’s ActiveDirectory module.  It is is capable of bulk modifying all users in an OU or can modify a single user if you specify their DN.  In the script below, modify the SearchBase and replace @olddomain.com and @newdomain.com.

Import-Module ActiveDirectory
Get-ADUser -Filter * -SearchBase 'OU=Test,DC=domain,DC=local' -Properties proxyaddresses | Foreach {Set-ADUser -identity $_ -Replace @{'ProxyAddresses' = @($_.proxyaddresses -Replace "@olddomain.com","@newdomain.com")}}

 

Jun 12

Delegate Add/Delete Computer Objects in AD

AD Delegation allows you to give users/groups access to certain parts of your AD without giving them full admin access. A great example is allowing Help Desk users to reset user passwords; this is actually quite easy and is a default option when delegating permissions to an OU. However, you may want your Help Desk users to be able to join/remove computer accounts to your domain which is a bit more difficult. By default, a standard user account can join up to 10 workstations to your domain and more than likely you’ll want them to join more. Here are the necessary steps as well as my recommendations:

1 – Create New OU for your Computers

Computer OU

In this example, I made the top OU called Computer and made several sub OU’s.  I suggest using an OU because you can apply a GPO at the topmost level to apply specific security to all of your computers.

2 – Redirect the Default Computers Container to the New Computer OU in AD

By default, computers joined to an AD domain are put in the Computers Container, which cannot have a GPO applied because it’s a container and not an OU.  You can redirect that container to our new Computer OU using Redircmp.exe (http://support.microsoft.com/kb/324949).  On your AD Domain Controller, run the following command (Replace DC=contoso,DC=local with your domain name):

C:\windows\system32>redircmp OU=computer,DC=contoso,DC=local

 

 3 – Create a Global Security Group to Join/Delete Computers

Create a new Global Security Group, which we will use to delegate who can Join/Delete computers from AD.  In my example, I’ll use a group called Join-Move-Delete Computer OU

4 – Delegate the Join and Delete Permissions

  • Right-Click the Computer OU and select Properties
  • Click the Security tab and click the Advanced button

ComputerOU Properties

  • Click the Add button, enter the name of the security group Join-Move-Delete Computer OU and click OK. You can now add any users you desire to this group.

ComputerOU Advanced Security

  • Under Apply to, select This object and all descendant objects
  • Under the Allow column, select Create Computer Objects and Delete Computer Objects
  • Click OK on all of the screens to save the changes

ComputerOU Create-Delete Permissions

All members of the Join-Move-Delete Computer OU group can now Add and Delete Computers in your domain.

5 – Delegate Moving Objects to Sub-OU’s in the Computer OU (Optional)

Optionally but likely, you may want your users to be able to move the computers they join to the proper OU.  In that case, we need to add 1 more permission.

  • Right-Click the Computer OU and select Properties
  • Click the Security tab and click the Advanced button
  • Click the Add button, enter the name of the security group Join-Move-Delete Computer OU and click OK.
  • Under Apply to, select Descendant Computer objects
  • Under the Allow column, select Write all properties
  • Click OK on all of the screens to save the changes

All members of the Join-Move-Delete Computer OU group can now move computers between all of the Sub-OU’s in the Computer OU.

 

 

 

 

May 22

DHCPpwn

It’s more than an alpha than beta but… This is an old piece of code I was working on a few years ago, but recently found time to start coding again. I know it’s a bit buggy (all of the buttons do not function yet and it tends to lock up bc of the loop on sending packets), but I still have lots of improvements to work on… I need to add my IPv4 Subnet calculator class (Should fix the lockup issues) and ARP class (Some DHCP servers like Fios modems send an arp request after DHCP). I also gotta add the function to hijack existing leases, but it’ll exhaust the DHCP pool on most servers(ie: linksys, cisco routers, etc)… I got it in a working state, so figured I’d post it for fun… It’ll be much improved soon!

BTW, if you test it on any type of DHCP server and don’t see addresses exhaust, let me know… I’ll get my hands on it and love to find out what else it’s doing!

DHCPwn1b

Feb 28

How to Make Fedora 18 a PS3 Media Server

PS3 Media Server is a DLNA-compliant UPnP Media server which supports Playstation 3 and any other DLNA compliant device.  It allows you to stream video, music, images, etc to your DLNA device even if it does not support the codec the media is encoded in.  For a complete list of supported devices please visit http://www.ps3mediaserver.org/about/.

Install RPM Fusion

sudo yum localinstall --nogpgcheck http://download1.rpmfusion.org/free/fedora/rpmfusion-free-release-branched.noarch.rpm

 

Install Software Dependencies

sudo yum -y install mencoder ffmpeg mplayer freeglut java wget

 

Install libzen and libmediainfo (Optional but recommended)

As of this writing, the current version of libzen is v0.4.28 which the below command references. You can check for updates by going to http://mediainfo.sourceforge.net/en/Download/Fedora and modifying the link below accordingly.

sudo yum -y install http://downloads.sourceforge.net/zenlib/libzen0-0.4.28-1.x86_64.Fedora_18.rpm

 

As of this writing, the current version of libmediainfo is v0.7.62 which the below command references. You can check for update by going to http://mediainfo.sourceforge.net/en/Download/Fedora and modifying the command below accordingly.

sudo yum -y install http://mediaarea.net/download/binary/libmediainfo0/0.7.62/libmediainfo0-0.7.62-1.x86_64.Fedora_18.rpm

 

 

Add Firewall Exceptions for PS3 Media Server

sudo firewall-cmd --permanent --add-port=5001/tcp
sudo firewall-cmd --permanent --add-port=5353/udp
sudo firewall-cmd --reload

 

 

Install PS3 Media Server, Make It Executable, and Start Media Server

As of this writing, the current version of PS3 Media Server is 1.72.0, which is used in the below command. You can check for an update by going to http://code.google.com/p/ps3mediaserver/downloads/list and modifying command below accordingly.

wget http://ps3mediaserver.googlecode.com/files/pms-generic-linux-unix-1.72.0.tgz
tar -zxvf pms-generic-linux-unix-1.72.0.tgz
chmod +x pms-1.72.0/PMS.sh
pms-1.72.0/PMS.sh

 

Configure Navigation/Share Settings

By default, PS3 Media Server allows browsing All Drives on your system. For security reasons, you’ll want to modify the Share settings to only access specific folders such as music, pictures, and videos using the following steps:

  1. Click the Navigation/Share Settings Tab
  2. Under the Shared Folders section, click the Add button
    1. Select the folder you want to be accessible (ex: /home/<username>/music/)
  3. Repeat the previous step for each folder you want to be available
  4. Click the Save button
  5. Click the Restart Server button

PMS Navigation/Share Settings

 

Feb 26

How to Remotely Access Linux From Windows

There are many ways to remotely access Linux including VNC, SSH, FreeNX, NXFree, Hamachi, Teamviewer, and the list goes on.  When it comes to remote access a few questions come to mind…  Is it secure, is it GUI or Command Line, how’s the performance, what extra software is required, etc.  If you are connecting to your Fedora 18 install from Windows there’s a great solution called xRDP.  xRDP uses the Windows Remote Desktop protocol to present an X window’s desktop to the user.  The Windows Remote Desktop offers a secure connection to your Linux box, similar to VNC over SSH.  In addition, it does not require any additional software on your Windows machine since the Remote Desktop Client is built in.  If you are running Linux, you can remote into the server using RDesktop (Included in Fedora 18).

Install xRDP

sudo yum install xrdp

Start the xRDP Service and Set It to Start at Boot

systemctl start xrdp.service
systemctl enable xrdp.service

Add RDP Exception to the Firewall

firewall-cmd --add-port=3389/tcp
firewall-cmd --permanent --add-port=3389/tcp

Open the Windows RDP Client and Connect to Linux

WindowsRDPClient xRDPLogin

Customize Desktop Environment for xRDP Session

If you do not want to use the default desktop environment, you can customize it by creating a .Xclients file (X is capital!!!) in your home directory to launch the desktop environment you want and making it executable.  In order to do this, open a terminal and run one of the following commands

Gnome 3

sudo echo "gnome-session" > ~/.Xclients
sudo chmod +x ~/.Xclients
sudo systemctl restart xrdp.service

Gnome Fallback

sudo echo "gnome-fallback" > ~/.Xclients
sudo chmod +x ~/.Xclients
sudo systemctl restart xrdp.service

KDE

sudo echo "startkde" > ~/.Xclients
sudo chmod +x ~/.Xclients
sudo systemctl restart xrdp.service

MATE

sudo echo "mate-session" > ~/.Xclients
sudo chmod +x ~/.Xclients
sudo systemctl restart xrdp.service

Cinnamon

sudo echo "cinnamon" > ~/.Xclients
sudo chmod +x ~/.Xclients
sudo systemctl restart xrdp.service

Xfce4

sudo echo "startxfce4" > ~/.Xclients
sudo chmod +x ~/.Xclients
sudo systemctl restart xrdp.service

 

Feb 26

How to Install Mate, Cinnamon, KDE Plasma, and Xfce on Fedora 18

The Fedora 18 distribution ships using Gnome3 in most circumstances as the default desktop environment. There has been a lot of controversy about the direction Gnome3 has gone, which sparked many spin-off projects. If you are not a fan of Gnome3 or are just looking to try other desktop environments for Fedora, here are the directions you’ll need.  Please note, you need to be root to run the following commands.  You may switch to the root account in the terminal by issuing the ‘su’ command or by using ‘sudo’ in front of the commands below if your account is part of the administrators group.

 

Make Sure Fedora is Up to Date

Open a terminal and run the following command to update Fedora.

yum update

 

Install the MATE Desktop Environment

http://wiki.mate-desktop.org/download

Open a terminal and run the following command to install the MATE Desktop Environment

yum groupinstall "MATE Desktop"

Install the Cinnamon Desktop Environment

http://docs.fedoraproject.org/en-US/Fedora/18/html/Release_Notes/sect-Release_Notes-Changes_for_Desktop.html

Open a terminal and run the following command to install the Cinnamon Desktop Environment

yum groupinstall "Cinnamon Desktop"

Install the KDE Plasma Workspace

http://fedoraproject.org/wiki/KDE

Open a terminal and run the following command to install the KDE Plasma Workspace

yum install @kde-desktop

Install the Xfce Desktop Environment

http://fedoraproject.org/wiki/Xfce

Open a terminal and run the following command to install the Xfce Desktop Environment

yum groupinstall XFCE

 

Feb 09

ConvertOutlookContactsToAD.vbs

'=========================================================================
' ConvertOutlookContactsToAD.vbs
' VERSION: 1.0
' AUTHOR: Brian Steinmeyer
' EMAIL: sigkill@sigkillit.com
' WEB: http://sigkillit.com
' DATE: 2/9/2013
' REQUIREMENTS: Requires Exchange Tools or CDOEXM.DLL on the computer running
' the script to create Email enabled contacts. The script also uses OLEDB,
' which requires running it with %systemroot%\SysWow64\wscript.exe,
' %systemroot%\SysWow64\cscript.exe, or a 64-bit OLEDB Provider.
' COMMENTS: The script is designed to take an Outlook CSV(DOS) Exported list of
' contacts which is used to create AD contacts. However, not all attributes directly
' translate or have an equivelent. For example, AD only has attributes for a single
' address where Outlook contacts can have business, home, and other addresses. The
' strUserType variable was created to allow you to pick 1 of those 3 options to use
' on the import.
' To use the script export your Outlook contacts to a CSV(DOS) file. Then set the
' variables for the log file (Default is in the same directory as the script), the
' DN of the container you want to create the AD Contacts in, the location of the
' Outlook Exported Contacts CSV file, and the UserType(Business, Home, Other)
' EXAMPLE: Create Contacts with CSV file in the same folder as the script
'          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
'          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
'          Dim contactsExport: contactsExport = "export.csv"
'          Dim strUserType: strUserType = "Business"
' EXAMPLE: Create Contacts Using the Home Address in the CSV
'          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
'          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
'          Dim contactsExport: contactsExport = "export.csv"
'          Dim strUserType: strUserType = "Home"
' EXAMPLE: Create Contacts with CSV file in a different folder as the script
'          Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
'          Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
'          Dim contactsExport: contactsExport = "C:\scripts\export.csv"
'          Dim strUserType: strUserType = "Business"
'=========================================================================
Option Explicit
' ------ START CONFIGURATION ------
Dim strLogFile: strLogFile = Replace(WScript.ScriptName,".vbs",".txt")
Dim contactsDN: contactsDN = "OU=Contacts, DC=domain, DC=com"
Dim contactsExport: contactsExport = "export.csv"
Dim strUserType: strUserType = "Business" 'Business, Home, Other
' ------ END CONFIGURATION ------

Call Logger(strLogFile, "USER:GENERAL, EMAIL, ORGANIZATION, ADDRESS, TELEPHONE", True)
Call CreateContacts(contactsExport, contactsDN, strUserType, strLogFile)
Wscript.Echo "Finished"

Private Sub CreateContacts(strContactsFile, strContactsDN, UserType, strLogFile)

    On Error Resume Next  'Start Error Handling

    'Ensure DN not ADS Path
    strContactsDN = Replace(strContactsDN,"LDAP://","",1,1,1)  

    'Grab Contacts With OLEDB - If Using a 64-bit OS you Must Use
    ' - C:\Windows\SysWow64\wscript.exe OR C:\Windows\SysWow64\cscript.exe
    ' - Alternatively, use a 64-bit OLEDB Provider (http://www.microsoft.com/en-us/download/details.aspx?id=20065)
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim objFile: Set objFile = objFSO.GetFile(strContactsFile)
    Const adOpenStatic = 3
    Const adLockOptimistic = 3
    Const adCmdText = &H0001
    Dim objConnection: Set objConnection = CreateObject("ADODB.Connection")
    Dim objRecordSet: Set objRecordSet = CreateObject("ADODB.Recordset")
    objConnection.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & objFile.ParentFolder & "\;" & _
        "Extended Properties=""text;HDR=YES;FMT=Delimited"""
    objRecordset.Open "SELECT * FROM [" & objFile.Name & "]", objConnection, adOpenStatic, adLockOptimistic, adCmdText
    If Err.Number <> 0 Then
        Err.Clear
        Call Logger(strLogFile, "Error Contacts File Is Already Opened, Quitting Script!", False)
    End If

    'Connect to AD and Get Contacts Container
    Const ADS_SCOPE_SUBTREE = 2
    Dim objConnection2: Set objConnection2 = CreateObject("ADODB.Connection")
    Dim objCommand: Set objCommand = CreateObject("ADODB.Command")
    objConnection2.Provider = "ADsDSOObject"
    objConnection2.Open "Active Directory Provider"
    Set objCommand.ActiveConnection = objConnection2
    objCommand.Properties("Page Size") = 1000   'Override the Return 1000 Results Default      
    objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE    'Include Sub OU's
    objCommand.CommandText = "SELECT ADsPath FROM 'LDAP://" & strContactsDN & "'"
    Dim objRecordset2: Set objRecordSet2 = objCommand.Execute
    If Not objRecordSet2.RecordCount > 0 Then
        Call Logger(strLogFile, "Error Contacts Container Doesn't Exist, Quitting Script!", False)
        Exit Sub
    End If
    Dim objContainer: Set objContainer = GetObject(objRecordSet2.Fields("AdsPath").Value)
    Dim strResult
    Dim blnAttributeFound
    Dim objContact, cFName, cLName, cInitials, cOffice, cWebpage
    Dim cEmail, cEmailAlias
    Dim cJobTitle, cDepartment, cCompany
    Dim cStreet, cCity, cState, cZip, cCountry, cPOBox
    Dim cHomePhone, cOtherHomePhone, cPager, cMobile, cFax, cOtherFax, cIPPhone, cOtherIPPhone, cTelephone, cOtherTelephone, cNotes
    Do Until objRecordset.EOF
        'Set Contact CN
        strResult = objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name") & ":"
        Set objContact = objContainer.Create("Contact","CN=" & objRecordset.Fields.Item("First Name") & " " & objRecordset.Fields.Item("Last Name"))

        'General Attributes (Telephone/Other Telephone Under Telephones Attributes and E-mail Under Email Attributes
        If Not IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then
            cFName = objRecordset.Fields.Item("First Name")
            cLName = objRecordset.Fields.Item("Last Name")
            objContact.Put "givenName", cFName
            objContact.Put "SN", cLName
            objContact.Put "displayname", cFName & " " & cLName
        Elseif Not IsNull(objRecordset.Fields.Item("First Name")) AND IsNull(objRecordset.Fields.Item("Last Name")) Then
            cFName = objRecordset.Fields.Item("First Name")
            objContact.Put "givenName", cFName
            objContact.Put "displayname", cFName
        Elseif IsNull(objRecordset.Fields.Item("First Name")) AND Not IsNull(objRecordset.Fields.Item("Last Name")) Then
            cLName = objRecordset.Fields.Item("Last Name")
            objContact.Put "SN", cLName
            objContact.Put "displayname", cLName           
        End If
        If Not IsNull(objRecordset.Fields.Item("Initials")) Then
            cInitials = objRecordset.Fields.Item("Initials")
            objContact.Put "initials", cInitials
        End If
        If Not IsNull(objRecordset.Fields.Item("Office Location")) Then
            cOffice = objRecordset.Fields.Item("Office Location")
            objContact.Put "physicalDeliveryOfficeName", cOffice
        End If
        If Not IsNull(objRecordset.Fields.Item("Web Page")) Then
            cWebpage = objRecordset.Fields.Item("Web Page")
            objContact.Put "wWWHomePage", cWebpage
        End If
        objContact.SetInfo
        If Err.Number <> 0 Then
            Err.Clear
            strResult = strResult & "ERROR,ERROR,ERROR,ERROR,ERROR"
        Else
            strResult = strResult & "SUCCESS,"

            'Email Attributes (Assumes First Email)
            blnAttributeFound = False
            If Not IsNull(objRecordset.Fields.Item("E-mail Address")) Then
                blnAttributeFound = True
                cEmail = objRecordset.Fields.Item("E-mail Address")
                objContact.Put "Mail", cEmail
                objContact.MailEnable cEmail
            End If
            If Not IsNull(objRecordset.Fields.Item("E-mail Display Name")) Then
                blnAttributeFound = True
                cEmailAlias = objRecordset.Fields.Item("E-mail Display Name")
                objContact.Put "mailNickname", cEmailAlias
                objContact.MailEnable cEmail
            End If
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR,"
            Else
                strResult = strResult & "SUCCESS,"
            End If

            'Organization Attributes
            blnAttributeFound = False
            If Not IsNull(objRecordset.Fields.Item("Job Title")) Then
                blnAttributeFound = True
                cJobTitle = objRecordset.Fields.Item("Job Title")
                objContact.Put "title", cJobTitle
            End If
            If Not IsNull(objRecordset.Fields.Item("Department")) Then
                blnAttributeFound = True
                cDepartment = objRecordset.Fields.Item("Department")
                objContact.Put "department", cDepartment
            End If
            If Not IsNull(objRecordset.Fields.Item("Company")) Then
                blnAttributeFound = True
                cCompany = objRecordset.Fields.Item("Company")
                objContact.Put "company", cCompany
            End If
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR,"
            Else
                strResult = strResult & "SUCCESS,"
            End If

            'Address Attributes (Add Variable to choose business, home, or other)
            blnAttributeFound = False
            Select Case UCase(UserType)
            Case "BUSINESS"
                If Not IsNull(objRecordset.Fields.Item("Business Street")) Then
                    blnAttributeFound = True
                    cStreet = objRecordset.Fields.Item("Business Street")
                    If Not IsNull(objRecordset.Fields.Item("Business Street 2")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 2")
                    End If
                    If Not IsNull(objRecordset.Fields.Item("Business Street 3")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Business Street 3")
                    End If
                    objContact.Put "streetAddress", cStreet
                End If
                If Not IsNull(objRecordset.Fields.Item("Business City")) Then
                    blnAttributeFound = True
                    cCity = objRecordset.Fields.Item("Business City")
                    objContact.Put "l", cCity
                End If
                If Not IsNull(objRecordset.Fields.Item("Business State")) Then
                    blnAttributeFound = True
                    cState = objRecordset.Fields.Item("Business State")
                    objContact.Put "st", cState
                End If
                If Not IsNull(objRecordset.Fields.Item("Business Postal Code")) Then
                    blnAttributeFound = True
                    cZip = objRecordset.Fields.Item("Business Postal Code")
                    objContact.Put "postalCode", cZip
                End If
                If Not IsNull(objRecordset.Fields.Item("Business Country/Region")) Then
                    blnAttributeFound = True
                    cCountry = objRecordset.Fields.Item("Business Country/Region")
                    objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166
                End If
                If Not IsNull(objRecordset.Fields.Item("Business Address PO Box")) Then
                    blnAttributeFound = True
                    cPOBox = objRecordset.Fields.Item("Business Address PO Box")
                    objContact.Put "postOfficeBox", cPOBox
                End If
            Case "HOME"
                If Not IsNull(objRecordset.Fields.Item("Home Street")) Then
                    blnAttributeFound = True
                    cStreet = objRecordset.Fields.Item("Home Street")
                    If Not IsNull(objRecordset.Fields.Item("Home Street 2")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 2")
                    End If
                    If Not IsNull(objRecordset.Fields.Item("Home Street 3")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Home Street 3")
                    End If
                    objContact.Put "streetAddress", cStreet
                End If
                If Not IsNull(objRecordset.Fields.Item("Home City")) Then
                    blnAttributeFound = True
                    cCity = objRecordset.Fields.Item("Home City")
                    objContact.Put "l", cCity
                End If
                If Not IsNull(objRecordset.Fields.Item("Home State")) Then
                    blnAttributeFound = True
                    cState = objRecordset.Fields.Item("Home State")
                    objContact.Put "st", cState
                End If
                If Not IsNull(objRecordset.Fields.Item("Home Postal Code")) Then
                    blnAttributeFound = True
                    cZip = objRecordset.Fields.Item("Home Postal Code")
                    objContact.Put "postalCode", cZip
                End If
                If Not IsNull(objRecordset.Fields.Item("Home Country/Region")) Then
                    blnAttributeFound = True
                    cCountry = objRecordset.Fields.Item("Home Country/Region")
                    objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166
                End If
                If Not IsNull(objRecordset.Fields.Item("Home Address PO Box")) Then
                    blnAttributeFound = True
                    cPOBox = objRecordset.Fields.Item("Home Address PO Box")
                    objContact.Put "postOfficeBox", cPOBox
                End If
            Case "OTHER"
                If Not IsNull(objRecordset.Fields.Item("Other Street")) Then
                    blnAttributeFound = True
                    cStreet = objRecordset.Fields.Item("Other Street")
                    If Not IsNull(objRecordset.Fields.Item("Other Street 2")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 2")
                    End If
                    If Not IsNull(objRecordset.Fields.Item("Other Street 3")) Then
                        cStreet = cStreet & vbCrLf & objRecordset.Fields.Item("Other Street 3")
                    End If
                    objContact.Put "streetAddress", cStreet
                End If
                If Not IsNull(objRecordset.Fields.Item("Other City")) Then
                    blnAttributeFound = True
                    cCity = objRecordset.Fields.Item("Other City")
                    objContact.Put "l", cCity
                End If
                If Not IsNull(objRecordset.Fields.Item("Other State")) Then
                    blnAttributeFound = True
                    cState = objRecordset.Fields.Item("Other State")
                    objContact.Put "st", cState
                End If
                If Not IsNull(objRecordset.Fields.Item("Other Postal Code")) Then
                    blnAttributeFound = True
                    cZip = objRecordset.Fields.Item("Other Postal Code")
                    objContact.Put "postalCode", cZip
                End If
                If Not IsNull(objRecordset.Fields.Item("Other Country/Region")) Then
                    blnAttributeFound = True
                    cCountry = objRecordset.Fields.Item("Other Country/Region")
                    objContact.Put "co", cCountry  'Note: use co to choose Country Name in ISO3166
                End If
                If Not IsNull(objRecordset.Fields.Item("Other Address PO Box")) Then
                    blnAttributeFound = True
                    cPOBox = objRecordset.Fields.Item("Other Address PO Box")
                    objContact.Put "postOfficeBox", cPOBox
                End If
            End Select
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR,"
            Else
                strResult = strResult & "SUCCESS,"
            End If

            'Telephone Attributes (Add Variable to choose business, home or other)
            blnAttributeFound = False
            If Not IsNull(objRecordset.Fields.Item("Home Phone")) Then
                blnAttributeFound = True
                cHomePhone = objRecordset.Fields.Item("Home Phone")
                objContact.Put "homePhone", cHomePhone
            End If
            If Not IsNull(objRecordset.Fields.Item("Home Phone 2")) Then
                blnAttributeFound = True
                cOtherHomePhone = objRecordset.Fields.Item("Home Phone 2")
                objContact.PutEx 3, "otherHomePhone", Array(cOtherHomePhone)
            End If
            If Not IsNull(objRecordset.Fields.Item("Pager")) Then
                blnAttributeFound = True
                cPager = objRecordset.Fields.Item("Pager")
                objContact.Put "pager", cPager
            End If
            If Not IsNull(objRecordset.Fields.Item("Mobile Phone")) Then
                blnAttributeFound = True
                cMobile = objRecordset.Fields.Item("Mobile Phone")
                objContact.Put "mobile", cMobile
            End If
            If Not IsNull(objRecordset.Fields.Item("Business Fax")) Then
                blnAttributeFound = True
                cFax = objRecordset.Fields.Item("Business Fax")
                objContact.Put "facsimileTelephoneNumber", cFax
            End If
            If Not IsNull(objRecordset.Fields.Item("Home Fax")) Then
                blnAttributeFound = True
                cOtherFax = objRecordset.Fields.Item("Home Fax")
                objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)
            End If
            If Not IsNull(objRecordset.Fields.Item("Other Fax")) Then
                blnAttributeFound = True
                cOtherFax = objRecordset.Fields.Item("Other Fax")
                objContact.PutEx 3, "otherFacsimileTelephoneNumber", Array(cOtherFax)
            End If
            If Not IsNull(objRecordset.Fields.Item("Business Phone")) Then
                blnAttributeFound = True
                cIPPhone = objRecordset.Fields.Item("Business Phone")
                objContact.Put "ipPhone", cIPPhone
            End If
            If Not IsNull(objRecordset.Fields.Item("Business Phone 2")) Then
                blnAttributeFound = True
                cOtherIPPhone = objRecordset.Fields.Item("Business Phone 2")
                objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)
            End If
            If Not IsNull(objRecordset.Fields.Item("Company Main Phone")) Then
                blnAttributeFound = True
                cOtherIPPhone = objRecordset.Fields.Item("Company Main Phone")
                objContact.PutEx 3, "otherIpPhone", Array(cOtherIPPhone)
            End If
            If Not IsNull(objRecordset.Fields.Item("Primary Phone")) Then
                blnAttributeFound = True
                cTelephone = objRecordset.Fields.Item("Primary Phone")
                objContact.Put "telephoneNumber", cTelephone
            End If
            If Not IsNull(objRecordset.Fields.Item("Other Phone")) Then
                blnAttributeFound = True
                cOtherTelephone = objRecordset.Fields.Item("Other Phone")
                objContact.Put "otherTelephone", cOtherTelephone
            End If
            If Not IsNull(objRecordset.Fields.Item("Notes")) Then
                blnAttributeFound = True
                cNotes = objRecordset.Fields.Item("Notes")
                objContact.Put "info", cNotes
            End If
            If blnAttributeFound = True Then
                objContact.SetInfo
            End If
            If Err.Number <> 0 Then
                Err.Clear
                strResult = strResult & "ERROR"
            Else
                strResult = strResult & "SUCCESS"
            End If
        End If

        'Log Results
        Call Logger(strLogFile, strResult, False)      
        objRecordset.MoveNext
    Loop

    objRecordset.Close
    objRecordset2.Close

    On Error Goto 0  'End Error Handling

End Sub

Private Sub Logger(fileName, logMessage, blnNewLog)

    On Error Resume Next

    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim objFSO: Set objFSO = CreateObject("Scripting.FileSystemObject")
    Dim scriptPath: scriptPath = Left(WScript.ScriptFullName,InstrRev(WScript.ScriptFullName,"\"))
    Dim logName
    If InStr(1,fileName,"\",1) > 0 Then
        logName = fileName
        If objFSO.DriveExists(objFSO.GetDriveName(logName)) Then
            If StrComp(objFSO.GetExtensionName(logName), "", 1) = 0 Then
                If Not objFSO.FolderExists(logName) Then
                    If objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        objFSO.CreateFolder logName 'Create Folder In Current Path
                        Exit Sub
                    Else
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog) 'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog) 'Recurse Creating Current Folder
                        Exit Sub
                    End If
                End If
            Else
                If Not objFSO.FileExists(logName) Then
                    If Not objFSO.FolderExists(objFSO.GetParentFolderName(logName)) Then
                        Call Logger(objFSO.GetParentFolderName(logName), logMessage, blnNewLog)  'Recurse Creating Parent Folder
                        Call Logger(logName, logMessage, blnNewLog)  'Recurse Creating Current Folder
                    End If
                End If
            End If
        End If
    Else
        logName = scriptPath & fileName
    End If
    Dim logFile
    If blnNewLog = True Then
        Set logFile = objFSO.CreateTextFile(logName, True)
    Else
        If objFSO.FileExists(logName) Then
            Set logFile = objFSO.OpenTextFile(logName, ForAppending, True)
        Else
            Set logFile = objFSO.CreateTextFile(logName, True)
        End If
    End If
    logFile.WriteLine logMessage
    logFile.Close
    Set objFSO = Nothing

    On Error Goto 0

End Sub

 

Feb 07

Outlook unable to open your default e-mail folders

Error Messages

  • unable to open your default e-mail folders
  • Cannot open the Outlook window. The server is not available.

Resolution 1

Outlook was installed with compatibility mode.

  1. Locate your outlook.exe,
    1. Typically in C:\Program Files (x86)\Microsoft Office\Office14\
      1. (Note: 14 is for office 2010, yours may vary depending on your version of Outlook).
  2. Right-click the OUTLOOK.EXE, and select properties.
  3. On the Compatibility tab, uncheck all of the settings as shown belowOutlook Compatibility Tab Everything Unchecked

 

Resolution 2

Use the /resetnavpane when opening Outlook.

  1. Click Start and enter cmd in the search/run menu to open a command prompt
  2. In the command prompt, run the following command
    1. (Note: 14 is for office 2010, yours may vary depending on your version of Outlook)
C:\Program Files (x86)\Microsoft Office\Office14\outlook.exe /resetnavpane

 

Jan 26

Running VBScripts with UAC Elevation

Overview

Since the introduction of User Account Control (UAC), scripts do not run with administrator privileges despite being a local administrator.  You must elevate your script to run with administrator privileges. I’ll start by showing you a simple example.  The script below will list all of the processes on the local computer as well as the WIN32_Process CommandLine property.  If you run the script on a computer with UAC without elevating it, you will only see CommandLine values for processes created by your account; if any other processes were created by another account, the CommandLine property will be NULL.

strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
Set colItems = objWMIService.ExecQuery("SELECT * FROM Win32_Process",,48)
For Each objItem in colItems
Wscript.Echo "Process: " & objItem.Name & vbCrLf & _
"Startup: " & objItem.CommandLine
Next

 

On a test machine, I was logged on as User1, opened notepad, and launched a vbscript as the local administrator account using RunAs.  I ran the script above and compared the results to task manager with the following results:

As you can see, the script successfully showed the CommandLine property for the currently logged on user

User1 Test Script Notepad Process Results

User1 Task Manager Notepad Process Results

However, the test script failed to show the CommandLine property for the wscript.exe process running as administrator:

Administrator Test Script Wscript Process Results

Administrator Task Manager Wscript Process Results

By re-running the test script with elevated privileges, the script now successfully shows the CommandLine property for the wscript process running as Administrator.

Administrator Elevated Test Script Wscript Process Results

Now that I have successfully demonstrated the need to run a script elevated on a local machine, you might be wondering what happens when you the test script on a remote machine.  If you run the script on a remote machine that you have administrator rights on, it will successfully display the CommandLine property for all users.  Now, you might be confused as to why it works remotely?  The answer is quite simple, the script is elevated by RPC.  Now that you have a good understanding of running vbscripts with UAC elevation, here are some methods on how to elevate them.

 

 Method 1 – Elevating Using the Command Prompt

  1. Click Start, All Programs, Click Accessories
  2. Right-click Command Prompt and click Run as administratorRun Elevated Command Prompt
  3. Click Yes
    1. CMD UAC Prompt
  4. Any script you launch using wscript.exe or cscript.exe will launch elevated

Method 2 – RunAs Script

This method uses a wrapper script to run an elevated VBScript using the runas verb with the ShellExecute method of Shell.Application.  When it launches the elevated script, click Yes

http://sigkillit.com/2013/01/25/elevatewscript-vbs/

VBS UAC Prompt

 

Method 3 – Add ‘Run as administrator’ to the .vbs File Context Menu

The ‘Run as administrator’ option on a File Context Menu is only available on certain file types by default, and .vbs files are not one of them.  However, by doing a quick registry modification we can enable the ‘Run as administrator’ option o the file context menu.  Download and run the following registry to merge it into your registry, or you can copy the below text and save it to a .reg file:

Add Run as administrator to VBS File Context Menu

Windows Registry Editor Version 5.00

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\runas]
"HasLUAShield"=""

[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\runas\Command]
@=hex(2):22,00,25,00,53,00,79,00,73,00,74,00,65,00,6d,00,52,00,6f,00,6f,00,74,\
00,25,00,5c,00,53,00,79,00,73,00,74,00,65,00,6d,00,33,00,32,00,5c,00,57,00,\
53,00,63,00,72,00,69,00,70,00,74,00,2e,00,65,00,78,00,65,00,22,00,20,00,22,\
00,25,00,31,00,22,00,20,00,25,00,2a,00,00,00