login script generator

Batch, ASP, JScript, Kixtart, etc.
Forum rules
Do not post any licensing information in this forum.

Any code longer than three lines should be added as code using the 'Select Code' dropdown menu or attached as a file.
This topic is 15 years and 3 months old and has exceeded the time allowed for comments. Please begin a new topic or use the search feature to find a similar but newer topic.
Locked
User avatar
huittdp
Posts: 7
Last visit: Mon Jan 23, 2017 2:19 pm

login script generator

Post by huittdp »

when i run the login script generator it locates every group in the enterprise, is there any code i can insert so that all i see is the groups in my OU?
User avatar
jhicks
Posts: 1789
Last visit: Mon Oct 19, 2015 9:21 am

login script generator

Post by jhicks »

It would take a bit of work to modify the HTA to let you select an OU say from a drop down list. However, if you know that you always want groups from a specific OU, open the HTA in a scripting editor (or Notepad) and find this line:

Code: Select all

strQuery="Select sAMAccountname,cn,distinguishedname,GroupType from '" & _
myDomain.AdsPath & "' Where objectCategory='Group' AND objectclass='Group' " &_
"AND (GroupType=' " & GLOBAL_SECURITY_GROUP & "' OR GroupType=' " &_
UNIVERSAL_SECURITY_GROUP & "')" 
t should be around line 414. Replace mydomain.ADSPath with the distinguishedname of your OU. For example, suppose I want to find groups in the Employees OU in the Mycompany.com domain. The new line would look like this:

Code: Select all

strQuery="Select sAMAccountname,cn,distinguishedname,GroupType from 'OU=employees,DC=mycompany,DC=com' Where objectCategory='Group' AND objectclass='Group' " &_
"AND (GroupType=' " & GLOBAL_SECURITY_GROUP & "' OR GroupType=' " &_
UNIVERSAL_SECURITY_GROUP & "')" 
Be sure to make a backup copy of the HTA before you do any editing.
User avatar
huittdp
Posts: 7
Last visit: Mon Jan 23, 2017 2:19 pm

login script generator

Post by huittdp »

strQuery="Select sAMAccountname,cn,distinguishedname,GroupType from OU=Groups,OU=Gulf CHD,DC=doh,DC=ad,DC=state,DC=fl,DC=us Where objectCategory='Group' AND objectclass='Group' " &_"AND (GroupType=' " & GLOBAL_SECURITY_GROUP & "' OR GroupType=' " &_UNIVERSAL_SECURITY_GROUP & "')"


Is this what you were talking about? if so, i tried it and i got an error telling me that if I continued IE would run slower.
I am very new when it comes to HTA.
User avatar
jhicks
Posts: 1789
Last visit: Mon Oct 19, 2015 9:21 am

login script generator

Post by jhicks »

The msg is because you have an error. Put single quote marks around your OU 'OU=Groups,OU=Gulf CHD,DC=doh,DC=ad,DC=state,DC=fl,DC=us'
User avatar
huittdp
Posts: 7
Last visit: Mon Jan 23, 2017 2:19 pm

login script generator

Post by huittdp »

This is the whole thing. I am still getting the error about IE running slow.
I can't tell you how much I appreciate all the help.
The origional ran good except it gave me the whole enterprise and the Florida Department of Health is a BIG enterprise.

