VB HTA File Copy by Group
I have a VB/HTA login script that is nearly working. However, I want to be able to copy a file from a network share based on an AD Group. I've managed to get it to create shortcuts based on AD, but not this.
Here is the code I'm trying:-
It sounds simple, but all it does is copy both File1 and File2 to the machine, which is obviously not what I'm looking for.
To explain, the FileX.bmp file will be renamed later to a standard BG.bmp file for use with BGInfo. That bit's working! It's just this bit I'm having problems with.
Any help would be gratefully received.
Thanks!
Here is the code I'm trying:-
Const bgGroup1 = "ADgroup1"
Const bgFolder1 = "C:\BG\", bgFile1 = "\\DOMAIN\netlogon\bg\file1*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder1) Then
oFSO.CreateFolder bgFolder1
End If
oFSO.CopyFile bgFile1, bgFolder1, Overwrite
Const bgGroup2 = "ADgroup2"
Const bgFolder2 = "C:\BG\", bgFile2 = "\\DOMAIN\netlogon\bg\file2*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder2) Then
oFSO.CreateFolder bgFolder2
End If
oFSO.CopyFile bgFile2, bgFolder2, Overwrite
It sounds simple, but all it does is copy both File1 and File2 to the machine, which is obviously not what I'm looking for.
To explain, the FileX.bmp file will be renamed later to a standard BG.bmp file for use with BGInfo. That bit's working! It's just this bit I'm having problems with.
Any help would be gratefully received.
Thanks!
Do more with
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Hi, try this code.
Regards,
Rob.
Regards,
Rob.
' THIS LINE MUST BE PLACED IN THE MAIN CODE TO ALLOW THE DICTIONARY
' OBJECT TO REMAIN PERSISTENT FOR THE ISMEMBEROFGROUP FUNCTION
Dim objMemberships
Set objNetwork = CreateObject("WScript.Network")
Set objADSysInfo = CreateObject("ADSystemInfo")
Set objUser = GetObject("LDAP://" & objADSysInfo.UserName)
Const bgGroup1 = "ADgroup1"
Const bgFolder1 = "C:\BG\"
Const bgFile1 = "\\DOMAIN\netlogon\bg\file1*"
Const bgGroup2 = "ADgroup2"
Const bgFolder2 = "C:\BG\"
Const bgFile2 = "\\DOMAIN\netlogon\bg\file2*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If IsMemberOfGroup(objUser, bgGroup1) = True Then
If Not oFSO.FolderExists(bgFolder1) Then
oFSO.CreateFolder bgFolder1
End If
oFSO.CopyFile bgFile1, bgFolder1, Overwrite
End If
If IsMemberOfGroup(objUser, bgGroup2) = True Then
If Not oFSO.FolderExists(bgFolder2) Then
oFSO.CreateFolder bgFolder2
End If
oFSO.CopyFile bgFile2, bgFolder2, Overwrite
End If
Function IsMemberOfGroup(objADUser, strGroupCN)
If IsEmpty(objMemberships) = True Then
Set objMemberships = CreateObject("Scripting.Dictionary")
objMemberships.Add LCase("ALL"), 0
If IsNull(objADUser.MemberOf) = False Then
If TypeName(objADUser.MemberOf) = "String" Then
objMemberships.Add LCase(Mid(Split(objADUser.MemberOf, ",")(0), 4)), 0
Else
For Each strGroupName In objADUser.MemberOf
objMemberships.Add LCase(Mid(Split(strGroupName, ",")(0), 4)), 0
Next
End If
End If
End If
If objMemberships.Exists(LCase(strGroupCN)) = True Then
IsMemberOfGroup = True
Else
IsMemberOfGroup = False
End If
End Function
this is powershell and handles groups
$user = $env:USERNAME
$Group = @()
$info = @{
'Group' = "ADGroup1"
"Source" = "\\DOMAIN\netlogon\bg\file1.bmp"
}
$Group = New-Object -TypeName psobject -Property $Info
$info = @{
'Group' = "ADGroup2"
"Source" = "\\DOMAIN\netlogon\bg\file2.bmp"
}
$Group2 = New-Object -TypeName psobject -Property $Info
$Group = [array]$Group + $Group2
$tocopy = "\\DOMAIN\netlogon\bg\BGFILEDefault.bmp"
foreach($group in $Groups){
if ((Get-ADUser $User -Properties memberof).memberof -like "CN=" + $group.Group)
{
$tocopy = $group.source
break
}
}
$bgFolder = "C:\BG\"
if (!(test-path $bgFolder)) {
md $bgFolder
}
copy-item $tocopy -Container $bgFolder -Include $tocopy -Force
rename-item $tocopy bginfo.bmp
Rob,
I tried your suggestion, but it didn't copy anything - including files that had happily copied previously.
David,
How would I put this into a VB or HTA script?
I have copied the whole code (prior to the updates from Rob which have been redacted) in case something further down (or up) is causing the issue.
I tried your suggestion, but it didn't copy anything - including files that had happily copied previously.
David,
How would I put this into a VB or HTA script?
I have copied the whole code (prior to the updates from Rob which have been redacted) in case something further down (or up) is causing the issue.
<!--
Logon Script - logon.hta
Created by ME
Version 1.0
-->
<head>
<title></title>
<script language="VBScript">
'Prevent Window flickering on load.
Me.ResizeTo 500,378
'Move Window off screen.
Me.MoveTo ((Screen.Width)),((Screen.Height))
</script>
<HTA:APPLICATION
APPLICATIONNAME="LogonScript"
BORDER="thin"
BorderStyle="complex"
SCROLL="no"
maximizebutton="no"
minimizebutton="no"
SINGLEINSTANCE="yes"
WINDOWSTATE="normal"
SysMenu="no"
ContextMenu="no"
Icon="C:\[FOLDER]\logon.ico"
>
</head>
<script language="VBScript">
Dim FSO, oShell, oNetwork, objSysInfo, sUserDN, objUser
Dim sDepartment, sUserName, sComputerName, sDomain, sDisplayName, sGroups, sDN
Dim sStatus, intSeconds, sDesktop, sScriptDir, iTimerID
'Configure for your domain. See "MainScript" Sub for drive mappings.
sDN = "[DOMAIN].local"
Sub Window_onLoad
On Error Resume Next
Set FSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("WScript.Shell")
Set oNetwork = CreateObject("WScript.Network")
'Get User's information.
UserInfo
'User's Desktop for deploying shortcuts.
sDesktop = oShell.ExpandEnvironmentStrings("%USERPROFILE%") & "\Desktop\"
'Populate Window with user info.
document.title = sDomain & " Logon Script - " & sDepartment 'Changes title bar to reflect domain and department the current user is logging onto.
DisplayName.InnerHTML = sDisplayName
UserName.InnerHTML = sUserName
ComputerName.InnerHTML = sComputerName
'Repl[FOLDER] logo with Dept. logo if found.
HTA = location.pathname
HTA_Path = Left(HTA,InStrRev(HTA,"\"))
'Repl[FOLDER] logo with Dept logo if found. Pl[FOLDER] department logo in same dir as logon.hta. Name should be logo-department.gif, where department is the OU name.
If FSO.FileExists(HTA_Path & "logo-" & sDepartment & ".gif") Then
Logo.src = "logo-" & sDepartment & ".gif"
Else
Logo.src = "logo-default.gif"
End If
'Move to top left of screen.
Me.MoveTo 100,100
'Run Main Logon Script
MainScript
'Countdown timer before closing. Set time in seconds.
intSeconds = 3
iTimerID = window.setInterval("Count", 1000)
End Sub
Sub Default_Buttons
If Window.Event.KeyCode = 13 Then
End If
End Sub
Sub UserInfo
On Error Resume Next
Dim arrDept
Set objSysInfo = CreateObject("ADSystemInfo")
sUserDN = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & sDN & "/" & sUserDN)
'Find User and Computer info.
sUserName = oNetwork.UserName
sComputerName = UCase((oNetwork.ComputerName))
sDomain = UCase((oNetwork.UserDomain))
sDisplayName = trim(objUser.DisplayName)
'Find Group Memberships
sGroups = GetGroups(sUserDN)
'Get department name from DN. (Assuming users OU in AD is setup as Domain->Department->Users->UserObject)
arrDept = split(sUserDN, ",")
sDepartment = mid(arrDept(2), 4) 'Set number in array where department OU name is found.
'ie: CN=UserName,OU=Users,OU=Department,DC=your,DC=domain,DC=com; arrDept(2) = OU=Department
'If Full Name isn't found, set as username.
If sDisplayName = "" Then
sDisplayName = sDisplayName
End If
Err.Clear
Set objSysInfo = Nothing
Set objUser = Nothing
End Sub
'=======================================================================
Sub MainScript
On Error Resume Next
objExplorer.Visible = 1
' *****Change Mouse Cursor, Set Window Title *****
objExplorer.Document.Body.Style.Cursor = "wait"
' *****Window Message, Hourglass icon, 1 Second pause *****
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")
' *****Object to run SHELL Commands *****
Set objShell = WScript.CreateObject("WScript.Shell")
Set WSHShell = CreateObject("WScript.Shell")
Set WSHNetwork = CreateObject("WScript.Network")
Set objSysInfo = CreateObject("ADSystemInfo")
strUser = objSysInfo.UserName
Set objUser = GetObject("LDAP://" & strUser)
strFullName = objUser.Get("displayName")
' ***** Grab User Name and Domain Name *****
DomainString = Wshnetwork.UserDomain
' ***** Find the Windows Directory *****
WinDir = WshShell.ExpandEnvironmentStrings("%WinDir%")
' ***** Grab the user name *****
UserString = strFullName
' ***** Bind to the user object to get user name and check for group memberships later *****
Set UserObj = GetObject("WinNT://" & DomainString & "/" & UserString)
' ***** Grab the computer name for use in add-on code later *****
strComputer = WSHNetwork.ComputerName
' ***** Find if C:\[FOLDER] exists and create it if not. Copy Updated files from [FOLDER] DC to C:\[FOLDER] *****
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat ("I am copying any Updated Files from the Server. Please wait a moment....")
ShowStat (" ")
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")
Const strFolder = "C:\[FOLDER]\", strFile = "\\[DOMAIN].local\netlogon\[FOLDER]\*.*"
Const Overwrite = True
Dim oFSO
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(strFolder) Then
oFSO.CreateFolder strFolder
End If
oFSO.CopyFile strFile, strFolder, Overwrite
'
' ================================================
' Copies Background file dependent on Group
'
Const bgGroup1 = "gpo_[COMPANY2]_background"
Const bgFolder1 = "C:\[FOLDER]\", bgFile1 = "\\[DOMAIN].local\netlogon\[FOLDER]\backgrounds\[COMPANY2]*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder1) Then
oFSO.CreateFolder bgFolder1
End If
oFSO.CopyFile bgFile1, bgFolder1, Overwrite
Const bgGroup2 = "gpo_[COMPANY]_background"
Const bgFolder2 = "C:\[FOLDER]\", bgFile2 = "\\[DOMAIN].local\netlogon\[FOLDER]\backgrounds\[COMPANY]*"
Set oFSO = CreateObject("Scripting.FileSystemObject")
If Not oFSO.FolderExists(bgFolder2) Then
oFSO.CreateFolder bgFolder2
End If
oFSO.CopyFile bgFile2, bgFolder2, Overwrite
' ***** Create Desktop Shortcuts *****
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat ("I am checking for, and creating your personal Desktop Shortcuts. Give me a few seconds, please...")
ShowStat (" ")
ShowStat ("I am copying any Updated Files from the Server. Please wait a moment....")
ShowStat (" ")
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")
' ================== Delete Old Shortcuts =============================
Set Shell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
DesktopPath = Shell.SpecialFolders("Desktop")
FSO.DeleteFile DesktopPath & "\intranet.url"
FSO.DeleteFile DesktopPath & "\[APPLICATION] Online.lnk"
FSO.DeleteFile DesktopPath & "\[APPLICATION].lnk"
FSO.DeleteFile DesktopPath & "\[APPLICATION].lnk"
FSO.DeleteFile DesktopPath & "\[APPLICATION] Queries and Reports Menu.lnk"
FSO.DeleteFile DesktopPath & "\Company.lnk"
FSO.DeleteFile "C:\[FOLDER]\bg.bmp"
' To Delete a file from within C:\[FOLDER] that is no longer required, uncomment and modify the below - works as normal User
' FSO.DeleteFile "C:\[FOLDER]\FILENAME"
' ================== Create New Shortcuts =============================
SET oFSO = Wscript.CreateObject("Scripting.FileSystemObject")
strDsk = WshShell.SpecialFolders("Desktop")
' ***** Code to create a specific shortcut *****
Dim objNetwork, objUser, CurrentUser, strDesktop
Dim strGroup, oShellLink
'
' ================================================
' Configure
'
Const userGroup1 = "sc_laptop_users"
Const userGroup2 = "sc_[APPLICATION]"
Const userGroup3 = "sc_[WEB APPLICATION]"
Const userGroup4 = "sc_[APPLICATION]"
Const userGroup5 = "sc_intranet"
' ================================================
' Create objects and extract strGroup values
Set objNetwork = CreateObject("WScript.Network")
Set objUser = CreateObject("ADSystemInfo")
Set CurrentUser = GetObject("LDAP://" & objUser.UserName)
strGroup = LCase(Join(CurrentUser.MemberOf))
set WshShell = WScript.CreateObject("WScript.Shell")
strDesktop = WshShell.SpecialFolders("Desktop")
' Assign shortcuts
' == Laptop Users ====================================
If InStr(strGroup, lcase(userGroup1)) Then
' Example of an Application Shortcut
set oShellLink = WshShell.CreateShortcut(strDesktop & "\Login Offline.lnk")
oShellLink.TargetPath = "C:\[FOLDER]\Logon.cmd"
oShellLink.IconLocation = "C:\[FOLDER]\Logon.ico"
oShellLink.Description = "Login Offline"
oShellLink.Save
set oShellLink = WshShell.CreateShortcut(strDesktop & "\VPN.lnk")
oShellLink.TargetPath = "C:\Program Files (x86)\Fortinet\SslvpnClient\FortiSSLVPNclient.exe"
oShellLink.IconLocation = "%SystemRoot%\Installer\{A34DCE59-0004-0000-2267-3F8A9926B752}\FortiSSLVPNclient.ico"
oShellLink.Description = "VPN"
oShellLink.Save
End If
' ================================================
' == [APPLICATION] Online =========================
If InStr(strGroup, lcase(userGroup3)) Then
set oShellLink = WshShell.CreateShortcut(strDesktop & "\[APPLICATION] Online.lnk")
oShellLink.TargetPath = "https://chlapps.co.uk/FosteringSolutions/[APPLICATION]online/default.asp"
oShellLink.IconLocation = "C:\[FOLDER]\col.ico"
oShellLink.Description = "[APPLICATION] Online"
oShellLink.Save
End If
' ================================================
' == [APPLICATION] ====================================
If InStr(strGroup, lcase(userGroup4)) Then
set oShellLink = WshShell.CreateShortcut(strDesktop & "\[APPLICATION].lnk")
oShellLink.TargetPath = "https://www.[APPLICATION]hrponline.net/index.aspx"
oShellLink.IconLocation = "C:\Windows\System32\cmmon32.exe"
oShellLink.Description = "[APPLICATION]"
oShellLink.Save
End If
' ================================================
' == Intranet ====================================
If InStr(strGroup, lcase(userGroup5)) Then
set oShellLink = WshShell.CreateShortcut(strDesktop & "\Intranet.lnk")
oShellLink.TargetPath = "http://192.168.77.23"
oShellLink.IconLocation = "C:\Program Files\Internet Explorer\iexplore.exe"
oShellLink.Description = "Intranet"
oShellLink.Save
End If
' ================================================
' == [APPLICATION] ====================================
If InStr(strGroup, lcase(userGroup2)) Then
set oShellLink = WshShell.CreateShortcut(strDesktop & "\[APPLICATION].lnk")
oShellLink.TargetPath = "C:\[FOLDER]\ARES.rdp"
oShellLink.IconLocation = "mstsc.exe"
oShellLink.Description = "[APPLICATION]"
oShellLink.Save
End If
' ================================================
' ***** Changes the desktop background file for BGInfo. *****
WshShell.Run "C:\[FOLDER]\Rename.bat"
' ***** Runs the BGInfo application to set the desktop background and display the BG information. *****
' BGInfo
' ***** Logon Script Complete. Send Completion message and close script *****
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (" ")
ShowStat (UserString & ", your logon script is now complete and Windows is loading up. Have a nice day!")
ShowStat (" ")
ShowStat ("I am checking for, and creating your personal Desktop Shortcuts. Give me a few seconds, please...")
ShowStat (" ")
ShowStat ("I am copying any Updated Files from the Server. Please wait a moment....")
ShowStat (" ")
ShowStat ("Logon script running. This may take me a few moments. Meanwhile, please be mesmerised by the snazzy little picture above! Oooh! Shiny!")
objExplorer.Document.Body.Style.Cursor = "default"
My.Computer.FileSystem.RenameFile "C:\[FOLDER]\Backgrounds\acornpark.bmp", "C:\[FOLDER]\bg.bmp"
End Sub
'==========================================================================================================================================================================
'=================================================================== END OF LOGIN SCRIPT ===================================================================================
'-------------------- Functions --------------------------
'------------------- SLEEP -----------------------------
Sub sleep (Timesec)
Set objwsh = CreateObject("WScript.Shell")
objwsh.Run "Timeout /T " & Timesec & " /nobreak" ,0 ,true
Set objwsh = Nothing
End Sub
' example to wait for 3 seconds:
'sleep 3
'------------------- BGINFO -----------------------------
Sub BGInfo
Set objShell = CreateObject("Wscript.Shell")
objShell.Run "C:\[FOLDER]\bginfo.exe C:\[FOLDER]\wst.bgi /accepteula /timer:0"
End Sub
'----------------------- Close Window---------------------------
Sub CloseSelf
window.close
End Sub
Sub Hold
document.all.lock.checked = True
window.clearInterval(iTimerID)
countdown.Style.Display = "none"
btn_close.Style.Display = "inline"
End Sub
'------------------ Count --------------------------
Sub Count
'Bring script to front.
window.focus()
If intSeconds <> 0 Then
countdown.InnerHTML = intSeconds
intSeconds = intSeconds - 1
Else
If Not document.all.lock.checked Then
CloseSelf
End If
End If
End Sub
'----------------------------- Get Groups --------------------
Function GetGroups(sUDN)
On Error Resume Next
'Function to return user's Group Memberships
Set objUser2 = GetObject("LDAP://" & sDN & "/" & sUDN)
If objUser2.primaryGroupID = 513 Then
sList = sList & "Domain Users" & VbCrLf
Else
If objUser2.primaryGroupID = 512 Then
sList = sList & "Domain Admins" & VbCrLf
End If
End If
oMemberOf = objUser2.GetEx("memberOf")
For Each oGroup In oMemberOf
oGroup = Mid(oGroup, 4, 330)
arrGroup = Split(oGroup, ",")
sList = sList & arrGroup(0) & VbCrLf
Next
Set objUser2 = Nothing
GetGroups = sList
End Function
'------------------------ Show Status Message (write to window) ----------------
Function ShowStat(sMessage)
sStatus = sMessage & VbCrLf & sStatus
document.all.status.InnerText = sStatus
End Function
'============================================== END OF FUNCTIONS! ==========================================
</script>
<body id="mainbody" bgcolor="white" style="font:Verdana; color:black" onclick="hold">
<table width="100%" border="0" cellpadding="0">
<tr valign="center">
<td align="center" width="30%">
<img name="Logo">
</td>
<td align="center" width="70%">
<font size="3" f[FOLDER]="arial">Welcome <strong><span style="color:blue" id="DisplayName"></span></strong> <br><font size="2">to the</font><br><B><font color="blue">[FOLDER] Domain</B></font><br>
<font f[FOLDER]="arial" size="3">Logon Name: <B><span style="color:blue" id="UserName"></span><BR></B>Computer Name: <B><span style="color:blue" id="ComputerName"></span></B>
</td>
</tr>
<tr>
<td>
</td>
</tr>
</table>
<table width="100%" border="0" cellpadding="0">
<tr align="left">
<td>
<textarea rows="15" name="status" cols="73" style="font-family: Verdana; font-weight:bold; font-size: 8pt"></textarea>
</td>
</tr>
<hr color="red">
</table>
<table width="100%" border="0" cellpadding="0">
<tr valign="top">
<td align="left" width="50%">
<font size="2.25"> </font><input type="checkbox" name="lock">
</td>
<td align="right" width="50%">
<span id="countdown"></span><input type="button" name="btn_close" style="display:none" value="Close" onclick="CloseSelf">
</td>
</tr>
</table>
</body>
Premium Content
You need an Expert Office subscription to comment.Start Free Trial