Thank you very much and Happy Holidays<html>
<!-- Logon Script Generator 1.4
This HTA is designed in the "scriptomatic" approach with the goalof rapidly producing VBScript code with minimal scripting. The function of most logon scripts is to map network resources such as file shares and printer, often based on group membership. This tool simplifies that process.
The HTA requires two text files, drives.txt and printers.txt Sample versions are included. You will need to modify them for your environment. Drives.txt should contain the UNC path of all the file shares that you might want to map in a logon script. You can use %username% as part of a drive mapping UNC. Printers.txt is the list of network printer shares you might want to map.
By default the tool will look for the files in the same directory asthis HTA. However you can select alternate files. Click the Showconfig button and then Get File. Last settings used are stored inHKCUSoftwareSAPIEN Technologies, Inc.LogonScriptGenerator.
When you start the HTA, these files are read into drop down lists. For drive mappings, select the drive letter and UNC from the drop down lists. If you want the drive mapping to happen on the basis of group membership, you can select a group from the dropdown list. This list is populated on startup by using the LDAP ADSI provider to query Active Directory for all security-enabled groups. If you don't want to use group membership, don't select any group or use Domain Users. Use the Add Drive button to add the selection to your script. Repeat for as many drive selections as you would like.
Follow the same process with network printers. Check "make default" if you want a specific printer set as default. If you check this box on more than one printer, the last one you checked will probably be set as default. You shouldn't have to use the legacy add printer section unless you have applications that require a printer mapped to a port like LPT1.
The script has the option to display a summary popup with a variety of information. You also display a short message. You can display how old the user's password is. You can display a summary of mapped printers and drives. The message will display for 10 seconds by default but you can change that. Setting the timeout to -1 will force the user to click OK otherwise it will automatically close after the specified number of seconds.
During drive and printer mappings, you can elect to display an error message should there be a failure or error. In addition to specific error information, you can also include a brief message such as directions to call the help desk.
If you have the need to run additional scripts or command line tools, you can enter them in the Additional Commands section. Put each command on it's own line. These will be run with the Exec method synchronously.
The Script Comments section is for the header of your script. You can enter additional comments if you'd like.
Click the Create Script button to preview the code or Clear Selections if you want to start again. There is no way to see what you've already added until you click Create Script. This will display the final script and hide the configuration elements.
After the script is saved you can open it in a script editor for furtherrevision. If you have Primal Script 4.1, it will be detected and the scriptwill open with Primal Script. Otherwise it will open in Notepad. This HTAis not an editing tool, just a code creator.
If you want to start completely over after viewing the produced code, you can click Reset button. You can edit directly in the HTA to tweak the code. When ready, click the Save File button and save your vbs script. You should test it thoroughly before rolling it out into production.
There is popup help for most elements if you hover your mouse over them.
If necessary for troubleshooting, you can turn on the tracing debug featureUnder Config. This will launch a separate Internet Explorer Window for tracemessages. If you check this box, the tool will refresh and any logon scriptsettings you have made will be lost, so do this first if you are debugging.
Use the Quit button to close the tool when you are finished. This will properly clean up any temporary elements and update the registry properly.This is especially important if you turn debug tracing on.
Requirements:Windows XP Professional computer that belongs to an Active Directory domain.
Change History:v1.4 November 27, 2006 Modified registry path for saving values Added functionality to turn on/turn off debugging from the config Fixed popup helpv1.3 November 21, 2006 Added functionality to configure location of drives.txt and printers.txt Added functionality to load welcome message from a text file. Added functionality to load Error message from a text file. Added functionality to edit saved script in PrimalScript 4.1 if it is installed otherwise you can open it in Notepad.v1.2 November 20, 2006 Added debug functionalityv1.1 October 6, 2006 Corrected errors when specifying a path like file01%username%$ Corrected errors if %username% was not in lower case. Now any case will work.v1.0 April 13, 2006 Original Release
**************************************************************** * DO NOT USE IN A PRODUCTION ENVIRONMENT UNTIL YOU HAVE * * TESTED IN A SECURED LAB ENVIRONMENT. USE AT YOUR OWN RISK. * * ****************************************************************
-->
<head>
<title>SAPIEN Logon Script Generator</title><hta:application ID="LogonScriptGen" border="thick" borderstyle="normal" caption="yes" contextmenu="false" icon="sapien.ico" maximizebutton="false" minimizebutton="true" navigable="false" scroll="true" selection="false" showintaskbar="true" singleinstance="true" sysmenu="true" version="1.4" windowstate="normal">
<style>body { font-family:Tahoma; color=Blue; background=#CCCCFF;}
button {font-family:Tahoma; font-size:8pt;}input {font-family:Tahoma; font-size:8pt;}</style>
<script language="VBScript">Dim objNetworkDim objFSO,objFileDim oIE
Const FORREADING=1Const FORWRITING=2Const PrimalScriptPath="HKLMSOFTWARESAPIEN Technologies, Inc.PrimalScript4.1"Const HKCUPath="HKCUSoftwareSAPIEN Technologies, Inc.LogonScriptGenerator"
'Check registry for last debug valuestrMRUDebug=ReadMRU("Debug")If strMRUDebug="" Then blnDebug=FalseElse blnDebug=TrueEnd If
'Check registry for previous source filesstrMRUDriveSource=ReadMRU("DriveSource")Trace "strMRUDriveSource=" & strMRUDriveSourcestrMRUPrinterSource=ReadMRU("PrinterSource")Trace "strMRUPrinterSource=" & strMRUPrinterSource'define source files. The default location is same directory as the HTA.
If strMRUDriveSource="" Then strDriveSource=CurrentDir() & "drives.txt"Else strDriveSource=strMRUDriveSourceEnd If
Trace "strDriveSource=" & strMRUDriveSource
If strMRUPrinterSource="" Then strPrinterSource=CurrentDir() & "printers.txt"Else strPrinterSource=strMRUPrinterSourceEnd ifTrace "strPrintersource=" & strMRUPrinterSource
Set objNetwork=CreateObject("WScript.Network")Set objFSO=CreateObject("Scripting.FileSystemObject")
'define some default values for text boxes'default error messagestrDefaultErrorMessage="Contact the Help Desk for further assistance."
'default commentstrDefaultComments="'Created: " & Now & VbCrLfstrDefaultComments=strDefaultComments & "'Author: " & objNetwork.UserDomain &_ "" & objNetwork.UserName & VbCrLfstrDefaultComments=strDefaultComments & "'Created by SAPIEN" &_" Technologies, Inc. Logon Script Generator" & VbCrLfstrDefaultComments=strDefaultComments & "'**********************" & VbCrLf
strDefaultWelcome="This is a secure network. Authorized Access Only."
'define script snippetsstrDIM="Dim objFSO,objFILE,objShell,objNetwork"strObjects="set objFSO=CreateObject(""Scripting.FileSystemObject"")" & vbcrlfstrObjects=strObjects & "set objShell=CreateObject(""Wscript.Shell"")" & VbCrLfstrObjects=strObjects & "set objNetwork=CreateObject(""Wscript.Network"")" & VbCrLf
Function CurrentDir()On Error Resume Next strHTALocation=window.location strPath=Left(strHTALocation,InStrRev(strHTALocation,"/")) strPath=Replace(strPath,"file:///","") strPath=Replace(strPath,"/","") strPath=Replace(strPath,"%20"," ") Trace "Current Directory is " & strPath CurrentDir=strPathEnd Function
Sub Window_OnLoad()On Error Resume Nextwindow.resizeTo 600,500Trace "Loading HTA"Trace "User " & objNetwork.UserDomain & "" & objNetwork.UserNameTrace "Computer " & objNetwork.ComputerNameTrace GetOS()
'hide sections while populatingdivShowScript.style.display="none"divMain.Style.display="none"divSnippets.Style.display="none"divConfig.style.display="none"divFilename.style.display="none"
'display status messagestatusReport.Innerhtml="<font color=RED size=2>Please wait...populating drop down lists</Font>"
'force a screen refreshForceRefresh()
'populate config fieldstxtDriveSource.value=strDriveSourcetxtPrinterSource.value=strPrinterSource
'set default valuesIf blnDebug Then chkDebug.Checked=True
Call SetDefaults
'Populate drop downsTrace "Call PopulateDropDriveLetters"Call PopulateDropDriveLettersTrace "Call PopulateGroups"Call PopulateGroupsTrace "Call PopulateDrives"Call PopulateDrivesTrace "Call PopulatePrinters"Call PopulatePrinters
'hide status messagestatusReport.innerhtml=""
'display main sectiondivMain.Style.Display="inline"Trace "Finished populating form"end Sub
Sub SetDefaults()On Error Resume NextTrace "SetDefaults()"txtPrinterPortMappings.Value=""txtDriveMappings.value=""txtPrinterMappings.value=""txtAdditionalCommands.value=""
'set default valuestxtComments.value=strDefaultCommentstxtErrorMessage.value=strDefaultErrorMessagetxtWelcomeMessage.value=strDefaultWelcometxtDisplayTimeout.value="10"txtErrorTimeout.value="10"
Trace txtComments.valueTrace txtErrorMessage.valueTrace txtWelcomeMessage.valueTrace txtDisplayTimeout.valueTrace txtErrorTimeout.value
'clear check boxeschkShowPassword.Checked=FalsechkDisplayWelcome.Checked=FalsechkShowDriveSummary.Checked=FalsechkShowPrinterSummary.Checked=FalsechkMakeDefault.Checked=FalsechkMakeDefault2.Checked=FalsechkShowErrorMessages.Checked=False
Trace chkShowPassword.CheckedTrace chkDisplayWelcome.CheckedTrace chkShowDriveSummary.CheckedTrace chkShowPrinterSummary.CheckedTrace chkMakeDefault.CheckedTrace chkMakeDefault2.CheckedTrace chkShowErrorMessages.Checked
End Sub
Sub PopulateDropDriveLettersOn Error Resume NextTrace "PopulateDropDriveLetters()"tmpArray=Split("d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z",",")For d = 0 To UBound(tmpArray) strDriveLetter=UCase(tmpArray(d)) & ":" Trace "Adding " & strDriveLetter PopulateDropDown "dropDrive",strDriveLetter,strDriveLetterNext
End Sub
Sub PopulateDrives()On Error Resume NextTrace "PopulateDrives()"strDriveSource=txtDriveSource.value'clear any existing entriesCall ClearDropDown("dropDriveUNC")PopulateDropDown "dropDriveUNC","NONE","NONE"
If objFSO.FileExists(strDriveSource) ThenTrace strDriveSource & " exists" Set objFile=objFSO.OpenTextFile(strDriveSource,FORREADING) Do While objFile.AtEndOfStream<>True strDrive=objFile.ReadLine Trace "Calling PopulateDropDown dropDriveUNC," & strDrive PopulateDropDown "dropDriveUNC",strDrive,strDrive Loop objFile.Close Trace "Updating registry" SetMRU "DriveSource",strDriveSourceElse'source file not found MsgBox strDriveSource & " not found",vbOKOnly+vbCritical,"Populate Drive Mappings" Trace strDriveSource & " not found" txtDriveSource.value="" btnConfig_OnClick()End IfEnd Sub
Sub PopulatePrinters()On Error Resume NextTrace "PopulatePrinters()"strPrinterSource=txtPrinterSource.Value
'clear any existing entriesCall ClearDropDown("dropPrinterUNC")Call ClearDropDown("dropPrinters")PopulateDropDown "dropPrinterUNC","NONE","NONE"PopulateDropDown "dropPrinters","NONE","NONE"
If objFSO.FileExists(strPrinterSource) ThenTrace strDriveSource & " exists" Set objFile=objFSO.OpenTextFile(strPrinterSource,FORREADING) Do While objFile.AtEndOfStream<>True strPrinter=objFile.ReadLine Trace "Calling PopulateDropDown dropPrinterUNC" & "," & strPrinter & "," & strPrinter PopulateDropDown "dropPrinterUNC",strPrinter,strPrinter Trace "Calling PopulateDropDown dropPrinters" & "," & strPrinter & "," & strPrinter PopulateDropDown "dropPrinters",strPrinter,strPrinter Loop objFile.Close Trace "Updating registry" SetMRU "PrinterSource",strPrinterSourceElse'source file not found MsgBox strPrinterSource & " not found",vbOKOnly+vbCritical,"Populate Printer Mappings" Trace strPrinterSource & " not found" txtPrinterSource.Value="" btnConfig_OnClick()End IfEnd Sub
Sub PopulateGroups()On Error Resume NextTrace "PopulateGroups()"Dim objConnection,objCmd,objRS
Const ADS_GROUP_TYPE_GLOBAL_GROUP = &h00000002Const ADS_GROUP_TYPE_DOMAIN_LOCAL_GROUP = &h00000004Const ADS_GROUP_TYPE_LOCAL_GROUP = &h00000004Const ADS_GROUP_TYPE_UNIVERSAL_GROUP = &h00000008Const ADS_GROUP_TYPE_SECURITY_ENABLED = &h80000000GLOBAL_SECURITY_GROUP = ADS_GROUP_TYPE_GLOBAL_GROUP Or ADS_GROUP_TYPE_SECURITY_ENABLEDUNIVERSAL_SECURITY_GROUP=ADS_GROUP_TYPE_UNIVERSAL_GROUP or ADS_GROUP_TYPE_SECURITY_ENABLED
Set objConnection=CreateObject("ADODB.Connection")Set objCmd=CreateObject("ADODB.Command")
Set RootDSE=GetObject("LDAP://RootDSE")
If Err.Number<>0 Then strMsg="This computer does not appear to belong " &_ "to an Active Directory domain." & VbCrLf & "No groups can be discovered." MsgBox strMsg,vbOKOnly+vbExclamation,"Domain Membership Required" Trace "This computer does not appear to belong to an Active Directory domain." Exit SubEnd If
Set myDomain=GetObject("LDAP://"&RootDSE.get("DefaultNamingContext"))strQuery="Select sAMAccountname,cn,distinguishedname,GroupType from 'OU=Groups,OU=Gulf CHD,DC=doh,DC=ad,DC=state,DC=fl,DC=us' Where objectCategory='Group' AND objectclass='Group' " &_"AND (GroupType=' " & GLOBAL_SECURITY_GROUP & "' OR GroupType=' " &_UNIVERSAL_SECURITY_GROUP & "')"

Trace strQuery
set objCatalog=GetObject("GC:")for each obj In objCatalog set GC=objNext
objConnection.Provider="ADSDSOObject"objConnection.Open "Active Directory Provider"objCmd.ActiveConnection=objConnectionobjCmd.Properties("Page Size") = 100objCmd.Properties("asynchronous")=TrueobjCmd.Properties("Timeout") =30objCmd.Properties("Cache Results") = FalseobjCmd.CommandText=strQuery
Trace "Executing query"set objRS=objCmd.Execute
do while not objRS.EOFTrace "Adding " & objRS.fields("sAMAccountname") & " To drop down lists" PopulateDropDown "dropDriveGroup", objRS.fields("sAMAccountname"), objRS.fields("sAMAccountname") PopulateDropDown "dropPrinterGroup", objRS.fields("sAMAccountname"), objRS.fields("sAMAccountname") PopulateDropDown "dropPrinterPortGroup", objRS.fields("sAMAccountname"), objRS.fields("sAMAccountname") objRS.movenextLoopobjRS.CloseobjConnection.Close
'Use this code for testing against local machine or an NT domain instead of the'regular subroutine code'Dim objDomain'Set objDomain=GetObject("WinNT://" & objNetwork.UserDomain)'objDomain.Filter=Array("group")'For Each group In objDomain' PopulateDropDown "dropDriveGroup",group.name,group.name' PopulateDropDown "dropPrinterGroup",group.name,group.name' PopulateDropDown "dropPrinterPortGroup",group.name,group.name'NextTrace "Finished enumerating groups"End Sub
Function PopulateDropDown(strDropDown,strText,strValue)On Error resume NextTrace "PopulateDropDown"set objDrop=document.createElement("OPTION")objDrop.Text=strTextobjDrop.Value=strValuedocument.all.item(strDropDown).Add(objDrop)
end Function
Function ClearDropDown(strDropdown)On Error Resume NextTrace "ClearDropDown"For i=0 to document.all.item(strDropDown).Options.Length-1 document.all.item(strDropDown).Remove(0)Next
End Function
Sub btnAddDrive_Onclick()On Error Resume NextTrace "btnAddDrive_Onclick()"'don't Do anything If no drive selectedIf dropDriveUNC.Value="NONE" Then Exit Sub
If txtDriveMappings.Value="" Then txtDriveMappings.value= dropDrive.Value & "|" & dropDriveUNC.Value &_ "|" & dropDriveGroup.ValueElse txtDriveMappings.value=txtDriveMappings.Value & "||" &_ dropDrive.Value & "|" & dropDriveUNC.Value & "|" & dropDriveGroup.ValueEnd If
'resetTrace "resetting drive values"dropDriveGroup.value="Any Group"dropDriveUNC.value="NONE"dropDrive.Value="D:"End Sub
Sub btnAddPrinterPort_Onclick()On Error Resume NextTrace "btnAddPrinterPort_Onclick()"'don't Do anything If no printer selectedIf dropPrinterUNC.Value="NONE" Then Exit Sub
If txtPrinterPortMappings.Value="" Then txtPrinterPortMappings.value= dropPort.Value & "|" & dropPrinterUNC.Value &_ "|" & dropPrinterPortGroup.Value & "|" & chkMakeDefault.CheckedElse txtPrinterPortMappings.value=txtPrinterPortMappings.Value & "||" &_ dropPort.Value & "|" & dropPrinterUNC.Value & "|" &_ dropPrinterPortGroup.Value& "|" & chkMakeDefault.CheckedEnd If
'resetTrace "Resetting printer values"dropPort.Value="LPT1:"dropPrinterUNC.Value="NONE"dropPrinterPortGroup.Value="Any Group"chkMakeDefault.Checked=False
End Sub
Sub btnAddPrinter_Onclick()On Error Resume NextTrace "btnAddPrinter_Onclick()"
'don't Do anything If no printer selectedIf dropPrinters.Value="NONE" Then Exit Sub
If txtPrinterMappings.Value="" Then txtPrinterMappings.value= dropPrinters.Value &_ "|" & dropPrinterGroup.Value & "|" & chkMakeDefault2.CheckedElse txtPrinterMappings.value=txtPrinterMappings.Value & "||" &_ dropPrinters.Value & "|" &_ dropPrinterGroup.Value & "|" & chkMakeDefault2.CheckedEnd If
'resetTrace "Resetting printer values"dropPrinters.Value="NONE"dropPrinterGroup.Value="Any Group"chkMakeDefault2.Checked=False
End Sub
Sub btnGenerate_Onclick()On Error Resume NextTrace "btnGenerate_Onclick()"'Add comment headerstrScript=txtComments.Value & VbCrLf'add DIM and ObjectsstrScript=strScript & "On Error Resume Next" & VbCrLfstrScript=strScript & strDIM & VbCrLfstrScript=strScript & strObjects & VbCrLfTrace "Script head"Trace strScript
'define variables'REPLACE LINE BREAKS IN TEXT AREA WITH VBCRLF AND ""strWelcomeMessageValue=Trim(txtWelcomeMessage.value)strWelcomeMessageValue=Replace(strWelcomeMessageValue,VbCrLf,Chr(34) & " & VbCrLf & " & Chr(34))
Trace "strWelcomeMessageValue=" & strWelcomeMessageValue
If chkDisplayWelcome.Checked Then strScript=strScript &_ "strWelcomeMsg=" & Chr(34) & strWelcomeMessageValue & Chr(34) & VbCrLf 'REPLACE LINE BREAKS IN TEXT AREA WITH VBCRLF AND ""strErrorMessageValue=Trim(txtErrorMessage.value)strErrorMessageValue=Replace(strErrorMessageValue,VbCrLf,Chr(34) & " & VbCrLf & " & Chr(34))Trace "strErrorMessageValue=" & strErrorMessageValueIf chkShowErrorMessages.Checked Then strScript=strScript & "strHelpMsg=" & Chr(34) & strErrorMessageValue & Chr(34)& VbCrLf strScript=strScript & "iErrorTimeout=" & txtErrorTimeOut.value & VbCrLf strScript=strScript & "blnShowError=" & chkShowErrorMessages.checked & VbCrLfEnd If
strScript=strScript & VbCrLf
'Map network drivesIf txtDriveMappings.Value<>"" Then strScript=strScript & "'Map network drives" & VbCrLf 'get drive information from hidden text field tmpInfo=txtDriveMappings.Value arrInfo=Split(tmpInfo,"||") For a=0 To Ubound(arrInfo) strMapData=arrInfo(a) 'split out drive, UNC and Group arrData=Split(strMapData,"|") strDrive=Chr(34) & arrData(0) & Chr(34) strMap=Chr(34) & arrData(1) & Chr(34) 'replace %username% with objNetwork.UserName if in mapping UNC If InStr(Ucase(strMap),"%USERNAME%") Then strMap=Replace(UCase(strMap),"%USERNAME%",Chr(34) & " & objNetwork.Username & " & Chr(34)) End If strGroup=Chr(34) &arrData(2) & Chr(34) If InStr(strGroup,"Any Group") Then strScript=strScript & "MapIt " & strDrive &_ "," & strMap & VbCrLf Else strScript=strScript &_ "If IsAMemberOf(objNetwork.UserDomain,objNetwork.UserName," &_ strGroup & ") Then MapIt " & strDrive & "," & strMap & vbcrlf End If NextstrScript=strScript & VbCrLf
End If
'Map printersIf txtPrinterPortMappings.Value<>"" OR txtPrinterMappings.Value<>"" Then strScript=strScript & "'Map printers"& VbCrLf 'get printer port assignments from hidden text field tmpInfo=txtPrinterPortMappings.Value arrInfo=Split(tmpInfo,"||") For a=0 To Ubound(arrInfo) strMapData=arrInfo(a) 'split out drive, UNC and Group arrData=Split(strMapData,"|") strPort=Chr(34) & arrData(0) & Chr(34) strMap=Chr(34) & arrData(1) & Chr(34) strGroup=Chr(34) &arrData(2) & Chr(34) strDefault=arrData(3) If InStr(strGroup,"Any Group") Then strScript=strScript & "AddPrinterPortConnection " & strPort &_ "," & strMap & VbCrLf If strDefault Then strScript=strScript & "objNetwork.SetDefaultPrinter " & strMap & VbCrLf End If Else strScript=strScript &_ "If IsAMemberOf(objNetwork.UserDomain,objNetwork.UserName," &_ strGroup & ") Then AddPrinterPortConnection " & strPort & "," & strMap & VbCrLf If strDefault Then strScript=strScript & "objNetwork.SetDefaultPrinter " & strMap & VbCrLf End If End If Next 'get printer assignments from hidden text field tmpInfo=txtPrinterMappings.Value arrInfo=Split(tmpInfo,"||") For a=0 To Ubound(arrInfo) strMapData=arrInfo(a) 'split out drive, UNC and Group arrData=Split(strMapData,"|") strMap=Chr(34) & arrData(0) & Chr(34) strGroup=Chr(34) &arrData(1) & Chr(34) strDefault=arrData(2) If InStr(strGroup,"Any Group") Then strScript=strScript & " AddPrinterConnection " & strMap & VbCrLf If strDefault Then strScript=strScript & "objNetwork.SetDefaultPrinter " & strMap & VbCrLf End If Else strScript=strScript &_ "If IsAMemberOf(objNetwork.UserDomain,objNetwork.UserName," &_ strGroup & ") Then AddPrinterConnection " & strMap & VbCrLf If strDefault Then strScript=strScript & "objNetwork.SetDefaultPrinter " & strMap & VbCrLf End If End If NextstrScript=strScript & VbCrLfEnd If
'add additional commandsIf txtAdditionalCommands.Value<>"" ThenstrScript=strScript & "'additional commands, if any" & VbCrLf
cmdArray=Split(txtAdditionalCommands.Value,vbcrlf) For c=0 To UBound(cmdArray) If cmdArray(c)<>"" Then strScript=strScript &_ "objShell.Exec " & Chr(34) & cmdArray(c) & Chr(34) & VbCrLf nextEnd IfstrScript=strScript & VbCrLf
'build summary messageIf chkDisplayWelcome.Checked Or chkShowPassword.Checked Or chkShowDriveSummary.Checked Or chkShowPrinterSummary.Checked Then strScript=strScript & "'build summary message"& VbCrLf strScript=strScript & "iDisplayTimeout=" & txtDisplayTimeOut.value & VbCrLf strScript=strScript & "strMsg=" & Chr(34) & Chr(34) & VbCrLf If chkDisplayWelcome.checked Then strScript=strScript &_ "strMsg=strMsg & strWelcomeMsg & VbCrLf" & VbCrLf strScript=strScript & "strMsg=strMsg & vbcrlf" & VbCrLf If chkShowPassword.Checked Then strScript=strScript &_ "strMsg=strMsg & PasswordExpires(objNetwork.Userdomain,objNetwork.Username) & VbCrLf" & VbCrLf strScript=strScript & "strMsg=strMsg & vbcrlf" & VbCrLf If chkShowDriveSummary.checked Then strScript=strScript & "'enumerate drives" & VbCrLf strScript=strScript & "Set objDrives = objNetwork.EnumNetworkDrives" & VbCrLf strScript=strScript & "strMsg=strMsg & " & Chr(34) & "Network drive mappings:" & Chr(34) & " & vbcrlf" & vbcrlf strScript=strScript & "For i = 0 to objDrives.Count - 1 Step 2" & VbCrLf strScript=strScript & " strMsg=strMsg & " & Chr(34) & "Drive " & Chr(34) &_ " & objDrives.Item(i) & " & Chr(34) & "=" & Chr(34) & " & objDrives.Item(i+1) & vbcrlf " & VbCrLf strScript=strScript & "Next" & VbCrLf strScript=strScript & "strMsg=strMsg & vbcrlf" & VbCrLf strScript=strScript & VbCrLf End If If chkShowPrinterSummary.checked Then strScript=strScript & "'enumerate printers" & VbCrLf strScript=strScript & "Set objPrinters = objNetwork.EnumPrinterConnections" & VbCrLf strScript=strScript & "strMsg=strMsg & vbcrlf &" & Chr(34) & "Printer mappings:" & Chr(34) & " & vbcrlf" & VbCrLf strScript=strScript & "For i = 0 to objPrinters.Count - 1 Step 2" & VbCrLf strScript=strScript & " strMsg=strMsg & objPrinters.Item(i) &" & Chr(34) &_ " = " & Chr(34) & "& objPrinters.Item(i+1) & vbcrlf" & VbCrLf strScript=strScript & "Next" & VbCrLf strScript=strScript & "strMsg=strMsg & vbcrlf" & VbCrLf strScript=strScript & VbCrLf End If 'display summary message strScript=strScript & "'display summary message"& VbCrLf strScript=strScript & "If strMsg<>" & Chr(34) & Chr(34) &_ " Then objShell.Popup strMsg,iDisplayTimeout," & CHR(34) & "Logon Summary" & Chr(34) & ",vbOKOnly+vbInformation"End If
strScript=strScript & VbCrLfstrScript=strScript & "'End of main script"strScript=strScript & VbCrLf & VbCrLf
'add routinesstrScript=strScript & "'" & String(50,"/") & VbCrLfstrScript=strScript & txtArea_Routines.value & VbCrLf
txtViewScript.Value=strScript
'hide creation sectiondivMain.style.display="none"
'display scriptdivShowScript.Style.display="inline"'set focus on scripttxtViewScript.FocusTrace "Final Script"Trace strScriptEnd Sub
Sub btnSaveFile_Onclick()On Error Resume NextTrace "btnSaveFile_Onclick()"Dim objDialogSet objDialog=CreateObject("SAFRCFileDlg.FileSave")objDialog.FileType="vbs"objDialog.filename="logon.vbs"objDialog.OpenFileSaveDlgstrFileName=objDialog.FileNameTrace "Saving to " & strFileNameIf strFileName="" Then Exit Sub
Set objFile=objFSO.CreateTextFile(strFileName,True)objFile.Write txtViewScript.valueobjFile.ClosestrMsg="<Font size=2>Saved as " & strFileName & "</font>"divFileName.insertAdjacentHTML "BeforeBegin",strMsg
'write saved filename to a hidden field so it can be used'when editing the filetxtSaveAs.Value=strFileName'find if PrimalScript 4.1 is not installed On Error Resume NextDim objShellSet objShell=CreateObject("WScript.Shell")strPSPath=objShell.RegRead(PrimalScriptPath)If strPSPath<>"" Then'adjust the button text btnEditScript.value="Edit with PrimalScript 4.1"End If
divFilename.style.display="inline"btnSaveFile.style.display="none"End Sub
Function ForceRefresh()Set oShell = CreateObject("WScript.Shell")oShell.Run "cmd /c", 0, True
End Function
Sub About()On Error Resume NextTrace "About()"strMsg="Logon Script Generator v."& LogonScriptGen.version & VbCrLfstrMsg=strMsg & "copyright 2006" & VbCrLfstrMsg=strMsg & "SAPIEN Technologies, Inc"MsgBox strMsg,vbOKOnly+vbInformation,"About"
End Sub
Sub Trace(strMsg)'The following sub can be left at the bottom of your script'Use Trace "Message goes here" to add a debug message
On Error Resume NextIf blnDebug=False Then Exit Sub
If Not IsObject(oIE) Then Set oIE = CreateObject("InternetExplorer.Application") oIE.navigate "about:blank" oIE.ToolBar = False oIE.AddressBar = False oIE.Top = 10 oIE.Left = 10 oIE.Width = 600 oIE.Height = 600 oIE.Visible = True oIE.menubar = False oIE.StatusBar = False oIE.Document.Body.Title = "Debug Messages"End If oIE.Document.writeln "<font face=Verdana size=2>" &_ Now & " - " & strMsg & "<br>"End Sub
'**********************************'* Get OS Caption via WMI *'**********************************Function GetOS()'returns values like:'Microsoft Windows XP Professional
On Error Resume NextDim objWMITrace "GetOS()"Set objWMI=GetObject("winmgmts://.rootcimv2").InstancesOf("win32_operatingsystem")
For Each OS In objWMI GetOS=OS.Caption Trace "function returning " & OS.CaptionNext
End Function
'**********************************' show or hide the config section *'**********************************Function btnConfig_OnClick()On Error Resume Nextif divConfig.Style.Display="none" Then divConfig.Style.Display="inline" btnConfig.value="Hide Config"Else divConfig.Style.Display="none" btnConfig.value="Show Config"
End If
End Function
Function OpenFile()Dim objDialog'This requires Windows XP/2003 Set objDialog=CreateObject("SAFRCFileDlg.FileOpen") objDialog.OpenFileOpenDlg OpenFile=objDialog.FileNameEnd Function
Function btnOpenDrives_Onclick()On Error Resume NextTrace "Getting drive.txt source"strSource=OpenFile()txtDriveSource.Value=strSourceTrace "repopulating drop downs"'repopulate dropdownCall PopulateDrivesEnd Function
Function btnOpenPrinters_Onclick()On Error Resume NextTrace "Getting printers.txt source"strSource=OpenFile()txtPrinterSource.Value=strSourceTrace "repopulating drop downs"'repopulate drop downCall PopulatePrintersEnd Function
'**********************************'* Update Registry with last *'* used settings for source files*'**********************************Sub SetMRU(sType,sMRU)'sType is either DriveSource,PrinterSource, or Debug'sMRU is the path to the file, or TRUE/FALSE for Debug
On Error Resume NextDim objShellSet objShell=CreateObject("WScript.Shell")
strRegPath=HKCUPath & sTypeTrace "Writing " & strRegPath & "," & sMRUobjShell.RegWrite strRegPath,sMRU,"REG_SZ"
End Sub
'**********************************'* Read Registry for last *'* used settings for text file *'**********************************Function ReadMRU(sType)'sType is either DriveSource,PrinterSource,Debug
On Error Resume NextDim objShellSet objShell=CreateObject("WScript.Shell")strRegPath=HKCUPath & sTypeTrace "Reading " & strRegPathstrResult=objShell.RegRead(strRegPath)Trace "value is " & strResultReadMRU=strResult
Err.clearEnd Function
'**********************************' Load welcome message from file *'**********************************Function btnLoadWelcome_OnClick()On Error Resume NextTrace "Loading Welcome message from file"strWelcomeSource=OpenFileIf objFSO.FileExists(strWelcomeSource) ThenTrace strWelcomeSource & " exists"Set objFile=objFSO.OpenTextFile(strWelcomeSource,FORREADING)Do While objFile.AtEndOfStream<>True txtWelcomeMessage.Value=objFile.ReadAllLoopobjFile.CloseElse MsgBox strWelcomeSource & " not found",vbOKOnly+vbCritical,"Load Welcome Message" Trace strWelcomeSource & " not found"End If
End Function
'**********************************' Load error message from file *'**********************************Function btnLoadError_OnClick()On Error Resume NextTrace "Loading Error message from file"strErrorSource=OpenFileIf objFSO.FileExists(strErrorSource) ThenTrace strErrorSource & " exists"Set objFile=objFSO.OpenTextFile(strErrorSource,FORREADING)Do While objFile.AtEndOfStream<>True txtErrorMessage.Value=objFile.ReadAllLoopobjFile.CloseElse MsgBox strErrorSource & " not found",vbOKOnly+vbCritical,"Load Error Message" Trace strErrorSource & " not found"End If
End Function
'**********************************' Load saved script into an editor '**********************************
Function EditScript()On Error Resume NextTrace "Editing Script"'check if Primal Script is defined and existsOn Error Resume NextDim objShellSet objShell=CreateObject("WScript.Shell")strPSPath=objShell.RegRead(PrimalScriptPath)If objFSO.FileExists(strPSPath) ThenTrace "opening " & strPSPath & " " & txtSaveAs.value objShell.Exec strPSPath & " " & txtSaveAs.ValueElseTrace "opening Notepad " & txtSaveAs.Value objShell.Exec "Notepad " & txtSaveAs.ValueEnd If
End Function
'**********************************' Turn on/off tracing option * '**********************************Function SetTrace()On Error Resume NextIf chkDebug.Checked then 'Update registry SetMRU "Debug",TrueElse 'Update registry Dim objShell Set objShell=CreateObject("WScript.Shell") objShell.RegDelete HKCUPath & "Debug" MsgBox "You will have to manually close any open Internet Explorer trace windows.", vbOKOnly+vbInformation,"Clear Tracing"End If
window.location.reload()
End Function
Function btnQuit_OnClick()On Error Resume NextDim objShellSet objShell=CreateObject("WScript.Shell")objShell.RegDelete HKCUPath & "Debug"self.close()End Function
</script></head>
<body vlink="#CCCCFF"><table border="0"><tr><td width="500">Logon Script Generator</td><td align="right"><input type="button" id="btnConfig" value="Show Config" title="Manage configuration files"><br><input type="button" id="btnQuit" value=" Quit " title="Quit this tool"></td></tr></table><div id="divConfig"><table border="0"><tr><td><font size=2>Drives.txt </font></td><td><input type="text" id="txtDriveSource" size="40"></td><td><button id="btnOpenDrives" title="select drives.txt">Get File</td></tr><tr><td><font size=2>Printers.txt </font></td><td><input type="text" id="txtPrinterSource" size="40"></td><td><button id="btnOpenPrinters" title="select printers.txt">Get File</td></tr><tr><td colspan="2"><input type="checkbox" id="chkDebug" onChange="SetTrace()" on Title="Restart tool with debug tracing in a separate Internet Explorer window. All changes you've made so far will be lost. Click anywhere in the HTA if you change this value."><font size="2">Turn on trace debugging</font></td></tr></table></div><div id="StatusReport"> </div><div id="divMain"><!-- Map Network Drive --><font size="2">Map Network Drives</font><br> <select size="1" name="dropDrive"><!-- options generated by PopulateDropDriveLetters -->
</select> <select size="1" name="dropDriveUNC"> <option value="NONE">NONE</option> </select> <br> <font size="2"> if member of </font><font size="1"><select size="1" name="dropDriveGroup"> <option selected value="Any Group">Any Group</option> </select></font> <button name="btnAddDrive" title="Add this selection to your script">Add Drive</button><!-- Map Printers -->
<p><font size="2">Add Printers<br>
<select size="1" name="dropPrinters"> <option value="NONE">NONE</option> </select> </font><input type="checkbox" name="chkMakeDefault2" ></font><font size="2">make default</font> <br> <font size="2"> if member of </font><font size="1"><select size="1" name="dropPrinterGroup"> <option selected value="Any Group">Any Group</option> </select></font> <button name="btnAddPrinter" title="Add this selection to your script">Add Printer</button> <!-- Map Printer by Port --> <p><font size="2">Add Printer by port (this is a legacy setting for apps that require a printer port like LPT1:)</font><br> <select size="1" name="dropPort"> <option value="LPT1:">LPT1:</option> <option value="LPT2:">LPT2:</option> <option value="LPT3:">LPT3:</option> </select> <select size="1" name="dropPrinterUNC"> <option value="NONE">NONE</option> </select><input type="checkbox" name="chkMakeDefault"><font size="2">make default</font> <br> <font size="2"> if member of </font><font size="1"><select size="1" name="dropPrinterPortGroup"> <option selected value="Any Group">Any Group</option> </select></font> <button name="btnAddPrinterPort" title="Add this selection to your script">Add Printer</button>
<!-- Options --><p><fieldset ><legend>Display Options</legend><input type="checkbox" name="chkShowPassword" title="display the age of the user's password in the summary display popup"><font size="2">Show password age </font><input type="checkbox" name="chkDisplayWelcome" title="display the text of the welcome message as part of the summary display popup"><font size="2">Display Welcome Message </font><input type="checkbox" name="chkShowDriveSummary" title="display network drive mapping information as part of the summary display popup" ><font size="2">Display Mapped Drive Summary </font><input type="checkbox" name="chkShowPrinterSummary" title="display printer mapping information as part of the summary display popup"><font size="2">Display Mapped Printer Summary</font> <input type="checkbox" name="chkShowErrorMessages" title="display error message text in the event of drive/printer mapping"><font size="2">Display Error Messages</font></p></fieldset>
<!-- Welcome Message --><p><font size="3">Welcome message</font><br>
<textarea rows="3" name="txtWelcomeMessage" cols="50" title="This text will be displayed at the start of a summary message. Keep this short with lines no longer than the width of the text box for best results."></textarea> &nbsp<button id="btnLoadWelcome">Load from File</button> <br> <font size="2">Display welcome message for </font><font size="1"> <input type="text" name="txtDisplayTimeout" size="4" value="10" title="Set to -1 to force user to acknowledge."></font><font size="2"> seconds</font></p> <p>
<!-- Error Message -->
<font size="3">Error message</font><font size="1"></font><br><textarea rows="3" name="txtErrorMessage" cols="50" title="This text will be displayed as part of an error message during any drive or printer mappings. Keep this short with lines no longer than the width of the text box for best results"></textarea> &nbsp<button id="btnLoadError">Load from File</button> <br>
<br><font size="2">Display error message for </font><font size="1"><input type="text" name="txtErrorTimeout" size="4" value="10" title="Set to -1 to force user to acknowledge."></font><font size="2"> seconds</font></p>
<!-- Additional Commands -->
<font size="3">Additional Commands</font><br> <textarea rows="3" name="txtAdditionalCommands" cols="50" title="Enter additional commands and parameters. Use full paths to scripts and executables. These commands will be executed using the Exec method of the wshShell object."></textarea><br><font size="2">enter one command per line</font> <!-- Script Comments --><p> <font size="3">Script comments</font><br> <textarea rows="7" name="txtComments" cols="66" title="Add comments for the beginning of the script. Each line must begin with an apostrophe '"></textarea><p><!-- Generate Script -->
<P><button id="btnGenerate" title="Generate the final VBScript code.">Create Script</button>&nbsp<button id="btnClear" onclick="SetDefaults" title="Clear your selections and start again.">Clear Selections</button></div>
<!-- Show Script --><div id="divShowScript"><p>View Script <button name="btnSaveFile" title="Click to save your script to a file.">Save File</button> <button id="btnReset" onclick=window.location.reload title="This will reload the generator erasing anything you may have already entered.">Reset</button>
<textarea rows="20" name="txtViewScript" cols="66"></textarea><p><div id="divFileName"> <input type="button" id="btnEditScript" value="Edit script with Notepad" onclick="EditScript()"></div></p></div>
<p align="center"><font size=2><a href="http://www.SAPIEN.com" title="visit this HTA's creator"><img src="sapien.bmp" alt="Visit www.SAPIEN.com"></a><br><a href="#" onclick="About()" title="display version information">About</a></p></font><!-- hidden field to hold saved file name --><input type="hidden" id="TxtSaveAs"><!-- hidden fields to hold temporary values --> <div id="divSnippets"> <input type="text" name="txtDriveMappings"> <input type="text" name="txtPrinterMappings"> <input type="text" name="txtPrinterPortMappings"> <textArea name="txtArea_Routines">Function PasswordExpires(strDomain,strUser)On Error Resume NextDim objUserSet objUser=GetObject("WinNT://" & strDomain & "/" & strUser & ",user")PassExp=INT(objUser.MaxPasswordAge/86400)-INT(objUser.PasswordAge/86400)
If PassExp<0 Then strPassMsg="Your password never expires."Else strPassMsg="Your password expires in " & PassExp & " day(s)"end If
PasswordExpires=strPassMsgEnd Function
Function IsAMemberOf(strDomain,strUser,strGroup)On Error Resume NextSet objUser=GetObject("WinNT://" & strDomain & "/" & strUser & ",user")Set objGrp=GetObject("WinNT://" & strDomain & "/" & strGroup & ",group")
If objGrp.IsMember(objUser.ADsPath) Then IsAMemberOf=TrueElse IsAMemberOf=FalseEnd If
End Function
Sub MapIt(strDrive,strMap)On Error Resume NextIf objFSO.DriveExists(strDrive) Then objNetwork.RemoveNetworkDrive(strDrive)
objNetwork.MapNetworkDrive strDrive,strMap
If Err.Number<>0 And blnShowError Then strMsg="There was a problem mapping drive " & UCase(strDrive) & " to " &_ strMap & VbCrLf & strHelpMsg & VbCrLf & "Error#:" & Hex(err.Number) &_ VbCrLf & Err.Description objShell.Popup strMsg,iErrorTimeOut,"Error",vbOKOnly+vbExclamation Err.ClearEnd If
End Sub
Sub AddPrinterConnection(strPrinterUNC)On Error Resume Next
objNetwork.AddWindowsPrinterConnection strPrinterUNC
If Err.Number<>0 And blnShowError Then strMsg="There was a problem mapping " & UCase(strPrinterUNC) & ". " &_ vbcrlf & VbCrLf & strHelpMsg & VbCrLf & "Error#:" & Hex(err.Number) &_ VbCrLf & Err.Description objShell.Popup strMsg,iErrorTimeOut,"Error",vbOKOnly+vbExclamation Err.ClearEnd If
end sub
Sub AddPrinterPortConnection(strPort,strPrinterUNC)On Error Resume Next
objNetwork.AddPrinterConnection strPort,strPrinterUNC
If Err.Number<>0 And blnShowError Then strMsg="There was a problem mapping " & UCase(strPrinterUNC) & " to " &_ strPort & vbcrlf & VbCrLf & strHelpMsg & VbCrLf & "Error#:" & Hex(err.Number) &_ VbCrLf & Err.Description objShell.Popup strMsg,iErrorTimeOut,"Error",vbOKOnly+vbExclamation Err.ClearEnd If
end sub
</textArea>
</div></body></html>
User avatar
jhicks
Posts: 1789
Last visit: Mon Oct 19, 2015 9:21 am

login script generator

Post by jhicks »

I think if you are running it from a network share, you get the IE message about running slow. Try it locally and see if that makes a difference.
User avatar
huittdp
Posts: 7
Last visit: Mon Jan 23, 2017 2:19 pm

login script generator

Post by huittdp »

No
User avatar
huittdp
Posts: 7
Last visit: Mon Jan 23, 2017 2:19 pm

login script generator

Post by huittdp »

I forgot. We have a domain controller in our server room.
I will check Monday and let you know about the group number.

Thanks
This topic is 15 years and 3 months old and has exceeded the time allowed for comments. Please begin a new topic or use the search feature to find a similar but newer topic.
Locked