donhodge
asked on
Problems with login script
I am applying a GPO to run a VB printer script to the entire domain.
I am also applying a GPO to run a batch script to add net drives, this is applyed to the whole domain but i have it set to run only for one small group.
The problem is some of my stations will not run either script and im not sure where to start trouble shooting.
Thanks
I am also applying a GPO to run a batch script to add net drives, this is applyed to the whole domain but i have it set to run only for one small group.
The problem is some of my stations will not run either script and im not sure where to start trouble shooting.
Thanks
Have you tested that the scripts work before using them in a GPO?
ASKER
Yes the scripts are in net logon and yes i tested them and they work,
the policy i used is, User Config\Windows settings\scripts\login
the policy i used is, User Config\Windows settings\scripts\login
And the policy is linked to an OU containing the USERS, you wish to affect?
I would try running GPResult on one of the problematic workstations. Be sure to logon as the user. See if tries to apply the policy, and if so if there are any failures.
http://www.microsoft.com/windowsxp/using/setup/expert/gpresults.mspx
I would try running GPResult on one of the problematic workstations. Be sure to logon as the user. See if tries to apply the policy, and if so if there are any failures.
http://www.microsoft.com/windowsxp/using/setup/expert/gpresults.mspx
on our server the policy is based on the computer, not the user
mainly because all user need the logon script
mainly because all user need the logon script
ASKER
I will try the GPResult, the GPO is applied to the domain so its not a prob with OU structure.
The printer script needs to be availible to all users in domain so ill try it on the computer side of the config settings
Thanks
The printer script needs to be availible to all users in domain so ill try it on the computer side of the config settings
Thanks
here is my logon script, .VBS
it's better than a .BAT
use it only as reference, because it's BIG :P
it manage printers, and drives
it also execute an audit every 7 days to make an inventory in my sql server (ask if you want that other script)
it's better than a .BAT
use it only as reference, because it's BIG :P
it manage printers, and drives
it also execute an audit every 7 days to make an inventory in my sql server (ask if you want that other script)
'=== login script stas
'=== login script stas
'=== usable with GPO computer and user same time
'=== index
' objects definition
' network info (passive)
' network drive mapping
' printers mapping
' config outlook
' config word, excel, access
' config acrobat reader
on error resume next
Set objshe = WScript.CreateObject("WScript.Shell")
set objEnv = objshe.Environment("PROCESS")
Set objFSO = wscript.CreateObject("Scripting.FileSystemObject")
Set objNet = CreateObject("WScript.Network")
set objsheapp = wscript.CreateObject("Shell.Application")
Set objaut = WScript.CreateObject("AutoItX.Control")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
'HKEY_CLASSES_ROOT (HKCR)
'HKEY_CURRENT_USER (HKCU)
'HKEY_LOCAL_MACHINE (HKLM)
'HKEY_USERS (HKU)
'HKEY_CURRENT_CONFIG (HKCC)
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
'=== all possible office version installed
'=== can be used to find the folder AND the register path in base
arroff = array("11","12")
arrwin = array(" (x86)","")
dim msgfin '=== final message in bubble near task bar
admrig = 1 '=== the user have admin right, so we run all system parts of the script
msgfin ="" '=== message displayed in bubble in task bar at end of login
msgfin02="" '=== message final dans event viewer applications
debugname = "fournier.serge" '=== full error report if this user log
'=== msgbox at end for tests
msgfin03="====== debut logon script" & vbcrlf
msgfin04="=== warnings or info" & vbcrlf
'=== global variables or setup
objEnv("SEE_MASK_NOZONECHECKS") = 1
script01 = "\\corp.stas.local\stas\NetLogon\users\notification_balloon.vbs"
'=== network groups (pas le login) avec tous les CN, OU, DC
Set objUser = CreateObject("ADSystemInfo")
Set CurrentUser = GetObject("LDAP://" & objUser.UserName)
'=== network usename
usenam = lcase(objNet.UserName)
uselna = lcase(currentuser.sn) '=== last name
usefna = lcase(currentuser.givenname) '=== first name
db_host = environ("stassql1") ' MySQL Server address
db_database = "winventory"
db_user = "sa"
db_password = "password"
set database=createobject("adodb.connection")
set tag = CreateObject ("ADODB.Recordset")
conn = "driver={SQL Server};server=" & db_host & ";Database=" & db_database & ";Uid=" & db_user & ";Pwd=" & db_password
'conn = "Driver={SQL Server};Server=" & db_host & ";Integrated Security=SSPI"
database.open conn
sql = "USE " & db_database
set tag = database.execute(sql)
'=== network card find
strcomputer="."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("select * from win32_networkadapterconfiguration WHERE IPEnabled='TRUE' " _
& "AND ServiceName<>'AsyncMac' " _
& "AND ServiceName<>'VMnetx' " _
& "AND ServiceName<>'VMnetadapter' " _
& "AND ServiceName<>'Rasl2tp' " _
& "AND ServiceName<>'msloop' " _
& "AND ServiceName<>'PptpMiniport' " _
& "AND ServiceName<>'Raspti' " _
& "AND ServiceName<>'NDISWan' " _
& "AND ServiceName<>'NdisWan4' " _
& "AND ServiceName<>'RasPppoe' " _
& "AND ServiceName<>'NdisIP' " _
& "AND ServiceName<>'' " _
& "AND Description<>'PPP Adapter.'",,48)
'=== mac address find
For Each objItem in colItems
count_all = count_all + 1
if objItem.IPAddress(0) <> "0.0.0.0" then
count = count + 1
if count = 1 then
net_ip_address = objItem.IPAddress(0)
'objOutputFile.WriteLine date & " " & time & " IP: " & net_ip_address
net_mac_address = objItem.MACAddress
end if
end if
next
sql = "UPDATE system SET log_start={ fn NOW() } WHERE net_mac_address = '" & net_mac_address & "'"
set tag = database.execute(sql)
if usenam=debugname then
'msgbox(sql)
end if
'=== log everything for timing
'T:\log_logon
usetmp = environ("temp")
'file01 = "\\stas-host-01\stas\temporaire\log_logon\" & usenam & "_log_logon.txt"
on error resume next
'Set objfil01 = objFso.OpenTextFile(file01, 2, true)
'objFil01.WriteLine date & " " & time & " début logon "
'if usenam = debugname then
' set cursys = GetObject("LDAP://" & objUser.ComputerName)
' Set oComputer = CreateObject("ADSystemInfo")
' cName = oComputer.ComputerName
' Set ObjGroup = GetObject("LDAP://cn=informatique," & objUser.ComputerName)
' for each Group in ObjGroup.member
' If Group = ObjGroup.distinguishedName Then
' wscript.echo "Already a Member of This Group"
' Else
'ObjGroup.Add "LDAP://" & cName
' Wscript.Echo lName.ComputerName & " Added to USB Group"
'
' End If
' Next
'end if
'=== path to current user desktop
'AllUsersDesktop : D:\Documents and Settings\All Users\Bureau
'AllUsersStartMenu : D:\Documents and Settings\All Users\Menu Démarrer
'AllUsersPrograms : D:\Documents and Settings\All Users\Menu Démarrer\Programmes
'AllUsersStartup : D:\Documents and Settings\All Users\Menu Démarrer\Programmes\Démarrage
'Desktop : D:\Documents and Settings\Christophe\Bureau
'AppData : D:\Documents and Settings\Christophe\Application Data
'PrintHood : D:\Documents and Settings\Christophe\Voisinage d'impression
'Templates : D:\Documents and Settings\Christophe\Modèles
'Fonts : D:\WINDOWS\Fonts
'NetHood : D:\Documents and Settings\Christophe\Voisinage réseau
'StartMenu : D:\Documents and Settings\Christophe\Menu Démarrer
'SendTo : D:\Documents and Settings\Christophe\SendTo
'Recent : D:\Documents and Settings\Christophe\Recent
'Startup : D:\Documents and Settings\Christophe\Menu Démarrer\Programmes\Démarrage
'Favorites : D:\Documents and Settings\Christophe\Favoris
'Programs : D:\Documents and Settings\Christophe\Menu Démarrer\Programmes
alldes = objShe.SpecialFolders.Item("AllUsersDesktop")
'=== variable for user logged (when its not system)
if usenam <>"system" then
'
'=== service
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\bonjour service\start"
d=regwri(a,4,"REG_DWORD")
'=== service
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Microsoft Office Groove Audit Service\start"
d=regwri(a,4,"REG_DWORD")
'=== service
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Apple Mobile Device\start"
d=regwri(a,4,"REG_DWORD")
' objFil01.WriteLine date & " " & time & " query ldap data "
usegrp = LCase(Join(CurrentUser.MemberOf)) '=== list of all groups user is in
useappdat = objShe.SpecialFolders.Item("appdata") '=== application data
allappdat = environ("ALLUSERSPROFILE") & "\Application Data" '=== application data all users
uselosappdat = environ("USERPROFILE") & "\local settings\Application Data" '=== local setting, app data
usedes = objShe.SpecialFolders.Item("Desktop") '=== user desktop - bureau
usetmp = environ("temp") '=== user temp folder
macfon = objShe.SpecialFolders.Item("Fonts")
comfil = environ("commonprogramfiles")
'=== find the path to office
useoff = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\Word\InstallRoot", "path")
if isnull(useoff) then
useoff = regrea(0, hklm, "SOFTWARE\Microsoft\Office\11.0\Word\InstallRoot", "path")
end if
useout = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\outlook\InstallRoot", "path")
if isnull(useout) then
useout = regrea(0, hklm, "SOFTWARE\Microsoft\Office\11.0\Word\InstallRoot", "path")
end if
useexc = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\excel\InstallRoot", "path")
if isnull(useoff) then
useexc = regrea(0, hklm, "SOFTWARE\Microsoft\Office\11.0\excel\InstallRoot", "path")
end if
if useoff ="" then
if usenam = debugname then
msgbox("erreur pas trouvé le path office")
end if
msgfin03=msgfin03 & "error - path office not found" & vbcrlf
end if
end if
on error resume next
'=== computer name
sysnam = lcase(objnet.computername)
if err.number<>0 then
if usenam = debugname then
msgbox(err.number & vbcrlf & err.description)
end if
msgfin03=msgfin03 & vbcrlf & "error - system name invalide - " & vbcrlf & sysnam & vbcrlf
end if
if usenam <>"system" then
if usenam = debugname then
'msgbox("vous etes serge fournier, debugger")
end if
on error resume next
err.clear
objshe.Run script01 & " DEBUT ""Bonjour`n" & usenam & "`n" & sysnam & "`n"" 15 1+16",, False
if err<>0 then
err.clear
script01 = "\\172.16.0.37\NetLogon\users\notification_balloon.vbs"
objshe.Run script01 & " DEBUT ""Bonjour`n" & usenam & "`n" & sysnam & "`n"" 15 1+16",, False
if err<>0 then
err.clear
script01 = "\\172.16.0.1\NetLogon\users\notification_balloon.vbs"
objshe.Run script01 & " DEBUT ""Bonjour`n" & usenam & "`n" & sysnam & "`n"" 15 1+16",, False
end if
end if
'=== adjust time on local computer
'objFil01.WriteLine date & " " & time & " time adjust to stas-dc-03 "
objshe.Run "net time \\stas-dc-03 /set /yes",0, false
if err.number<>0 then
if usenam = debugname then
msgbox(err.number & vbcrlf & err.description)
end if
msgfin03=msgfin03 & "error - impossible to start task bar bubble message"
end if
end if
'=== error trapping and testing by this user
if usenam = debugname then
on error goto 0
else
on error resume next
end if
'=== get system drive letter
WinDir = objfso.GetSpecialFolder(0) '=== windows dir
if windir="" then
msgfin03=msgfin03 & vbcrlf & "erreur - windows path not found" & vbcrlf
end if
sysdir = objfso.GetSpecialFolder(1) '=== system32 dir
if sysdir="" then
msgfin03=msgfin03 & vbcrlf & "erreur - system path not found" & vbcrlf
end if
'=== var environnement
'objshe.Environment.Item("WINDIR")
prodir32 = environ("programfiles(x86)")
prodir = environ("programfiles")
if prodir="" then
msgfin03=msgfin03 & vbcrlf & "erreur - program files path not found" & vbcrlf
end if
root=mid(windir,1,3)
'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
'=== path serveur
ser = "\\corp.stas.local\stas\netlogon"
ser2 = "\\corp.stas.local"
serv01 = "\\corp.stas.local\stas"
serveur = "\\stas-host-01\"
'========= start mapping drives
if usenam <>"system" then
'objFil01.WriteLine date & " " & time & " drives mapping start"
msgfin02=""
toterrcop=0
'=== special config for certain groups
If InStr(usegrp, "pemp") Then
objNet.RemoveNetworkDrive "X:"
end if
Set oDrives = objnet.EnumNetworkDrives
alldri = ""
allsha = ""
'objFil01.WriteLine date & " " & time & " drives get old letters "
For i = 0 to oDrives.Count - 1 Step 2
alldri = alldri & lcase(oDrives.Item(i)) & " "
'=== futur developement if we want to unmap drives if the path is not the same
'allsha = allsha & lcase(oDrives.Item(i+1)) & " "
Next
'=== special config for certain groups
If InStr(usegrp, "pemp") Then
c = mapdri("x:",serv01 & "\PEMP",alldri)
alldri = alldri & "x: "
end if
If InStr(usegrp, "comptabilite") or InStr(usegrp, "comptabilité") Then
c = mapdri("s:",serv01 & "\ADMINIST",alldri)
alldri = alldri & "s: "
end if
'=== archives drive mapping
if usenam="fournier.serge" or _
usenam="paquet.yves" or _
usenam="mancheron.jimmy" or _
usenam="maltais.daniel" or _
usenam="belley.guy" or _
usenam="prive.dominique" or _
usenam="juneau.helaine" or _
usenam="bouchard.louis" or _
usenam="doucet.gm" then
c = mapdri("x:",serv01 & "\archives",alldri)
alldri = alldri & "x: "
end if
if usenam <>"" then
c = mapdri("h:", serv01 & "\usagers\" & usenam,alldri)
alldri = alldri & "h: "
end if
'objFil01.WriteLine date & " " & time & " drives H to Z "
c = mapdri("h:", serv01 & "\Temporaire",alldri)
c = mapdri("i:", serv01 & "\Projets",alldri)
c = mapdri("j:", serv01 & "\Elec",alldri)
c = mapdri("k:", serv01 & "\Originaux",alldri)
c = mapdri("l:", serv01 & "\Mec",alldri)
c = mapdri("M:", serv01 & "\Magica",alldri)
c = mapdri("N:", serv01 & "\LOTUS",alldri)
c = mapdri("O:", serv01 & "\WP",alldri)
c = mapdri("r:", serv01 & "\dbase",alldri)
'c = mapdri("s:", serv01 & "\Temporaire",alldri)
c = mapdri("t:", serv01 & "\Temporaire",alldri)
c = mapdri("v:", serv01 & "\ProjetsStas",alldri)
c = mapdri("u:", "http://intranet.stas.biz/Documents/",alldri)
c = mapdri("w:", serv01 & "\Photos",alldri)
'c = mapdri("x:", serv01 & "\Temporaire",alldri)
c = mapdri("y:", serv01 & "\System",alldri)
c = mapdri("Z:", serv01 & "\References",alldri)
'c = mapdri("p:", serv01 & "\Netlogon",alldri)
msgfin = msgfin & "`n" & toterrcop & " err drives " & msgfin02
a = ser & "\users\_stas\"
b = root & "_stas"
e = makfol(b)
on error resume next
'=== make local dir c:\_stas
Set objFolder = objFSO.GetFolder(a)
if err.number<>0 then
if usenam = debugname or usenam ="admin3" then
msgbox("error" & vbcrlf & a & vbcrlf & err.description & vbcrlf & ser)
end if
end if
filnam = "chemin.ini"
sou = ser & "\users\" & filnam
des = "c:\_stas\apps\" & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
filnam = "chemin.ini"
sou = ser & "\users\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
a=copyfile(sou,des)
filnam = "_01_logon.vbs.lnk"
sou = ser & "\users\_stas\util\" & filnam
des = "c:\_stas\" & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
a=copyfile(sou,des)
Set objFiles = objFolder.subfolders '=== directory
'=== chek all file in each folders in c:\_stas
For Each objFile in objFiles
a = "\" & objfile.name
b = ser & "\users\_stas" & a
c = root & "_stas" & a
e = makfol(c)
d = copyfold(b,c)
if usenam = debugname then
'msgbox("test" & vbcrlf & b & vbcrlf & c)
end if
next
'=== update consigno
'objFil01.WriteLine date & " " & time & " consigno update "
a="V:\224226_elec_ing\Signature_electronique\templates\STAS_Avec_Sceau"
b=useappdat & "\.ConsignO\templates"
Set objFolder = objFSO.GetFolder(b)
if err.number<>0 then
if usenam = debugname or usenam ="admin3" then
'msgbox("error" & vbcrlf & b & vbcrlf & err.description & vbcrlf & ser)
end if
else
d = copyfold(a,b)
end if
msgfin = msgfin & "`n" & toterrcop & " err regwrite & copy"
end if
'=== map drive only if they are not aleady mapped
'=== a = letter
'=== b = share path
'=== c = all drive already used in a string
function mapdri(a,b,c)
if instr(c, lcase(a))=0 then
on error resume next
objNet.MapNetworkDrive a, b
if err.number<>0 then
msgfin02 = msgfin02 & a & " "
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - " & A & " drive not mapped to " & b & vbcrlf
end if
else
'=== drive exist, we dont unmap or remap
'msgfin02 = msgfin02 & a & " "
end if
end function
toterrcop =0
'====== start outlook machine
if usenam="system" or admrig = 1 then
'objFil01.WriteLine date & " " & time & " outlook setup "
'=== outlook machine setup
' filnam = "BoutonsOutlook.dll"
' sou = ser & "\users\_stas\outlook\" & filnam
' des = sysdir & "\" & filnam
' a=copyfile(sou,des)
'=========================== VISTA =====================
'=== désactiver le control usager - user access control (necessite un reboot)
'=== executing a script as true admin, bypassing all vista new security
set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOS in colOSes
osCaption = objOS.Caption
If instr(osCaption, "Vista") Then
objSheapp.ShellExecute "wscript.exe", Chr(34) & ser & "\users\_03_vista.VBS" & Chr(34), "", "runas", 1
'=== windows vista ajust adjust tweaks
a="HKEY_LOCAL_MACHINE\System\currentcontrolset\services\windefend\start"
d=regwri(a,4,"REG_DWORD")
End If
Next
filnam = "comdlg32.dll"
sou = ser & "\users\_stas\outlook\" & filnam
des = sysdir & "\" & filnam
a=copyfile(sou,des)
filnam = "comdlg32.ocx"
sou = ser & "\users\_stas\outlook\" & filnam
des = sysdir & "\" & filnam
a=copyfile(sou,des)
a=0
b=sysdir & "\regsvr32.exe /s c:\_stas\outlook\boutonsoutlook.dll"
a = objshe.run(b,0,true)
if a<>0 then
if usenam=debugname then
msgbox("erreur" & vbcrlf & b)
end if
end if
'a=0
'b=sysdir & "\regsvr32.exe /u /s c:\_stas\outlook\boutonsoutlook.dll"
'a = objshe.run(b,0,true)
'if a<>0 then
' if usenam=debugname then
' msgbox("erreur" & vbcrlf & b)
' end if
'end if
a=0
b=sysdir & "\regsvr32.exe /u /s " & sysdir & "\comdlg32.ocx"
a = objshe.run(b,0,true)
if a<>0 then
if usenam=debugname then
msgbox("erreur" & vbcrlf & b)
end if
end if
a=0
b=sysdir & "\regsvr32.exe /s " & sysdir & "\comdlg32.ocx"
a = objshe.run(b,0,true)
if a<>0 then
if usenam=debugname then
msgbox("erreur" & vbcrlf & b)
end if
end if
' return = WshShell.Run("ping "&strComputer&" -n 1 -w 500", 0, true)
d=regwri("HKEY_LOCAL_MACHINE\software\microsoft\jet\4.0\engines\text\format","delimited(;)","REG_SZ")
'=== variables environnement dans base de registre, necessite login usager
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\stasfile"
b="\\Corp.stas.local\stas"
c="REG_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\stasmag"
b="\\stas-magica-02"
c="REG_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\stassql1"
b="sql.corp.stas.local"
c="REG_SZ"
d=regwri(a,b,c)
'=== fonts machine setup
b = ser & "\users\_stas\fonts"
c = macfon
e = makfol(c)
d = copyfold(b,c)
';Gets rid of tray icon for taking survey (office 2k3)
'[HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\Internet]
'"UseOnlineContent"=dword:00000002
'[HKEY_CURRENT_USER\Software\Microsoft\Office\Common]
'"QMEnable"=dword:00000000
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\Internet\UseOnlineContent"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\Internet\UseOnlineContent"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\Common\QMEnable"
d=regwri(a,0,"REG_DWORD")
'=== outlook bug SAFE MODE ON TERMINAL SERVER (version 10,11,12)
d=regdeltre(hklm,"Software\Microsoft\Windows NT\Current Version\Terminal Server\Install\Software\Microsoft\Office\10.0\Outlook\Resiliency")
d=regdeltre(hklm,"Software\Microsoft\Windows NT\Current Version\Terminal Server\Install\Software\Microsoft\Office\11.0\Outlook\Resiliency")
d=regdeltre(hklm,"Software\Microsoft\Windows NT\Current Version\Terminal Server\Install\Software\Microsoft\Office\12.0\Outlook\Resiliency")
'=== disable asking to install desktop search on outlook 2007
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Search\DisableDownloadSearchPrompt"
d=regwri(a,1,"REG_DWORD")
'=== explorer refresh après un rename etc (plus souvent)
'Windows Registry Editor Version 5.00
'[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Update]
'"UpdateMode"=dword:00000000
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Update\UpdateMode"
d=regwri(a,0,"REG_DWORD")
'=== context menu modif
'[HKEY_CLASSES_ROOT\Drive\shell\Send_Link_by_Mail]
'@=""
'[HKEY_CLASSES_ROOT\Drive\shell\Send_Link_by_Mail\Command]
'@="\"C:\\Windows\\System32\\wscript.exe\" \"C:\\_stas\\Util\\Send_Link_by_Mail.vbs\" %1"
'[HKEY_CLASSES_ROOT\lnkfile\shell\slink]
'@="Quick Launch folder (Explore)"
'a="HKEY_CLASSES_ROOT\Drive\shell\Send_Link_by_Mail\Command\@"
'b=""C:\\Windows\\System32\\wscript.exe\" \"C:\\_stas\\Util\\Send_Link_by_Mail.vbs\" %1"
if usenam="fournier.serge" then
'----------Installation script for right-click menu-----------
'--------Text file-------
'WSHShell.RegWrite "HKCR\*\shell\test\command\",r & "tst.vbs'","REG_SZ"
a="HKCR\txtfile\shell\test\command\"
b=sysdir & "\WScript.exe ""C:\_stas\util\t.VBS"" ""%1"""
objshe.RegWrite a, b,"REG_SZ"
'msgbox "ok right click sef"
'-----------end of script----------
end if
'si claude guérin, setup clear type fonts
'[HKEY_CURRENT_USER\Control Panel\Desktop]
'"FontSmoothing"="2"
'"FontSmoothingType"=dword:00000002
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\EnableAutoUpdateCheck"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\EnableJavaUpdate"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\NotifyDownload"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\NotifyInstall"
d=regwri(a,0,"REG_DWORD")
'=== paint net paintdotnet paint.net NO UPDATE
a="HKEY_LOCAL_MACHINE\SOFTWARE\Paint.NET\CHECKFORUPDATES"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\NtfsDisable8dot3NameCreation"
d=regwri(a,0,"REG_DWORD")
'=== error norton en nom short au demarrage
d=regdel("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\vptray")
'=== google
des = prodir & "\google\GoogleToolbar1.dll"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== google
des = prodir & "\google\GoogleToolbar2.dll"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== yahoo
des = prodir & "\Yahoo!\Companion\Installs\cpn\yt.dll"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== Shortcuts without "Shortcut to.."
' deja fait?
'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer]
'"link"=hex:00,00,00,00
'=== Disable Tracking of Broken Shortcut Links
'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer]
'"NoResolveTrack"=dword:00000001
'=== disable restart prompt after a windows update
'[HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate\AU]
'"RebootRelaunchTimeoutEnabled"=dword:00000000
'a="HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate\AU\RebootRelaunchTimeoutEnabled"
'd=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoResolveTrack"
d=regwri(a,1,"REG_DWORD")
'=== Disable Autorun for all Drive Types
'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer]
'"NoDriveTypeAutoRun"=dword:00000091
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDriveTypeAutoRun"
d=regwri(a,16,"REG_DWORD")
'NoDriveAutoRun or NoDriveTypeAutoRun
'=== diminue le niveau d'update de la date de dernier acces sur un share réseau
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRemoteRecursiveEvents"
d=regwri(a,1,"REG_DWORD")
'=== Add register / unregister to the context menu for .dll files
'[HKEY_CLASSES_ROOT\.dll]
'"Content Type"="application/x-msdownload"
'@="dllfile"
'[HKEY_CLASSES_ROOT\dllfile]
'@="Application Extension"
'[HKEY_CLASSES_ROOT\dllfile\Shell\Register\command]
'@="regsvr32.exe \"%1\""
'[HKEY_CLASSES_ROOT\dllfile\Shell\UnRegister\command]
'@="regsvr32.exe /u \"%1\""
'runwita="HKEY_CLASSES_ROOT\"& runwitnam &"\shell\open\command\"
'runwitb=runwitprog
'runwitc="REG_SZ"
'runwitd=regwri(runwita,runwitb,runwitc)
'objFil01.WriteLine date & " " & time & " regsvr32 for dll for power users "
if usenam="fournier.serge" or usenam="foster.nathaniel" or usenam="boivin.francois" then
a="HKEY_CLASSES_ROOT\.dll\Content Type"
d=regwri(a,"application/x-msdownload","REG_SZ")
a="HKEY_CLASSES_ROOT\.dll\"
d=regwri(a,"dllfile","REG_SZ")
a="HKEY_CLASSES_ROOT\dllfile\"
d=regwri(a,"Application Extension","REG_SZ")
a="HKEY_CLASSES_ROOT\dllfile\Shell\Register\command\"
d=regwri(a,"regsvr32.exe ""%1""","REG_SZ")
a="HKEY_CLASSES_ROOT\dllfile\Shell\UnRegister\command\"
d=regwri(a,"regsvr32.exe /u ""%1""","REG_SZ")
end if
'=== correct sort order in windows xp
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoStrCmpLogical"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoStrCmpLogical"
d=regwri(a,1,"REG_DWORD")
end if
'========= printers mapping
if usenam<>"admin1" _
and usenam<>"admin2" _
and usenam<>"administrateur" _
and (instr(sysnam,"stas")=0 or sysnam="stas-ts-02") then
'and instr(usegrp, "cn=comptes_generiques")=0
if usenam<>"system" then
'objFil01.WriteLine date & " " & time & " printer mapping "
'=== reset error counter
toterrcop = 0
dim strUNCPrinter
Dim objPrinter
dim intDrive
dim intNetLetter
dim totren
dim totold
totren=0
totold=0
paspil=0
'=== user login name
strUserName = usenam
' printer server
maingroup = "employés stas"
'=== a = ldap group (the group they need to be in to have this printer installed)
'=== b = unc path of printer
'=== c = dummy
c = installprinter("SCAN2200", serveur & "SCAN2200")
c = installprinter("SCAN2200", serveur & "SCAN2200_RECTO_VERSO")
c = installprinter("SCAN2200", serveur & "SCAN2200MEC")
c = installprinter("SCAN2200", serveur & "SCAN2200MEC_RECTO_VERSO")
c = installprinter("SCAN4080", serveur & "scan4080_noir")
c = installprinter("SCAN4080", serveur & "SCAN4080_COUL")
c = installprinter("SCAN4080", serveur & "SCAN4080_RECTO_VERSO")
c = installprinter("SCAN4080", serveur & "SCAN4080_PDF")
c = installprinter("PLOT1055", serveur & "PLOT1055")
c = installprinter("PLOT1055X64", serveur & "PLOT1055X64")
c = installprinter("COUL990C", serveur & "COUL990C")
c = installprinter("ELEC5SIM", serveur & "ELEC5SIM")
c = installprinter("MECA8100", serveur & "MECA8100")
c = installprinter("CAFE3330", serveur & "CAFE3330")
c = installprinter("COMP2100", serveur & "COMP2100")
c = installprinter("EMM5100", serveur & "EMM5100")
c = installprinter("ELEC5SIM", serveur & "HP8100-02")
c = installprinter("HP8100-02", serveur & "HP8100-02")
'=== printers exception for specifics users
if strUserName = "doucet.gm" then
a = maingroup
b = serveur & "COUL3600"
c = installprinter(a, b)
b = ""
objNet.SetDefaultPrinter b
end if
if strUserName = "bourque.jf" then
a = maingroup
'=== imprimante a michelle tremblay
b = "\\dtcs316792\hplaserj"
c = installprinter(a, b)
b = "IBM proprinter xl II"
objNet.SetDefaultPrinter b
b = "\\DTCS166981\HPLJ3330PS"
c = installprinter(a, b)
end if
if strUserName = "bouchard.pierre" then
b = serveur & "SCAN2200"
err.clear
objNet.SetDefaultPrinter b
'if err.number<>0 then
' b = serveur & "scan4080_noir"
' objNet.SetDefaultPrinter b
'end if
end if
if strUserName = "fournier.serge" then
b = serveur & "scan4080_noir"
err.clear
objNet.SetDefaultPrinter b
if err.number<>0 then
b = serveur & "ELEC5SIM"
objNet.SetDefaultPrinter b
end if
end if
if strUserName = "duchesne.patrice" then
b = serveur & "SCAN2200"
err.clear
objNet.SetDefaultPrinter b
if err.number<>0 then
b = serveur & "scan4080_noir"
objNet.SetDefaultPrinter b
end if
end if
if strUserName = "guay.francois" then
a = maingroup
'=== imprimante a michelle tremblay
b = "\\dtcs316792\hplaserj"
c = installprinter(a, b)
b = "HP LaserJet 4 Plus"
objNet.SetDefaultPrinter b
b = "\\DTCS166981\HPLJ3330PS"
c = installprinter(a, b)
end if
if strUserName = "potvin.andre" then
a = maingroup
'=== imprimante a michelle tremblay
b = "\\mtre20040106\mtremblay1"
c = installprinter(a, b)
objNet.SetDefaultPrinter b
end if
if strUserName = "quenneville.anne" then
a = maingroup
'=== imprimante a jfbourque (étiquettes)
b = "\\Rla20050210\IBM Proprinter XL II"
c = installprinter(a, b)
objNet.SetDefaultPrinter b
b = "\\DTCS166981\HPLJ3330PS"
c = installprinter(a, b)
end if
if strUserName = "tremblay.m" then
b = "\\Mtre20040106\HPLaserJ"
objNet.SetDefaultPrinter b
end if
'objFil01.WriteLine date & " " & time & " printer no color by default "
'=== we dont want color printer to be the default printer, so if it is, we put black and white
a = "SCAN4080"
b = serveur & "SCAN4080_COUL"
c = serveur & "SCAN4080_NOIR"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
'objFil01.WriteLine date & " " & time & " printer black become recto verso "
if usenam<>"morin.pierre" and usenam<>"morin.gilles" and usenam<> "mancheron.jimmy" and usenam<>"duchaine.robin" then
a = "SCAN4080"
b = serveur & "SCAN4080_NOIR"
c = serveur & "SCAN4080_RECTO_VERSO"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
end if
a = "SCAN2200"
b = serveur & "SCAN2200_RECTO_VERSO"
c = serveur & "SCAN2200"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
a = "SCAN2200MEC"
b = serveur & "SCAN2200MEC"
c = serveur & "SCAN2200MEC_RECTO_VERSO"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
'msgfin = msgfin & paspil
'objshe.Run script01 & " FIN ""Imprimantes installées`n" & totren & " / " & totold & "`n" & msgfin & """ 15 1+16",, False
end if
'=== outlook 2007 est présent, on copie les macros
a = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\outlook\InstallRoot", "path")
b = 0
if isnull(a) then
else
des = a & "outlook.exe"
if objFSO.fileEXISTS(des) then
b = 1
end if
end if
'=== outlook message change before send
'HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail
'HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Options\Mail
'Clé DWORD : « Send Pictures With Document » = 0
des = useout & "outlook.exe"
if objFSO.fileEXISTS(des) then
'objFil01.WriteLine date & " " & time & " outlook repair hyperlinks "
'=== hyperlink repair outlook 2007
a="HKEY_CLASSES_ROOT\outlook\URL Protocol"
d=regwri(a,"","REG_SZ")
a="HKEY_CLASSES_ROOT\outlook\"
d=regwri(a,"URL:Outlook Folders","REG_SZ")
a="HKEY_CLASSES_ROOT\outlook\shell\"
d=regwri(a,"open","REG_SZ")
a="HKEY_CLASSES_ROOT\outlook\shell\open\"
d=regwri(a,"","REG_SZ")
'=== hyperlink repair outlook 2007 (all version modif)
a="HKEY_CLASSES_ROOT\outlook\shell\open\command\"
d=regwri(a,"""" & des & """ /select ""%1""","REG_SZ")
end if
For each i in arroff
a="HKEY_CURRENT_USER\Software\Microsoft\Office\" & i & ".0\Outlook\Options\Mail\Send Pictures With Document"
d=regwri(a,0,"REG_DWORD")
next
'objFil01.WriteLine date & " " & time & " outlook projet macros "
if usenam<>"system" and _
(b=1 and usenam<>"boivin.francois") or _
(b=1 and usenam<>"fournier.serge") or _
(usenam="fournier.serge" and sysnam="stas-ts-02") or _
(usenam="boivin.francois" and sysnam="stas-ts-02") or _
usenam="boulianne.robin" or _
usenam="dufour.christian" or _
usenam="desbiens.jf" or _
usenam="pichette.chantal" or _
usenam="fortin.carl" or _
usenam="vezina.pascal" or _
usenam="duchesne.patrice" or _
usenam="guerin.claude" or _
usenam="cote.lise" or _
usenam="paiement.mf" or _
usenam="receptionniste" or _
usenam="réceptionniste" or _
usenam="gauthier.helene" then
'=== outlook vba machine setup
filnam = "VbaProject.OTM"
sou = ser & "\users\_stas\outlook\" & filnam
des = useappdat & "\Microsoft\Outlook\" & filnam
objFSO.copyFile sou, des, TRUE
if err<>0 and usenam=debugname then
'msgbox("ERROR" & vbcrlf & "macro outlook pas copiees")
msgfin = msgfin & "`n" & "DEBUG macro outlook pas copiees"
msgfin03 = msgfin03 & VBCRLF & "DEBUG macro outlook pas copiees"
elseif usenam=debugname then
'msgbox(sou & vbcrlf & des)
end if
'=== barre outils acces rapide (QAT) quick access tool bar
filnam = "olkmailitem.qat"
sou = ser & "\users\_stas\outlook\" & filnam
des = uselosappdat & "\Microsoft\office\" & filnam
objFSO.copyFile sou, des, TRUE
if err<>0 and usenam=debugname then
'msgbox("ERROR" & vbcrlf & "QAT pas copie" & vbcrlf & sou & vbcrlf & des)
msgfin03 = msgfin03 & VBCRLF & "DEBUG QAT pas copie"
msgfin = msgfin & "`n" & "DEBUG QAT pas copie"
elseif usenam=debugname then
'msgbox(sou & vbcrlf & des)
end if
end if
'========= start outlook user
if usenam <>"system"_
and usernam <> "admin1" _
and usernam <> "admin2" _
and usernam <> "admin3" _
then
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Policies\Microsoft\Office\11.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Policies\Microsoft\Office\12.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
'=== display contacts in outlook 2007
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\ShowContactField"
d=regwri(a,1,"REG_DWORD")
'=== outlook windows position
'strRegKey = "Software\Microsoft\Office\11.0\Outlook\"
'arrRegData = array(&h3f,&H05,&Hc0,&H7c,&Hff,&Hff,&Hff,&Hff,&H06,&H89,&H00,&H00,&H06,&H89,&H00,&H00,&H04,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H04,&H00,&H00,&H00)
'strRegValue = "settings"
'objReg.SetBinaryValue HKCU, strRegKey, strRegValue, arrRegData
'=== outlook goes to tray when minimized outlook tray outlook minimized
if usenam="larouche.michel"_
or usenam="pettersen.mathieu"_
or usenam="fournier.serge"_
or usenam="dufour.stephane"_
then
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\MinToTray"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\MinToTray"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\MinToTray"
d=regwri(a,1,"REG_DWORD")
else
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\MinToTray"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\MinToTray"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\MinToTray"
d=regwri(a,0,"REG_DWORD")
end if
'=== ambiguous name resolution offline --> online outlook 10.0 et 11.0 ===============
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Cached Mode\ANR Include Online GAL"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Cached Mode\ANR Include Online GAL"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Cached Mode\ANR Include Online GAL"
d=regwri(a,1,"REG_DWORD")
'=== macro securite off dans outlook 10 et 11
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\VBAWarnings"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\DataConnectionWarnings"
d=regwri(a,0,"REG_DWORD")
'=== manual registration of dll file to use with object oriented application
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\Description"
'b="Add-In Project Template"
'c="REG_SZ"
'd=regwri(a,b,c)
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\FriendlyName"
'b="My Add-In"
'c="REG_SZ"
'd=regwri(a,b,c)
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\LoadBehavior"
'b=3
'c="REG_DWORD"
'd=regwri(a,b,c)
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\CommandLineSafe"
'b=0
'c="REG_DWORD"
'd=regwri(a,b,c)
'=== outlook cached mode with favorites publics in cache
'=== Registry constants
' const CLASSID_SUBKEY = "CLSID\{0006F03A-0000-0000-C000-000000000046}\LocalServer32"
if usenam<>"fortin.dominic" and usenam <>"dufour.christian" then
const PROFILE_SUBKEY = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
const EXCHCFG_VALUE = "00036601"
dim objreg , lngRC, lngValueType, vntValueData
dim arrnames, lngn, arrTypes ,a
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
'=== read default outlook profile name
err.clear
defpro=""
b = "defaultprofile"
lngRC = objReg.GetStringValue(HKCU, PROFILE_SUBKEY , b, defpro)
if err<>0 then
msgbox("CAnnot find defaut outlook profile" & vbcrlf & PROFILE_SUBKEY & vbcrlf & b)
end if
'=== read config
if defpro<>"" then
c = PROFILE_SUBKEY & "\" & defpro & "\13dbb0c8aa05101a9bb000aa002fc45a"
d = "00036601"
lngRC = objReg.GetBinaryValue(HKCU, c, d, arrcfgout)
end if
'=== change outlook cache config
'objFil01.WriteLine date & " " & time & " outlook cache mode "
if sysnam="stas-ts-02" then
arrcfgout(0) = arrcfgout(0) And &H7F ' Disable 8th bit in 1st byte
arrcfgout(1) = arrcfgout(1) And &HFa ' Disable 1st bit in 2nd byte
else
arrcfgout(0) = arrcfgout(0) Or &H80 ' Enable 8th bit in 1st byte
' Enable 1st bit in 2nd byte = cached mode
' Enable 3rd bit in 2nd byte = cached mode favorite public folders
arrcfgout(1) = arrcfgout(1) Or &H05
end if
'=== save outlook cache config
objReg.SetBinaryValue hkcu, c, d, arrcfgout
end if
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err outlook"
end if
end if
'====== end outlook user
'========= end outlook
'====== start reg inscriptions =========== GENERAL SECTION
if usenam="system" or admrig = 1 then
'=== nrg file will run with daemon tools
'=== need admin right for this one
a=""
f = prodir & "\d-tools"
e = "\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f = prodir & "\daemon tools"
e = "\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir32 & "\d-tools"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir32 & "\daemon tools"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir & "\daemon tools Lite"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir32 & "\daemon tools Lite"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
if a<>"" then
b="iso"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="bin"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="nrg"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="img"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="ccd"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="cue"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="000"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
'=== remove cd in virtual cd rom drive
if usenam = debugname then
'msgbox (chr(34) & a & " -unmount 0" & chr(34))
end if
'objshe.Run chr(34) & a & chr(34) & " -unmount 0",, false
'=== remove update chek for daemon
'=== d = directory where it was found
des = d & "\chkupd.exe"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
end if
'=== image disquettes dans le b:
b="ima"
c=runwit("c:\_stas\virtual_floppy\vfdwin.exe /open ""%l""",b,"imagefloppy" & b)
end if
if usenam <>"system" then
toterrcop =0
'objFil01.WriteLine date & " " & time & " exlorer setup "
'====== INTERNET EXPLORER
'=== WINDOW POSITION (need a relog to be effective)
'=== disable regdebugger in iexplorer
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Disable Script Debugger","yes","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Error Dlg Displayed On Every Error","no","REG_SZ")
if usenam<>"dufour.stephane" then
a = "Software\Microsoft\Internet Explorer\Main\"
b = "Window_Placement"
c = array(&h2c,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h01,&h00,&h00,&h00,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&h82,&h01,&h00,&h00,&h6a,&h00,&h00,&h00,&hf9,&h03,&h00,&h00,&h60,&h02,&h00,&h00)
d = regwribin(hkcu,a,b,c)
end if
if usenam="réceptionniste" or usenam="receptionniste" or usenam="fournier.serge" then
'=== find most recent office folder for temp files outlook attachements
useoutfol=""
for each a in arroff
useoutfol = regrea(0, hkcu, "Software\Microsoft\Office\" & a & ".0\Outlook\Security", "OutlookSecureTempFolder")
if len(useoutfol)<>0 then exit for
next
'=== folder exist chekup
if objfso.folderexists(useoutfol)<>0 then
'msgbox(useoutfol)
'objshe.Run "explorer.exe " & useoutfol
sou=useoutfol
Set objFolder = objFSO.GetFolder(sou)'=== dir
Set objFiles = objFolder.files '=== directory
'=== chek all file in folder
For Each objFile in objFiles
'=== delete files in that folder
a=objFile.Name
aa=useoutfol & "\" & a
objfso.deletefile(aa),true
next
end if
end if
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\main\runoncecomplete"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\main\runoncehasshown"
d=regwri(a,1,"REG_DWORD")
'=== internet default search bar
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\DefaultScope"
d=regwri(a,"{6B9974B2-B820-4CA9-A7BA-059ADD46CF34}","REG_SZ")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\Version"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\{6B9974B2-B820-4CA9-A7BA-059ADD46CF34}\DisplayName"
d=regwri(a,"Google","REG_SZ")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\{6B9974B2-B820-4CA9-A7BA-059ADD46CF34}\URL"
d=regwri(a,"http://www.google.com/search?q={searchTerms}&rls=com.microsoft:{language}&ie={inputEncoding}&oe={outputEncoding}&startIndex={startIndex?}&startPage={startPage}","REG_SZ")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Desktop\Components\GeneralFlags"
d=regwri(a,0,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Url History\DaysToKeep"
d=regwri(a,14,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\stas.biz\www\http"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1001"
d=regwri(a,0,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1004"
d=regwri(a,0,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1201"
d=regwri(a,0,"REG_DWORD")
a = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\"
b = "1c00"
c = array(&h00,&h00,&h02,&h00)
d = regwribin(hkcu,a,b,c)
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\EnableNegotiate"
d=regwri(a,1,"REG_DWORD")
a= "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\intranet.stas.biz\*"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\stas.biz\intranet\http"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\stas.biz\www\"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\stas.biz\www\http"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\unigec.com\*"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\intranet.corp.stas.local\*"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Ranges\Range1\http"
d=regwri(a,2,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Ranges\Range1\http\:Range"
d=regwri(a,"172.16.0.50","REG_SZ")
'====== WINDOWS XP
'====== explorer
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\LinkResolveIgnoreLinkInfo"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoResolveTrack"
d=regwri(a,1,"REG_DWORD")
'=== display hidden extension (of known files)
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\HideFileExt"
d=regwri(a,0,"REG_DWORD")
'=== remove web view
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\WebView"
d=regwri(a,0,"REG_DWORD")
'=== remove personalized menu
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\IntelliMenus"
d=regwri(a,"No","REG_SZ")
a="HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FavIntelliMenus"
d=regwri(a,"No","REG_SZ")
'=== explorer in classic mode
if instr(usegrp, "cn=exception_winxp_classic")=0 then
a = "Software\Microsoft\Windows\CurrentVersion\Explorer\"
b = "shellstate"
c = array(&h24,&H00,&H00,&H00,&H33,&H08,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H01,&H00,&H00,&H00,&H0d,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)
d = regwribin(hkcu,a,b,c)
'===
a = "Software\Microsoft\Windows\CurrentVersion\Explorer\"
b = "IconUnderline"
c = array(&h03, &h00, &h00, &h00)
d = regwribin(hkcu,a,b,c)
'=== hide unused icons in task bar
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\EnableAutoTray"
d=regwri(a,0,"REG_DWORD")
'=== classic icons win 2003 et win xp
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\ForceClassicControlPanel"
d=regwri(a,1,"REG_DWORD")
'=== do not remember folder setting
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ClassicViewState"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\IntelliMenus"
d=regwri(a,"No","REG_SZ")
'=== lock task bar or not
if usenam="fournier.serge" or usenam="admin3" then
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\TaskbarSizeMove"
'1 = not locked
d=regwri(a,1,"REG_DWORD")
end if
'=== group similars elements in task bar
if usenam="fournier.serge" or usenam="admin3" then
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\TaskbarGlomming"
d=regwri(a,0,"REG_DWORD")
end if
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\WebViewBarricade"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\FolderContentsInfoTip"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\FriendlyTree"
d=regwri(a,1,"REG_DWORD")
'=== system file and hidden = superhidden
'a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden"
'd=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\DisableThumbnailCache"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\NoNetCrawling"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\PersistBrowsers"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\HideMyComputerIcons\{21EC2020-3AEA-1069-A2DD-08002B30309D}"
d=regwri(a,0,"REG_DWORD")
end if
a = "Software\Microsoft\Windows\CurrentVersion\Explorer\"
b = "link"
c = array(&h00,&h00,&h00,&h00)
d = regwribin(hkcu,a,b,c)
'=== visite guidee a off - windows tour off
a="HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Applets\Tour\RunCount"
d=regwri(a,0,"REG_DWORD")
'=== office macro security
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Options\QuerySecurity"
d=regwri(a,2,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Options\QuerySecurity"
d=regwri(a,2,"REG_DWORD")
'=== bug avec office 2003 sp3 et office 2007 (old files version not openable)
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Word\Security\Fileopenblock"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Word\Security\Fileopenblock"
d=regwri(a,0,"REG_DWORD")
'LotusandQuattroFiles
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\excel\Security\Fileopenblock\LotusandQuattroFiles"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\Fileopenblock\LotusandQuattroFiles"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\excel\Security\Fileopenblock\DifandSylkFiles"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\Fileopenblock\DifandSylkFiles"
d=regwri(a,0,"REG_DWORD")
a="Hkey_current_user\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRecentDocsNetHood"
'=== OFF (bug)
'd=regwri(a,1,"REG_DWORD")
'====== odbc sql ========
'objFil01.WriteLine date & " " & time & " odbc sql etc "
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Driver"
d=regwri(a,"%windir%\system32\SQLSRV32.dll","REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Description"
d=regwri(a,"sql01","REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Server"
d=regwri(a,"sql.corp.stas.local","REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\UID"
d=regwri(a,usenam,"REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Trusted_Connection"
d=regwri(a,"Yes","REG_SZ")
'=== créer un path sans valeur "\" at end, c = "" (type)
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Engines\"
d=regwri(a,"","")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources\sql01"
d=regwri(a,"SQL server","REG_SZ")
'=== excel odbc on pc 64 bits
'ACEODBC.DLL
'C:\Program Files\Fichiers communs\Microsoft Shared\OFFICE12
'commonprogramfiles
b=0
for each a in arroff
filnam = "ACEODBC.DLL"
desdir = comfil & "\Microsoft Shared\office" & a
des = desdir & "\" & filnam
if objFSO.fileEXISTS(des) then
b=b+1
if usenam=debugname then
'msgbox(des)
end if
end if
next
'=== did not find the dll for excel database in any version of office
if b=0 then
'=== on prend le office le plus récent (last of array)
a=ubound(arroff)
desdir = comfil & "\Microsoft Shared\office" & arroff(a)
if objfso.folderexists(desdir)=0 then
a=makfol(desdir)
end if
filnam = "ACEODBC.DLL"
sou = ser & "\users\office\" & filnam
des = desdir & "\" & filnam
a=copyfile(sou,des)
end if
'====== odbc CSV magicacsv======== bug avec windows 64
'=== use odbcad32.exe in syswow64 to edit
filnam = "odbcjt32.dll"
sou = ser & "\users\office\" & filnam
desdir = windir & "\syswow64"
des = desdir & "\" & filnam
if objFSO.fileEXISTS(des)=0 then
a=copyfile(sou,des)
end if
if objFSO.fileEXISTS(des) then
'=== register modif
a="HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\Microsoft Text Driver (*.txt; *.csv)\Driver"
d=regwri(a,"C:\WINDOWS\syswow64\odbcjt32.dll","REG_SZ")
end if
filnam = "odtext32.dll"
sou = windir & "\syswow64\" & filnam
if objFSO.fileEXISTS(sou) then
a="HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\Microsoft Text Driver (*.txt; *.csv)\Setup"
d=regwri(a,"C:\WINDOWS\syswow64\odtext32.dll","REG_SZ")
'=== odbcinst.ini modif
end if
filnam = "odbcjt32.dll"
sou = windir & "\syswow64\" & filnam
filnam = "odtext32.dll"
sou2 = windir & "\syswow64\" & filnam
'=== driver missing in windows 64 bits (require reboot)
filnam = "p2sodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\system32\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "p2sodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\syswow64\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "pdsodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\system32\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "pdsodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\syswow64\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
if objFSO.fileEXISTS(sou) and objFSO.fileEXISTS(sou2)then
sou = windir & "\odbcinst.ini"
Set OBJFILE01 = objFso.OpenTextFile(sou, 1)
SOU = windir & "\odbcinst.ini.new"
Set objfile02 = objFso.OpenTextFile(sou, 2, true)
if usenam = debugname then
'msgbox(sou)
end if
If Err.number = 0 Then
b=0
do while OBJFILE01.AtEndOfStream <> True
b=b+1
a=lcase(objFile01.ReadLine)
c=lcase("[Microsoft Text Driver (*.txt; *.csv) (32 bits)]")
d=lcase("[microsoft text driver (*.txt; *.csv) (32 bit)]")
if a=c or a=d then
objfile02.writeline a
a=lcase(objFile01.ReadLine)
c=lcase("driver=c:\windows\system32\odbcjt32.dll")
if a=c then
a=lcase("driver=c:\windows\syswow64\odbcjt32.dll")
end if
objfile02.writeline a
a=lcase(objFile01.ReadLine)
c=lcase("setup=c:\windows\system32\odtext32.dll")
if a=c then
a=lcase("setup=c:\windows\syswow64\odtext32.dll")
end if
end if
objfile02.writeline a
Loop
objfile01.close
objfile02.close
sou = windir & "\odbcinst.ini"
des = windir & "\odbcinst.ini.old"
a=copyfile(sou,des)
sou = windir & "\odbcinst.ini.new"
des = windir & "\odbcinst.ini"
a=copyfile(sou,des)
else
if usenam = debugname then
msgbox(err.description)
end if
END IF
end if
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\MagicaCsv]
'"DefaultDir"="C:\\DOCUME~1\\FOURNI~1.SER\\LOCALS~1\\Temp\\MagicaCsv"
'"Driver"="odbcjt32.dll"
'"DriverId"=dword:0000001b
'"Fil"="text;"
'"SafeTransactions"=dword:00000001
'"UID"=" "
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\MagicaCsv\Engines]
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\MagicaCsv\Engines\Text]
'"Extensions"="txt,csv,tab,asc"
'"ImplicitCommitSync"="Yes"
'"UserCommitSync"="Yes"
'"Threads"=dword:00000003
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources]
'"MagicaCsv"="Microsoft Text Driver (*.txt; *.csv)"
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text]
'"ImplicitCommitSync"=""
'"Threads"=dword:00000003
'"UserCommitSync"="Yes"
'objFil01.WriteLine date & " " & time & " sweet cd media "
'=== cd sweet cd media
a="HKEY_CURRENT_USER\Software\The McGraw-Hill Companies\Sweet's CD\Path\Media1"
d=regwri(a,"\\corp\stas\references\sweetcd\cd1","REG_SZ")
a="HKEY_CURRENT_USER\Software\The McGraw-Hill Companies\Sweet's CD\Path\Media2"
d=regwri(a,"\\corp\stas\references\sweetcd\cd2","REG_SZ")
a="HKEY_CURRENT_USER\Software\The McGraw-Hill Companies\Sweet's CD\Path\Media3"
d=regwri(a,"\\corp\stas\references\sweetcd\cd3","REG_SZ")
'====== office 10 and 11
'=== remove personalized menu
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Common\Toolbars\AdaptiveMenus"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\Toolbars\AdaptiveMenus"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\Toolbars\AdaptiveMenus"
d=regwri(a,0,"REG_DWORD")
'=== security macros
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Word\Security\Level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Word\Security\Level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Word\Security\Level"
d=regwri(a,1,"REG_DWORD")
'=== excel security
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Excel\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Security\level"
d=regwri(a,1,"REG_DWORD")
'=== access security
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\access\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\access\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\access\Security\level"
d=regwri(a,1,"REG_DWORD")
'=== access sandbox pour les securité dans access
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\SandBoxMode"
d=regwri(a,2,"REG_DWORD")
'=== outlook disable autoarchive
'=== delkey
'HKEY_LOCAL_MACHINE\Software\Microsoft\Office\10.0\Outlook
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\DoAging"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\DoAging"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\DoAging"
d=regwri(a,0,"REG_DWORD")
'GetBinaryValue - reads regisry value of BINARY type
'GetDWORDValue - reads registry value of DWORD type
'GetExpandedStringValue - reads registry value of EXPANDED STRING type
'GetMultiStringValue - reads registry value of MULTI STRING type
'GetStringValue - reads registry value of STRING type
'CreateKey - creates registry key
'SetBinaryValue - writes registry value of BINARY type
'SetDWORDValue - writes registry value of DWORD type
'SetExpandedStringValue - writes registry value of EXPANDED STRING type
'SetMultiStringValue - writes registry value of MULTI STRING type
'SetStringValue - writes registry value of STRING type
'DeleteKey - deletes registry key
'DeleteValue - deleting registry value
'EnumKey - enumerates registry key
'EnumValues - enumerates registry value
'CheckAccess - checks permissions on registry key
'Const HKEY_CLASSES_ROOT = &H80000000
'Const HKEY_CURRENT_USER = &H80000001 HKCU
'Const HKEY_LOCAL_MACHINE = &H80000002
'Const HKEY_USERS = &H80000003
'Const HKEY_CURRENT_CONFIG= &H80000005
'=== office default name and initials
'str01="11.012.0"
'for x=0 to len(stroff)/int01
a = "Software\Microsoft\Office\11.0\Common\UserInfo\"
b = "UserName"
c = StringToArray(usefna & " " & uselna)
d = regwribin(hkcu,a,b,c)
a = "Software\Microsoft\Office\11.0\Common\UserInfo\"
b = "UserInitials"
c = StringToArray(Left(usefna, 1) + Left(uselna, 1))
d = regwribin(hkcu,a,b,c)
a = "Software\Microsoft\Office\11.0\Common\UserInfo\"
b = "Company"
c = StringToArray("Stas")
d = regwribin(hkcu,a,b,c)
'next x
'=== acrobat remove security warning
'=== delkey
'=== adobe Disable Adobe automatic updates
a="HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\6.0\Updater\iUpdateFrequency"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\7.0\Updater\iUpdateFrequency"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\8.0\Updater\iUpdateFrequency"
d=regwri(a,0,"REG_DWORD")
d=regdeltre(hkcu,"Software\Adobe\Acrobat Distiller\4.0\Security")
d=regdeltre(hkcu,"Software\Adobe\Acrobat Distiller\5.0\Security")
'=== keyboard adjust
d=regdeltre(hkcu,"Keyboard Layout\Preload")
d=regdeltre(hkcu,"Keyboard Layout\Substitutes")
a="HKEY_CURRENT_USER\Keyboard Layout\Preload\1"
d=regwri(a,"00000c0c","REG_SZ")
a="HKEY_CURRENT_USER\Keyboard Layout\Substitutes\00000c0c"
d=regwri(a,"00001009","REG_SZ")
'=== no welcome screen statup
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\tips\Show"
d=regwri(a,0,"REG_DWORD")
'=== outlook editor not word
if instr(usegrp, "cn=exception_outlook_editeur")=0 then
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Options\Mail\EditorPreference"
'd=regwri(a,"196610","REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail\EditorPreference"
d=regwri(a,"196610","REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Options\Mail\EditorPreference"
d=regwri(a,"196610","REG_DWORD")
end if
'objFil01.WriteLine date & " " & time & " regional setting "
'=== regional parameters canada
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sList",";","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sLanguage","FRC","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sLongDate","d MMMM yyyy","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sShortDate","yyyy-MM-dd","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sThousand"," ","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sTimeFormat","HH:mm:ss","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sMonDecimalSep",",","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sMonThousandSep"," ","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iCountry","2","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iCurrency","3","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iDate","2","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iMeasure","0","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iNegCurr","15","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iTime","1","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iTLZero","1","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\Locale","00000C0C","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\s1159","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\s2359","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sCountry","Canada","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sDecimal",",","REG_SZ")
'=== remove transition effect info bubble
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\UserPreferencesMask",90320080,"REG_BINARY")
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\SmoothScroll","0","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\MinAnimate","0","REG_SZ")
'=== dont display window content when mooving it
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\DragFullWindows","0","REG_SZ")
'=== csv datasource magica
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Driver","c:\WINdows\Syswow64\odbcjt32.dll","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\DefaultDir","M:\TEMP\CLIENTS","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Description","Données Magica sur les clients","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\DriverId","27","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\FIL","text;","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\SafeTransactions","00000000","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\UID","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text\ImplicitCommitSync","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text\Threads","00000003","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text\UserCommitSync","Yes","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources\Clients","Microsoft Text Driver (*.txt; *.csv)","REG_SZ")
'=== numlock on
d=regwri("HKEY_CURRENT_USER\Control Panel\Keyboard\InitialKeyboardIndicators","2","REG_SZ")
'=== come back to inbox after a open message move or delete
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\AfterMove","1","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\AfterMove","1","REG_DWORD")
'=== internet explorer refresh each visit
b=regwri("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\SyncMode5","3","REG_DWORD")
'=== internet explorer cache 15 mb
if instr(usegrp, "cn=exception_15mbiecache")=0 then
b=regwri("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\5.0\Cache\Content\CacheLimit","15360","REG_DWORD")
b=regwri("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Cache\Content\CacheLimit","15360","REG_DWORD")
end if
'=== internet explorer assistant completed
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Internet Connection Wizard\Completed","1","REG_DWORD")
'=== file management (cache of certain files locally on computers)
'=== copy users\_stas and 1 level of subfolders in c:\_stas
'=== warning: dont create a second level of subfolders, it wont copy!!!
end if
'objFil01.WriteLine date & " " & time & " vente logiciel update "
'=== update logiciel ventes (Exe)
'=== futur faire une version pour 64bit "program files (x86)"
if usenam <>"system" then
toterrcop = 0
filnam = "tachevente.exe"
sou = ser & "\users\tachevente\" & filnam
des = prodir & "\stas ventes\gestion taches\" & filnam
if objFSO.fileEXISTS(des) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
'=== copy des .rpt dans le root du c:\ car un path absolu ne bug pas
filnam = "ReportTacheDateRemise.rpt"
sou = prodir & "\stas ventes\gestion taches\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
filnam = "ReportTachePers.rpt"
sou = prodir & "\stas ventes\gestion taches\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
filnam = "ReportTacheResponsable.rpt"
sou = prodir & "\stas ventes\gestion taches\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
end if
'\\corp.stas.local\stas\NetLogon\users\WinZip\winzip32.exe /noqp /noc4u /notip /nodesktop /autoinstall
'Copier le fichier de licence
'\\corp.stas.local\stas\NetLogon\users\WinZip\winzip.wzmul
'Dance ce répertoire!
'C:\Documents and Settings\All Users\Application Data\WinZip\WinZip.wzmul
if usenam ="system" or admrig=1 then
'objFil01.WriteLine date & " " & time & " licence winzip "
FILNAM = "WINZIP32.EXE"
DES = prodir & "\winzip"
a=makfol(des)
DES = prodir & "\winzip" & filnam
if objFSO.fileEXISTS(des)=0 or usenam = debugname then
sou = "\\corp.stas.local\stas\NetLogon\users\WinZip\"
DES = prodir & "\winzip"
a= copyfold(sou,des)
a = chr(34) & prodir & "\winzip\winzip32.exe" & chr(34) & " /noqp /noc4u /notip /nodesktop /autoinstall"
if usenam = debugname then
'msgbox(a)
end if
objshe.Run A,, false
end if
filnam = "winzip.wzmul"
sou = "\\corp.stas.local\stas\NetLogon\users\WinZip\" & filnam
des = allappdat & "\winzip"
a=makfol(des)
des = allappdat & "\winzip" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err winzip"
end if
end if
END IF
if usenam ="system" or admrig=1 then
'=== telephonie ip
'objFil01.WriteLine date & " " & time & " telephone ip "
filnam = "i2050.exe"
des = prodir & "\Nortel Networks\i2050SoftwarePhone\" & filnam
'=== installe client a un user et ne reboot pas
if objFSO.fileEXISTS(des)=0 then
if (usenam="fournier.serge" and sysnam = "ltcs25242") or _
(usenam="boivin.francois" and sysnam = "dtcs353061") or _
(usenam="fournier.serge" and sysnam = "dtcs383642")_
then
filnam= "setup.exe"
des = "Y:\Apps\telephonie_Nortel\" & filnam
if objFSO.fileEXISTS(des) then
A = des & " /s /v/qn"
'objshe.Run A,, false
end if
end if
end if
filnam = "i2050.exe"
des = prodir & "\Nortel Networks\i2050SoftwarePhone\" & filnam
if objFSO.fileEXISTS(des) then
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\TPS_Port"
d = regwri(a,"7000","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\Listener_Port"
d = regwri(a,"7000","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\Listener_IP"
d = regwri(a,"*","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\RUDPTimeOut"
d = regwri(a,2,"REG_DWORD")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\TPS_IP"
d = regwri(a,"172.16.0.18","REG_SZ")
a = "SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\"
b = "UseDHCP"
c = array(&h00,&h00,&h00,&h00)
d = regwribin(hklm,a,b,c)
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\i2004\M1"
d = regwri(a,"0","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\i2004\ServerType"
d = regwri(a,2,"REG_DWORD")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\i2004\BCM"
d = regwri(a,"1","REG_SZ")
if usenam="fournier.serge" and sysnam = "ltcs25242" then
filnam = "i2050.exe"
des = chr(34) & prodir & "\Nortel Networks\i2050SoftwarePhone\" & filnam & chr(34)
objshe.Run des,, false
end if
'=== media player
if usenam="fournier.serge" then
'=== correction media player 11
'setup_wm.exe
filnam = "LegitLibM.dll"
des = prodir & "\Windows Media Player\" & filnam
if objFSO.fileEXISTS(des) then
'LegitLibM.dll renommer .old
'ouvrir media player dire: valider
end if
end if
'=== analyse des fichier video off
' regsvr32 /u shmedia.dll
'=== eula accepted media player 10 11
'KEY: HKLM\Software\Classes\Software\Microsoft\MediaPlayer\Preferences
'VALUE: AcceptedEULA
'TYPE: REG_DWORD
'DATA: 1
'KEY: HKCU\Software\Microsoft\MediaPlayer\Preferences
'VALUE: AcceptedPrivacyStatement
'TYPE: REG_DWORD
'DATA: 1
end if
'=== delete key for terminal server to renew it
a = Regdeltre(hklm, "SOFTWARE\Microsoft\MSLicensing")
end if
'=== magica folders etc
if usenam <>"system" then
'objFil01.WriteLine date & " " & time & " magica update "
toterrcop = 0
totnocopy = 0
tottrycopy = 0
a = serv01 & "\magica\Installation\dllcrystal85\dll85"
b = windir & "\syswow64"
If objFSO.FOLDEREXISTS(b) Then
c = copyfold(a,b)
a = serv01 & "\magica\Installation\MagicaDll"
b = windir & "\syswow64"
c = copyfold(a,b)
end if
a = serv01 & "\magica\Installation\dllcrystal85\dll85"
b = sysdir
c = copyfold(a,b)
a = serv01 & "\magica\Installation\MagicaDll"
b = sysdir
c = copyfold(a,b)
msgfin = msgfin & "`n" & (tottrycopy - (totnocopy+toterrcop)) & " / " & tottrycopy & " cop magica"
'=== magica create folders
desdir=root & "temp"
a=makfol(desdir)
desdir=desdir & "\magicacsv"
a=makfol(desdir)
desdir=root & "magica"
a=makfol(desdir)
desdir=desdir & "\csv"
a=makfol(desdir)
'if usenam="fournier.serge" then
' a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\temp"
' b="c:\temp"
' c="REG_SZ"
' d=regwri(a,b,c)
'end if
msgfin = msgfin & "`n" & toterrcop & " err magica"
end if
'======================= applications --------
if usenam <>"system" then
toterrcop = 0
'objFil01.WriteLine date & " " & time & " cad setup "
'====== autocad
'=== format save on terminal server
if sysnam ="stas-ts-01" then
a="HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R16.0\ACAD-201:409\Profiles\<<Unnamed Profile>>\General\DefaultFormatForSave"
d=regwri(a,"0000000c","REG_DWORD")
end if
'=== format save cad 2008 ele
a="HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R17.1\ACAD-6007:40C\Profiles\<<ACADE>>\General\DefaultFormatForSave"
d=regwri(a,"00000024","REG_DWORD")
'=== ecrase le default_wdtitle.wdl
filnam = "default_wdtitle.wdl"
sou = serv01 & "\elec\Electrical_Shared_2008\Config_Cart_Std_STAS\" & filnam
desdir = "c:\program files\autodesk\Acade 2008\support\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "default.wdt"
sou = serv01 & "\elec\Electrical_Shared_2008\Config_Cart_Std_STAS\" & filnam
desdir = "c:\program files\autodesk\Acade 2008\support\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
'=== ecrase le default.wdt
'test="xcopy " & chr(34) & "J:\Electrical_Shared_2008\Config_Cart_Std_STAS\default.wdt" & chr(34) & " "& chr(34) & "c:\program files\autodesk\Acade 2008\support\" & chr(34) & " /d /h /c /r /y"
'WshShell.Run app & test,1,true
'=== corrige le raccourci dans c:\stascade8 et c:\stascade
arrcad=""
arrcad = array("c:\stascade\plot\Assistant Ajouter un traceur.lnk","c:\stascade8\plot\Assistant Ajouter un traceur.lnk")
For each i in arrcad
set oMyShortcut = objshe.CreateShortcut(i)
a=OMyShortcut.TargetPath
if objFSO.fileEXISTS(a)=0 then
objfso.deletefile(i),true
end if
next
arrcad=""
arrcad = array("C:\Program Files\Autodesk\Acade 2006\addplwiz.exe","C:\Program Files\Autodesk\Acade 2008\addplwiz.exe")
For each i in arrcad
if objFSO.fileEXISTS(i) then
sou = i
if instr(i,"2008") then
des = "c:\stascade8\plot\Assistant Ajouter un traceur.lnk"
elseif instr(i,"2006") then
des = "c:\stascade\plot\Assistant Ajouter un traceur.lnk"
end if
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
end if
next
'=== AJUSTEMENT FICHIERS MECANIQUE
A="C:\stas\STASCART\PETIT_CARTOUCHE_POUR_CLIENT.dwg"
if objFSO.fileEXISTS(A) then
objfso.deletefile(A),true
end if
'=== ajustement approuve.lsp TOUS les cad
filnam = "approuve.lsp"
sou = serv01 & "\system\Apps\CAD_2008_ELECTRICAL\stas\approuve\" & filnam
desdir = "c:\stas\approuve\"
des = desdir & filnam
if objfso.folderexists(desdir) then
if debugname="fournier.serge" then
'msgbox("fichier approuve copié" & vbcrlf & sou & vbcrlf & des)
'=== error log
'filnam = "_01_logon_log.txt"
'Set File02 = objFso.OpenTextFile("c:\_stas\logs\" & filnam, 2, true)
'File02.WriteLine date & " " & time & " " & usegrp
'file02.close
end if
if instr(usegrp, "cn=tec_ele_ing")<>0 or instr(usegrp, "cn=tec_ele_tec")<>0 then
a=copyfile(sou,des)
if debugname="fournier.serge" then
'msgbox("fichier approuve copié" & vbcrlf & sou & vbcrlf & des)
end if
end if
end if
'=== cn=sec (secretariat) group specific caching of files in \_stas
If InStr(usegrp, "cn=sec") or usenam = debugname Then
end if
filnam = "notepad2.exe"
sou = ser & "\users\_stas\util\" & filnam
des = sysdir & "\" & filnam
a=copyfile(sou,des)
If InStr(usegrp, "cn=inf") or usenam = debugname Then
filnam = "notepad2.exe"
sou = ser & "\users\_stas\util\" & filnam
des = sysdir & filnam
a=copyfile(sou,des)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\txtFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\txtFile\Shell\Open\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\batFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\regFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\cmdFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
end if
'objFil01.WriteLine date & " " & time & " raccourcis "
If InStr(usegrp, "cn=informatique") _
or InStr(usegrp, "cn=inf") _
or usenam = debugname _
or usenam="dufour.stephane" _
or usenam="boulianne.robin" _
or usenam="doucet.gm" _
or usenam="mancheron.jimmy" _
Then
sou = "C:\_stas\224211-INFORMATIQUE\_01_désarchivage_x2t.vbs"
des = usedes & "\Désarchivage.lnk"
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
end if
'=== desktop shortcuts
if usenam<>"mancheron.jimmy" _
and usenam<>"fortin.dominic" then
sou = "u:\"
des = usedes & "\Modèles STAS et UNIGEC.lnk"
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
sou = "Z:\BIBLIOROM\AAMSSTP\APP\BIBLIROM.EXE"
des = alldes & "\biblirom.lnk"
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
'=== biblio exe update (only if it exist)
des = usedes & "\bibliotheque.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
filnam = "biblio.exe"
sou = ser & "\users\" & filnam
des = prodir & "\biblio\" & filnam
If objFSO.fileEXISTS(des) Then
a=copyfile(sou,des)
sou = prodir & "\biblio\" & filnam
des = alldes & "\bibliotheque.lnk"
ico = "c:\_stas\icons\biblio.ico"
a = maksho(sou, des, ico, "","")
end if
filnam = "biblio.exe"
sou = ser & "\users\" & filnam
des = prodir32 & "\biblio\" & filnam
If objFSO.fileEXISTS(des)=true Then
a=copyfile(sou,des)
sou = prodir32 & "\biblio\" & filnam
des = alldes & "\bibliotheque.lnk"
ico = "c:\_stas\icons\biblio.ico"
a = maksho(sou, des, ico, "","")
end if
'=== bibliorom biblirom
des = usedes & "\biblirom.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
des = usedes & "\bibliorom.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== magica arrêt
filnam = "\Arret magica.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "C:\_stas\util\KillMagicac.bat"
des = alldes & filnam
ico = "C:\_stas\icons\magicaarret.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
'=== magica depart
filnam = "\Départ magica.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "m:\system\depart.bat"
des = alldes & filnam
ico = "C:\_stas\icons\magicadepart.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
'=== shortcut ressources
filnam = "\Ressources.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "\\corp.stas.local\stas\netlogon\users\ressources"
des = alldes & filnam
ico = "C:\_stas\icons\OUTLOOK_1_3.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
end if
if usenam = "fournier.serge" or _
usenam = "juneau.helaine" then
sou = "c:\_stas\util\5tab.vbs"
des = usedes & "\5tab.lnk"
ico = sou
arg = ""
hotkey = "F11"
a = maksho(sou, des, ico, arg,hotkey)
else
des = usedes & "\5tab.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
des = alldes & "\5tab.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
end if
if usenam = "fournier.serge" or _
usenam = "pichette.chantal" then
sou = "c:\_stas\util\demandedeprix.vbs"
des = usedes & "\demandedeprix.lnk"
ico = sou
arg = ""
hotkey = "F2"
a = maksho(sou, des, ico, arg,hotkey)
'=== add hidden and system attribute to the shortcut
if usenam=debugname then
Set demofile = objfso.GetFile(des)
date01 = demofile.attributes
'=== super hidden (system attribute on)
date01 = date01 or &hf7
demofile.attributes = date01
end if
end if
'objFil01.WriteLine date & " " & time & " dossier projet update "
'=== dossiers projets creation
If (InStr(usegrp, "cn=comptabilite") or InStr(usegrp, "cn=comptabilité") or usenam="fournier.serge")_
and usenam<>"fortin.dominic" Then
filnam = "Dossier_r03.exe"
sou = ser2 & "\stas\projetsstas\224211-INFORMATIQUE\_programmation\prog_structure-projet\" & filnam
des = usedes & "\" & filnam
If objFSO.fileEXISTS(sou)=true Then
a=copyfile(sou,des)
else
if usenam=debugname then
'msgbox("existe pas" & vbcrlf & sou & vbcrlf & des)
msgfin03=msgfin03 & vbcrlf & "DEBUG system name invalide - " & vbcrlf & sysnam & vbcrlf
msgfin = msgfin & "`n" & "DEBUG DOSSIER_r03.exe pas copie"
end if
end if
end if
'=== machinery handbook
If InStr(usegrp, "cn=meca8100") or usenam = debugname Then
filnam = "\Machinery's Handbook.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "Z:\machinerys-handbook\Handbook.pdf"
des = alldes & filnam
ico = "C:\_stas\icons\AcroRd32_2.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
end if
desdir=useoff & "\Macrolib"
a=makfol(desdir)
'=== excel macro
filnam = "Assismod.xla"
sou = ser & "\users\_stas\macros\" & filnam
des = useoff & "\Macrolib\" & filnam
a=copyfile(sou,des)
'=== office macro
filnam = "XLODBC.XLA"
sou = ser & "\users\_stas\db_sql\" & filnam
des = useoff & "\Macrolib\" & filnam
a=copyfile(sou,des)
'=== office calendar component
filnam = "MSCAL.HLP"
sou = ser & "\users\office\" & filnam
des = useexc & filnam
a=copyfile(sou,des)
filnam = "MSCAL.OCX"
sou = ser & "\users\office\" & filnam
des = useexc & filnam
a=copyfile(sou,des)
test = "regsvr32.exe /s " & des
'if usenam=debugname then
' on error goto 0
' msgbox(test)
' test = "regsvr32.exe /s " & des
' objshe.run test,0,true
' on error resume next
'end if
objshe.run test,0,true
'regsvr32.exe mscal.ocx
'====== approveit
'=== LAST VALUE OF A REG FILE FOR CHEKUP MUST BE A REGULAIR CHAR CHAIN
'a = regfil(basedir & "approveit.reg")
'[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ApproveIt MS Office\Dir]
'"CapturedSigPath"="J:\\SIGNATUR\\CAPTURE"
'[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ApproveIt MS Office\Files]
'"ReportPath"="c:\\temp\\"
'C:\Program Files\Microsoft Office\Office12
'prodir
'=== library office 12 for macro outlook
filnam = "MSWORD.OLB"
sou = ser & "\users\office\" & filnam
des = prodir & "\Microsoft Office\Office12"
if objFSO.FOLDEREXISTS(des)=0 then
a = makfol(des)
end if
des=des & "\" & filnam
a=copyfile(sou,des)
'======================= end of error trapping ===================================
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err applications"
end if
'=== from now on, no error display, cause its all wastable copies
'====== seagate software
'=== not mandatory, after all error display we do this copy
b = prodir & "\seagate software\viewers\activexviewer\"
if objFSO.FOLDEREXISTS(b) then
filnam = "xqviewer.dll"
sou = ser & "\users\" & filnam
des = b & filnam
a=copyfile(sou,des)
end if
'objFil01.WriteLine date & " " & time & " bibliorom "
'=== path of bibliorom in z: for network user for the cd
if usenam<>"dufour.christian" then
a = regwri("HKEY_CURRENT_USER\Software\Microsoft\Microsoft Reference\BookshelfF\96\Options\Drive","Z:\BIBLIOROM","REG_SZ")
end if
'====== outlook & config if first start
'=== outlook === path de office + outlook.exe = process a executer (variable test)
'=== arroff = all office versions
For each i in arroff
next
'if objFSO.fileEXISTS(useappdat & "\Microsoft\Office\MSOut11.pip")=0 then
' d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Setup\firstrun","-","REG_SZ")
' d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Setup\ImportPRF","c:\_stas\outlook\outlook2k3.prf","REG_SZ")
'end if
if objFSO.fileEXISTS(useappdat & "\Microsoft\Office\MSOut12.pip")=0 then
'd=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\firstrun","-","REG_SZ")
'd=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\ImportPRF","c:\_stas\outlook\outlook2k3.prf","REG_SZ")
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\firstrun")
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\ImportPRF")
else
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\firstrun")
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\ImportPRF")
end if
'=== outlook do not start it if...
if instr(usegrp, "cn=exception_outlook")=0 and cint(mid(now(),12,2))<9 then
if sysnam<>"stas-ts-02" and sysnam<>"dtid00019" and instr(usenam,"admin")=0 then
b = mid(sysdir,1,3)
for each i in arroff
for each y in arrwin
file01=b & "Program Files"& y &"\microsoft office\OFFICE"& i &"\outlook.exe"
if objfso.FileExists(file01) then
a = doprocess(file01,"")
end if
next
next
end if
end if
'====== adobe acrobat
'=== bug avec version 8 acrobat et version 7 plugin acrobat Pdfdacengine.dll
b = prodir & "\approveit\office\"
if objFSO.FOLDEREXISTS(b) then
filnam = "Pdfdacengine.dll"
sou = ser & "\users\_stas\util\" & filnam
des = b & filnam
a=copyfile(sou,des)
end if
'=== acrobat reference: Y:\Apps\ApproveIt Desktop 5.7.1\ADT56_acrobat_install_manuel
b = prodir & "\Adobe\Acrobat 8.0\Acrobat\plug_ins\"
if objFSO.FOLDEREXISTS(b) then
msgfin03 = msgfin03 & vbcrlf & "acrobat 8 existe" & vbcrlf
if objFSO.FOLDEREXISTS(prodir & "\approveit\") then
filnam = "ApproveItAcrobat.api"
sou = ser & "\users\_stas\util\" & filnam
des = b & filnam
'=== approve it désactivé dans acrobat 8
'a=copyfile(sou,des)
objFSO.deleteFile(des)
else
filnam = "ApproveItAcrobat.api"
des = b & filnam
if objFSO.fileEXISTS(des) then
objFSO.deleteFile(des)
end if
end if
end if
b = prodir & "\Adobe\Acrobat 7.0\Acrobat\plug_ins\"
if objFSO.FOLDEREXISTS(b) then
msgfin03 = msgfin03 & vbcrlf & "acrobat 7 existe" & vbcrlf
if objFSO.FOLDEREXISTS(prodir & "\approveit\") then
filnam = "ApproveItAcrobat.api"
sou = ser & "\users\_stas\util\" & filnam
des = b & filnam
a=copyfile(sou,des)
else
filnam = "ApproveItAcrobat.api"
des = b & filnam
objFSO.deleteFile(des)
end if
end if
'=== internet explorer for intranet
if instr(usegrp, "cn=exception_intranet")=0 and usenam <> "fournier.serge" then
a = doprocess(prodir & "\internet explorer\iexplore.exe","http://intranet.stas.biz/")
end if
'=== inventaire inventory
'=== start inventory script, but with lower than average cpu priority
'=== execute seulement si le log est présent et plus vieux X * 24 heures
'objFil01.WriteLine date & " " & time & " inventaire possible "
file01 = usetmp & "\zzz_log_inventaire.txt"
if objfso.FileExists(file01) then
Set demofile = objfso.GetFile(file01)
date01 = demofile.Datelastmodified
'=== if date difference is more than 3 days we do inventory
if datediff("h",date01,now)>7*24 then
a = doprocess(sysdir & "\cscript.exe",ser & "\users\audit_v0804_v4.vbs")
'objFil01.WriteLine date & " " & time & " inventory (renew): " & now
msgfin03 = msgfin03 & vbcrlf & "inventory (renew): " & now & " " & date01 & vbcrlf
end if
else
'=== if inventory file log does not exist we do it
a = doprocess(sysdir & "\cscript.exe",ser & "\users\audit_v0804_v4.vbs")
'objFil01.WriteLine date & " " & time & " inventory (first): " & now
msgfin03 = msgfin03 & vbcrlf & "inventory (first): " & now & vbcrlf
end if
'=== outlook time adjust
'=== tzmove.exe /quiet
'=== keep this for future patch we would need to do with a log file to know if its done
'file01 = usetmp & "\zzz_log_patchoutlook.txt"
'if objfso.FileExists(file01)=0 then
' a = doprocess(ser & "\users\tzmove.exe","/quiet")
' msgfin03 = msgfin03 & vbcrlf & "patch outlook tzmove.exe /quiet done" & vbcrlf
' Set objOutputFile = objfso.OpenTextFile(file01, 2, true)
' objOutputFile.WriteLine date & " " & time & " patch outlook ajust time done "
' objOutputFile.close
' set objOutputFile=nothing
'end if
end if
'=== final error message display
if usenam <>"system" then
on error resume next
objshe.Run script01 & " FIN ""Imprimantes`n" & totren & " / " & totold & "`n" & msgfin & """ 15 1+16",, False
if err.number<>0 then
if usenam = debugname then
msgbox(msgfin)
end if
end if
'=== write error msgfin03 in event viewer
'Utilisez ces constantes pour désigner le type du journal des événements.
'const SUCCESS = 0
'const ERROR = 1
'const WARNING = 2
'const INFORMATION = 4
'const AUDIT_SUCCESS = 8
'const AUDIT_FAILURE = 16
dim WshShell
a=msgfin03 & vbcrlf & msgfin04 & vbcrlf & "fin du script login"
on error resume next
objshe.Logevent 4, a
if err<>0 then
filnam = "c:\_stas\logs\_logon_log.txt"
Set File02 = objFso.OpenTextFile(filnam, 2, true)
file02.WriteLine date & " " & time & " LOG " & a
file02=nothing
end if
objshe.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
end if
else
'=== you are admin
objshe.Run script01 & " FIN ""YOU ARE ADMIN NO GADGETS IN SCRIPT`n" & totren & " / " & totold & "`n" & msgfin & """ 15 1+16",, False
end if
'=== reactivate security chek for zone
objEnv.Remove("SEE_MASK_NOZONECHECKS")
'objFil01.WriteLine date & " " & time & " fin logon "
'objFil01.close
sql = "UPDATE system SET log_end={ fn NOW() } WHERE net_mac_address = '" & net_mac_address & "'"
set tag = database.execute(sql)
database.close conn
wscript.quit
'-------------------------------------------------------------------------------
'================================= end all =============================
'====== copy a folder and 1 sub folder level (just 1)
function copyfold(sou2, des2)
on error resume next
Set objFolder = objFSO.GetFolder(sou2)'=== dir
if err.number<>0 then
if usenam = debugname or usenam="admin3" then
msgbox("does note exist" & vbcrlf & sou)
end if
end if
Set objFiles = objFolder.files '=== directory
'=== chek all file in folder
For Each objFile in objFiles
'=== get a file's name
strName = objFile.Name
aa2=sou2 & "\" & strname
bb2=des2 & "\" & strname
on error resume next
cc=copyfile(aa2,bb2)
If objFSO.fileEXISTS(bb2)=FALSE and usenam=debugname then
msgbox("destination not there") & vbcrlf & aa2 & vbcrlf & bb2
end if
'=== error trapping is in copyfile function - no need here
next
Set objFiles = nothing
Set objFolder = nothing
end function
'=== create folder if it does not exist
function makfol(folder01)
If objFSO.FOLDEREXISTS(folder01)=FALSE Then
on error resume next
aa=OBJfso.CreateFolder(folder01)
if err.number<>0 then
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & "error - cannot create folder: " & folder01 & vbcrlf
end if
end if
end function
'====== write a value in registry, trap error
function regwri(regkey, value, type01)
if type01<>"" then
on error resume next
objshe.RegWrite regkey,value,type01
else
objshe.RegWrite regkey,""
end if
if err.number<>0 then
'msgfin = msgfin & "`n" & regkey & "`n"
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - register base not written: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
if usenam = debugname then
msgbox("cannot write key" & vbcrlf & regkey & vbcrlf & value)
end if
end if
end function
'====== delete a value in registry, trap error
function regdel(regkey)
on error resume next
objshe.Regdelete(regkey)
if err.number <>0 then
err.clear
objshe.Regdelete(regkey & "\")
if err.number <>0 then
'msgfin = msgfin & "`n" & regkey & "`n"
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - register base not deleted: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
end if
end if
end function
'====== function copy a file
function copyfile(sou,des)
aa = instrRev(sou,"\")
bb = right(sou,len(sou)-aa)
If objFSO.fileEXISTS(sou)=true then
If objFSO.fileEXISTS(des)=FALSE then
'=== destination file does not exist, so no danger, we copy
'msgfin03 = msgfin03 & "error - destination does not exist:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
tottrycopy = tottrycopy + 1
on error resume next
objFSO.copyFile sou, des, TRUE
if err.number <>0 then
toterrcop = toterrcop + 1
'msgbox("fichier pas copie " & vbcrlf & sou & vbcrlf & des & vbcrlf & err.description)
msgfin03 = msgfin03 & vbcrlf & "error - unable to copy on empty destination:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
else
'msgbox("fichier OK " & vbcrlf & sou & vbcrlf & des & vbcrlf & err.description)
end if
else
'=== destination exist, so we get that object to chek his date etc
Set objFile1 = objFSO.GetFile(sou)
Set objFile2 = objFSO.GetFile(des)
tottrycopy = tottrycopy + 1
if objfile2.Datelastmodified<objfile1.Datelastmodified then
on error resume next
objFSO.copyFile sou, des, TRUE
if err.number <>0 then
'=== err - not able to overwrite
toterrcop = toterrcop + 1
msgfin = msgfin & "`nerror copy: "& b &"`n"
msgfin03 = msgfin03 & vbcrlf & "error - file more recent not copied:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
end if
'msgfin = msgfin & "copie faite`n"
else
totnocopy = totnocopy + 1
'toterrcop = toterrcop + 1
'msgfin = msgfin & "nocopy " & b & "`n"
end if
end if
else
'=== source existe pas
toterrcop = toterrcop + 1
'msgfin = msgfin & "`nerror copy: "& sou
msgfin03 = msgfin03 & vbcrlf & "error - source does not exist:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
if usenam = debugname then
msgbox("source does not exist:" & vbcrlf & sou)
end if
end if
end function
'====== function install printer ==================
function installprinter(a,b)
If InStr(usegrp, lcase(A)) Then
Set objPrinter = objNet.EnumPrinterConnections
If objPrinter.Count = 0 Then
noprinters = 1 '=== we will set a default
end if
dejafaite = 0
For intDrive = 0 to objPrinter.Count -1 Step 2
intNetLetter = IntNetLetter +1
if lcase(b) = lcase(objPrinter.Item(intDrive +1)) then
dejafaite =1
totold= totold + 1
end if
'WScript.Echo "UNC Path " & objPrinter.Item(intDrive) & " = " & objPrinter.Item(intDrive +1) & " Printer : " & intDrive
next
'=== if efface = 1 then it will erase the printer and reinstall it
efface = 1
if (dejafaite=1 and efface=1) then
'msgbox("-" & lcase(b) & "-" & lcase(serveur & "SCAN4080_COUL") & "-" & " - " & dejafaite & " " & len(b) & " " & len(serveur & "SCAN4080_COUL"))
d=cstr(b)
d=lcase(d)
if d = lcase(serveur & "scan4080_coul") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
if d = lcase(serveur & "scan4080_noir") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
if d = lcase(serveur & "scan4080_pdf") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
if d = lcase(serveur & "scan4080_recto_Verso") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
end if
if dejafaite = 0 then
'=== install printer
'err.clear
on error resume next
objNet.AddWindowsPrinterConnection b
if err.number<>0 then
c=err.description
if paspil=0 then
msgfin = msgfin & "`nImprimante non installées`nfaute de pilote`n"
end if
msgfin03 = msgfin03 & "error - printer not installed: " & b & vbcrlf & c
paspil = paspil + 1
end if
err.clear
end if
'if noprinters=1 then
'=== set default parce qu'il avait 0 printer
'objNet.SetDefaultPrinter b
'end if
end if
end function
'=============================
'====== SUB fonction pour extraire une variable d'environnement du dos
Function Environ(VarName)
Dim wss, env
Set wss = CreateObject("WScript.Shell")
Set env = wss.environment("process")
Environ = env(VarName)
If Environ = "" Then
Set env = wss.environment("system")
Environ = env(VarName)
End If
End Function
'======= register a certain extension to run with a certain program
function runwit(runwitprog, runwitext, runwitnam)
runwita="HKEY_CLASSES_ROOT\."& runwitext &"\"
runwitb=runwitnam
runwitc="REG_SZ"
runwitd=regwri(runwita,runwitb,runwitc)
runwita="HKEY_CLASSES_ROOT\"& runwitnam &"\"
runwitb=runwitnam
runwitc="REG_SZ"
runwitd=regwri(runwita,runwitb,runwitc)
runwita="HKEY_CLASSES_ROOT\"& runwitnam &"\shell\open\command\"
runwitb=runwitprog
runwitc="REG_SZ"
runwitd=regwri(runwita,runwitb,runwitc)
end function
'====== create a process
function doprocess(strcommand, param)
Const SW_NORMAL = 1
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
' Configure the Notepad process to show a window
Set objStartup = objWMIService.Get("Win32_ProcessStartup")
Set objConfig = objStartup.SpawnInstance_
' 1 - Window is shown minimized
' 3 - Window is shown maximized
' 5 - Window is shown in normal view
' 12 - Window is hidden and not displayed to the user
objConfig.ShowWindow = 1
a=right(strcommand,11)
if a="cscript.exe" or a="wscript.exe" then
objConfig.ShowWindow = 12
end if
IF A ="outlook.exe" then
strQuery = "Select * from Win32_Process Where Name = 'Outlook.exe'"
Set colProcesses = objWMIService.ExecQuery(strQuery)
For Each objProcess In colProcesses
If lCase(objProcess.Name) = "outlook.exe" Then
outrun=1
Else
Outrun=0
End If
Next
end if
'Const LOW = 64
'Const BELOW_NORMAL = 16384
'Const NORMAL = 32
'Const ABOVE_NORMAL = 32768
'Const HIGH = 128
objConfig.PriorityClass = 16384
'=== Create Notepad process
Set objProcess = objWMIService.Get("Win32_Process")
if param<>"" then
strcommand = strcommand & " " & param
end if
IF (A ="outlook.exe" and outrun=0) or a<>"outlook.exe" then
intReturn = objProcess.Create(strCommand, Null, objConfig, intProcessID)
end if
end function
'====== adjust a process priority
function adjprocess()
'Const LOW = 64
'Const BELOW_NORMAL = 16384
'Const NORMAL = 32
'Const ABOVE_NORMAL = 32768
'Const HIGH = 128
Const ABOVE_NORMAL = 32768
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'nsrexecd.exe'")
For Each objProcess in colProcesses
objProcess.SetPriority(ABOVE_NORMAL)
Next
end function
'====== write a binary in register base
function regwribin(section,path01,key,value)
on error resume next
objReg.SetBinaryValue section, path01, key, value
if err.number<>0 then
toterrcop = toterrcop +1
msgfin03 = msgfin03 & vbcrlf & "error - reg write binary: " & vbcrlf & path01 & vbcrlf & key & vbcrlf
if usenam=debugname then
msgbox("erreur écriture dans reg base avec binary" & vbcrlf & err.description & vbcrlf & path01 & vbcrlf & key)
end if
end if
end function
'====== function string to array to write in register base as binary, a string
Function StringToArray(ByVal ss)
Dim ii, jj
ReDim aa(Len(ss) * 2 + 1)
ii = -1
For jj = 1 To Len(ss)
ii = ii + 1 : aa(ii) = Asc(Mid(ss, jj, 1))
ii = ii + 1 : aa(ii) = 0
Next
ii = ii + 1 : aa(ii) = 0
ii = ii + 1 : aa(ii) = 0
StringToArray = aa
End Function
'====== delete a registry key tree (all of it)
Function Regdeltre(sHive, sEnumPath)
'=== Attempt to delete key. If it fails, start the subkey enumeration process.
on error resume next
regsubtree=0
lRC = objReg.DeleteKey(sHive, sEnumPath)
'=== The deletion failed, start deleting subkeys.
If (lRC <> 0) Then
'=== Subkey Enumerator
On Error Resume Next
objReg.EnumKey sHive, sEnumPath, sNames
If (IsArray(sNames)) Then
For Each sKeyName In sNames
lRC = regdeltre(sHive, sEnumPath & "\" & sKeyName)
Next
regsubtre = 1
end if
'=== try delete the main registry key again
lRC = objReg.DeleteKey(sHive, sEnumPath)
if (lrc<>0) and regsubtre=0 then
'toterrcop = toterrcop +1
msgfin04 = msgfin04 & vbcrlf & "WARNING regdeltre - del registry tree does not exist: " & vbcrlf & hex(sHive) & "\" & sEnumPath & vbcrlf
if usenam=debugname then
'msgbox("erreur del reg tree" & vbcrlf & err.description & vbcrlf & hex(sHive) & vbcrlf & sEnumPath)
end if
elseif (lrc<>0) and regsubtre=1 then
toterrcop = toterrcop +1
msgfin03 = msgfin03 & vbcrlf & "ERROR regdeltre - del registry tree failed: " & vbcrlf & hex(sHive) & "\" & sEnumPath & vbcrlf
if usenam=debugname then
msgbox("ERROR regdeltre" & vbcrlf & err.description & vbcrlf & hex(sHive) & vbcrlf & sEnumPath)
end if
end if
End If
End Function
'=== lis le registre en mode 32 bits, si rien, lis en 64 bits
function regrea(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
if regrea_mode=0 then
r2egrea_mode=32
end if
regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
IF ISNULL(regrea) THEN
r2egrea_mode=64
regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
end if
end function
'=== lis le registre en mode regrea_mode
function regrea2(regrea_mode, regrea_clef01, regrea_clef02, regrea_clef03)
Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
on error resume next
objCtx.Add "__ProviderArchitecture", regrea_mode
if err.number<>0 then
toterrcop = toterrcop +1
msgfin03 = msgfin03 & vbcrlf & "error - __ProviderArchitecture: " & vbcrlf
if usenam=debugname then
msgbox("erreur __ProviderArchitecture" & vbcrlf & err.description & vbcrlf & path01 & vbcrlf & key)
end if
end if
Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
Set objStdRegProv = objServices.Get("StdRegProv")
Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters
Inparams.Hdefkey = regrea_clef01
Inparams.Ssubkeyname = regrea_clef02
Inparams.Svaluename = regrea_clef03
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
'=== show output parameters object and the registry value HKLM\SOFTWARE\
'WScript.Echo Outparams.GetObjectText_
'WScript.Echo "WMI Logging is set to " & Outparams.SValue
regrea2 = Outparams.SValue
end function
'=== fais un raccourci
function maksho(source, destination, icone, argument, hotkey)
'=== delete shortcut before recreating it
if objFSO.fileEXISTS(destination) then
objfso.deletefile(destination),true
end if
'and instr(source,"_01_désarchivage_x2t")=0
' If usenam<>"fortin.dominic" _
' and (usenam<>"mancheron.jimmy" _
' and instr(source,"sarchivage_x2t")=0) _
' Then
set oMyShortcut = objshe.CreateShortcut(destination)
'=== 3=Maximized 7=Minimized 4=Normal
oMyShortcut.WindowStyle = 4
oMyShortcut.IconLocation = icone
OMyShortcut.TargetPath = source
oMyShortCut.Hotkey = hotkey
oMyShortCut.Save
' end if
end function
'====== fin functionsASKER
Sorry to be a pain Wildboy 85 but i sat there for ages last night trying get my head arround that impressive script.
I have only ever wrote two scripts in my life and it was the batch for drives an VB for printers.
Could you please just paste a small simple VB printer and drive script on here.
It would be much appreciated Thanks
I have only ever wrote two scripts in my life and it was the batch for drives an VB for printers.
Could you please just paste a small simple VB printer and drive script on here.
It would be much appreciated Thanks
ASKER
I ran GP result on a few PCs i keep getting this error
Failed to connect to domain\computername due to the error listed below. Ensure that WMI service is enabled on the target computer, consult the event log of the target computer for further details.
Details
The RPC server is unavailible.
I checked that the WMI services where running on target PC and RPC services are running. i restarted them manualy for extra measure.
Thanks
Failed to connect to domain\computername due to the error listed below. Ensure that WMI service is enabled on the target computer, consult the event log of the target computer for further details.
Details
The RPC server is unavailible.
I checked that the WMI services where running on target PC and RPC services are running. i restarted them manualy for extra measure.
Thanks
-Is the Windows firewall enabled on the client machine? If so make sure the file and print sharing exception is checked.
-under properties of the network adapter make sure "client for Microsoft networks" is enabled
-A common cause of that error is DNS misconfiguration. Make suer the workstation points ONLY to your internal DNS server for DNS, and not the ISP's even as an alternate.
-running NetDiag will help determine if there are any DNS or network configuration errors.
http://www.lan-2-wan.com/Diag-FAQ.htm#q1
-under properties of the network adapter make sure "client for Microsoft networks" is enabled
-A common cause of that error is DNS misconfiguration. Make suer the workstation points ONLY to your internal DNS server for DNS, and not the ISP's even as an alternate.
-running NetDiag will help determine if there are any DNS or network configuration errors.
http://www.lan-2-wan.com/Diag-FAQ.htm#q1
ASKER
I will run net diag, file and print sharing is set through GPO and client for microsoft networks is enabled.
Thanks
Thanks
ASKER
Hey can any one paste me a simple VB script for connecting printers and net drives.
You guys are life savers
Thanks
You guys are life savers
Thanks
I am not a "VBS guy", but I have used a script/batch file similar to below to add printers. I usually add it to the logon script, which of course could be applied through Group policy.
Download con2prt.exe which is part of the Microsoft Administration kit available here:
http://www.microsoft.com/ntworkstation/downloads/Recommended/Featured/NTZAK.asp
Or just the con2prt.exe file here:
http://www.lan-2-wan.com/Diag-FAQ.htm#q6
Copy con2prt.exe to the Netlogon share of your server. (default location of logon scripts)
C:\Windows\SYSVOL\sysvol\Y
Note, if you need the exact name of the printer share, log on to that workstation or server and enter Net Share at a command line
If the share name has spaces you will have to enclose it with " " .
If you are not familiar with batch files copy the text to notepad to edit and then save as something like LogOn.bat and again put in your Netlogon share folder on the server.
The lines starting with :: are comment lines and will be ignored or you can remove.
There are many other ways to do this using rundll32 or VBS scripts, but this is likely the simplest.
--------------------------
:: You need to download con2prt.exe,
:: Copy to the NetLogOn server share - the default directory for the logon batch files
:: replace SrvrName with the name of the server with the Netlogon share
:: Netlogon share is located on the server in C:\Windows\SYSVOL\sysvol\Y
:: If at some point you wish to delete all printers enable the following line by removing the Rem
Rem \\SrvrName\Netlogon\con2pr
:: Install the default printer
:: replace WkstName with the name of the server or workstation the to which the printer is connected
:: replace Printer#x with the exact share name or the printer on the workstation
:: Note if the share contains spaces surround it with quotations e.g. "\\WkStn1\HP Laser"
\\SrvrName\Netlogon\con2pr
:: Install other printers -You can add as many as you like
\\SrvrName\Netlogon\con2pr
\\SrvrName\Netlogon\con2pr
--------------------------
If you want to use VB, the following may be of some help:
http://support.microsoft.com/?kbid=263226
--------------------------
As for mapping drives it i fairly straight forward:
net use X: \\ServerName\ShareName
Personaly I like to clean the slate and recreate drives each time:
net use * /delete
net use /persistent:no
net use X: \\ServerName\ShareName
Download con2prt.exe which is part of the Microsoft Administration kit available here:
http://www.microsoft.com/ntworkstation/downloads/Recommended/Featured/NTZAK.asp
Or just the con2prt.exe file here:
http://www.lan-2-wan.com/Diag-FAQ.htm#q6
Copy con2prt.exe to the Netlogon share of your server. (default location of logon scripts)
C:\Windows\SYSVOL\sysvol\Y
Note, if you need the exact name of the printer share, log on to that workstation or server and enter Net Share at a command line
If the share name has spaces you will have to enclose it with " " .
If you are not familiar with batch files copy the text to notepad to edit and then save as something like LogOn.bat and again put in your Netlogon share folder on the server.
The lines starting with :: are comment lines and will be ignored or you can remove.
There are many other ways to do this using rundll32 or VBS scripts, but this is likely the simplest.
--------------------------
:: You need to download con2prt.exe,
:: Copy to the NetLogOn server share - the default directory for the logon batch files
:: replace SrvrName with the name of the server with the Netlogon share
:: Netlogon share is located on the server in C:\Windows\SYSVOL\sysvol\Y
:: If at some point you wish to delete all printers enable the following line by removing the Rem
Rem \\SrvrName\Netlogon\con2pr
:: Install the default printer
:: replace WkstName with the name of the server or workstation the to which the printer is connected
:: replace Printer#x with the exact share name or the printer on the workstation
:: Note if the share contains spaces surround it with quotations e.g. "\\WkStn1\HP Laser"
\\SrvrName\Netlogon\con2pr
:: Install other printers -You can add as many as you like
\\SrvrName\Netlogon\con2pr
\\SrvrName\Netlogon\con2pr
--------------------------
If you want to use VB, the following may be of some help:
http://support.microsoft.com/?kbid=263226
--------------------------
As for mapping drives it i fairly straight forward:
net use X: \\ServerName\ShareName
Personaly I like to clean the slate and recreate drives each time:
net use * /delete
net use /persistent:no
net use X: \\ServerName\ShareName
alright i will describe the script a bit
first it's for windows 2000 and +
at the start i list all network cards to identify the mac adress
i use this mac adress to identify my computers in a sql database for a live inventory (that is another script, australian)
my script will write it's own start and end time in that sql database so i can identify the computer that have a slow boot problem (slow script = slow boot)
for drive mapping in my script, there are comments there:
'========= start mapping drives
just after that there is a sub that map drive, but never the same drives, if they are alreayd mapped
i use a sub, because i only have to trap errors in the sub, not everytime i map a drive
my error are added in a string i will drop in event viewer later to consult
so before i map drives, i list all existing netork drive and put them in a string
then i chek if the drive is mapped in the string and i map missing ones
for printers, it's also a sub, but in our network we do not like poeple printing in color always
so if the color printer is their default one, we change it to another printer driver, that use the same printer, locked in black and white
you can extract themapping drive part, run it and add any missing "set" at the start of my script (mainly called "missing objects")
remove any "on error resume next" to see all missing things after you extract the interesting part for you
you can run the script manually, add and remove thing and after all testing done, put back an "on error resume next" for the script never to stop in the middle of a logon (you would not like that!)
you do not have to use all the subs you can simply do as this example there in my code snippet
later, when you want it you can pick up more code from my logon and add it progressively
the normal evolution of a logon script would be:
DOS, .cmd or .bat file
kix32 logon script
vbs script
vbs script with dll calls to access what vbs does not permit to access with objects
first it's for windows 2000 and +
at the start i list all network cards to identify the mac adress
i use this mac adress to identify my computers in a sql database for a live inventory (that is another script, australian)
my script will write it's own start and end time in that sql database so i can identify the computer that have a slow boot problem (slow script = slow boot)
for drive mapping in my script, there are comments there:
'========= start mapping drives
just after that there is a sub that map drive, but never the same drives, if they are alreayd mapped
i use a sub, because i only have to trap errors in the sub, not everytime i map a drive
my error are added in a string i will drop in event viewer later to consult
so before i map drives, i list all existing netork drive and put them in a string
then i chek if the drive is mapped in the string and i map missing ones
for printers, it's also a sub, but in our network we do not like poeple printing in color always
so if the color printer is their default one, we change it to another printer driver, that use the same printer, locked in black and white
you can extract themapping drive part, run it and add any missing "set" at the start of my script (mainly called "missing objects")
remove any "on error resume next" to see all missing things after you extract the interesting part for you
you can run the script manually, add and remove thing and after all testing done, put back an "on error resume next" for the script never to stop in the middle of a logon (you would not like that!)
you do not have to use all the subs you can simply do as this example there in my code snippet
later, when you want it you can pick up more code from my logon and add it progressively
the normal evolution of a logon script would be:
DOS, .cmd or .bat file
kix32 logon script
vbs script
vbs script with dll calls to access what vbs does not permit to access with objects
'------------vbs file-----------
'=== remark in front, to test script, so error can show up
'on error resume next
Set objNet = CreateObject("WScript.Network")
'=== file server name,better be a variable if you switch server one day
serv01 = "\\fileserver"
'=== letter to map
a = "h:"
'=== server + share name for the drive to map
b = serv01 & "\sharenumber1"
objNet.MapNetworkDrive a, b
'=== mapping of network drives done
now your homework, is to extract the same part you are interested in in the printer section.
lucky you i did it for you!
so my script, the original one, have error trapping, logging etc
but you don't have to use it untill you reach the next level ;)
lucky you i did it for you!
so my script, the original one, have error trapping, logging etc
but you don't have to use it untill you reach the next level ;)
'------------vbs file-----------
'=== remark in front, to test script, so error can show up
'on error resume next
Set objNet = CreateObject("WScript.Network")
'=== printer server name
serv01 = "\\printerserver\"
'=== printer name
a = "hpprintername"
'=== server + share name for the drive to map
b = serv01 & a
objNet.RemovePrinterConnection b
objNet.AddWindowsPrinterConnection b
'=== end of printers
'=== mapping of network drives done
ASKER
Ok i got the VB scripts working, thanks to your advice.
Now how do i write the script for the printers to add multiple printers to one server then multiple printers to another server in the one script.
Also with VB mapdrives script, what do i add to delete any mapped drives first.
Thanks
Now how do i write the script for the printers to add multiple printers to one server then multiple printers to another server in the one script.
Also with VB mapdrives script, what do i add to delete any mapped drives first.
Thanks
multiple printer servers:
you just change the server name in the variable and run same code
vbs is easy once you cath the basics
you just change the server name in the variable and run same code
vbs is easy once you cath the basics
'------------vbs file-----------
'=== remark in front, to test script, so error can show up
'on error resume next
Set objNet = CreateObject("WScript.Network")
'=== printer server name
serv01 = "\\printerserver\"
'=== printer name
a = "hpprintername"
'=== server + share name for the drive to map
b = serv01 & a
objNet.RemovePrinterConnection b
objNet.AddWindowsPrinterConnection b
'=== printer server name
serv01 = "\\printerserver222222\"
a = "hpprinternameserver2"
'=== server + share name for the drive to map
b = serv01 & a
objNet.RemovePrinterConnection b
objNet.AddWindowsPrinterConnection b
'=== mapping of network drives doneASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
wow i bet this is long because you are now programming a big logon script :)
do worry thought, i do not really care about the points, just my karma ;)
do worry thought, i do not really care about the points, just my karma ;)
ASKER
Thanks the VB script works much more efficiantly then the batch.
I am still perfecting my massive script LOL, as im still using a lot of trial and error.
Its good though, now i am starting to use scripts for a lot more.
Thanks.
I am still perfecting my massive script LOL, as im still using a lot of trial and error.
Its good though, now i am starting to use scripts for a lot more.
Thanks.
if you have questions about my script, ask in here, i will answer
i also have vista version and i am still working on it (bug on a few computers)
basically it is the same but must be called differently, with a scheduled process
i also have vista version and i am still working on it (bug on a few computers)
basically it is the same but must be called differently, with a scheduled process
the reason why i use sub to map drives and printer is ony for error reporting
so it look more complicated at first, but when you got a beautiful event in event viewer with the true error, it's easier to find why a printer did not map on a certain computer
so it look more complicated at first, but when you got a beautiful event in event viewer with the true error, it's easier to find why a printer did not map on a certain computer
ASKER
Thanks alot.
i am in the process of changing our PC to vista so i will need that script when you get it working if thats ok.
Thanks
i am in the process of changing our PC to vista so i will need that script when you get it working if thats ok.
Thanks
vista logon script
part 1 of 4
---------- 01_logon.vbs -----------
part 1 of 4
---------- 01_logon.vbs -----------
Set objshe = WScript.CreateObject("WScript.Shell")
set objEnv = objshe.Environment("PROCESS")
objEnv("SEE_MASK_NOZONECHECKS") = 1
'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
Dim isVista
Dim wshShell
Set wshShell = CreateObject("WScript.Shell")
GetOS
If isVista = True Then
'=== vista logon, we run script as admin/elevated user
'runLaunchApp
a="wscript """ & basedir & "_04_launch.vbs"" """ & basedir & "_02_logon.vbs"""
err.clear
objShe.Run a
if err<>0 then
msgbox("error vista" & vbcrlf & "cannot start second script" & vbcrlf & a)
end if
Else
'=== not vista logon
on error resume next
wshShell.Run "\\corp.stas.local\NETLOGON\users\_02_logon.vbs"
if err<>0 then
err.clear
wshShell.Run "\\172.16.0.37\NETLOGON\users\_02_logon.vbs"
if err<>0 then
err.clear
wshShell.Run "\\172.16.0.1\NETLOGON\users\_02_logon.vbs"
end if
end if
End If
objEnv.Remove("SEE_MASK_NOZONECHECKS")
Sub GetOS
on error resume next
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOS in colOSes
osCaption = objOS.Caption
If instr(osCaption, "Vista") Then
isVista = True
End If
Next
End Sub
vista logon script
part 2 of 4
---------- 02_logon.vbs -----------
(the big one you can replace with a small one with printers and drives only)
part 2 of 4
---------- 02_logon.vbs -----------
(the big one you can replace with a small one with printers and drives only)
'=== login script stas
'=== login script stas
'=== usable with GPO computer and user same time
'=== index
' objects definition
' network info (passive)
' network drive mapping
' printers mapping
' config outlook
' config word, excel, access
' config acrobat reader
on error resume next
Set objshe = WScript.CreateObject("WScript.Shell")
set objEnv = objshe.Environment("PROCESS")
Set objFSO = wscript.CreateObject("Scripting.FileSystemObject")
Set objNet = CreateObject("WScript.Network")
set objsheapp = wscript.CreateObject("Shell.Application")
Set objaut = WScript.CreateObject("AutoItX.Control")
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
'HKEY_CLASSES_ROOT (HKCR)
'HKEY_CURRENT_USER (HKCU)
'HKEY_LOCAL_MACHINE (HKLM)
'HKEY_USERS (HKU)
'HKEY_CURRENT_CONFIG (HKCC)
Const hkcr = &H80000000 'HKEY_CLASSES_ROOT
Const HKCU = &H80000001 'HKEY_CURRENT_USER
Const hklm = &H80000002 'HKEY_LOCAL_MACHINE
Const hku = &H80000003 'HKEY_USERS
Const hkcc = &H80000005 'HKEY_CURRENT_CONFIG
'=== office all possible versions
'=== used to find the folder AND the register path in register base
arroff = array("11","12")
'=== program files versions (x86 or not)
arrwin = array(" (x86)","")
dim msgfin '=== final message in bubble near task bar
admrig = 1 '=== the user have admin right, so we run all system parts of the script
msgfin ="" '=== message displayed in bubble in task bar at end of login
msgfin02="" '=== message final dans event viewer applications
debugname = "fournier.serge" '=== full error report if this user log
'=== msgbox at end for tests
msgfin03="====== debut logon script" & vbcrlf
msgfin04="=== warnings or info" & vbcrlf
'=== global variables or setup
objEnv("SEE_MASK_NOZONECHECKS") = 1
script01 = "C:\_stas\scripts\notification_balloon.vbs"
'=== network groups (pas le login) avec tous les CN, OU, DC
Set objUser = CreateObject("ADSystemInfo")
Set CurrentUser = GetObject("LDAP://" & objUser.UserName)
'=== network usename
usenam = lcase(objNet.UserName) '=== lastname.firstname (or login name)
uselna = lcase(currentuser.sn) '=== last name
usefna = lcase(currentuser.givenname) '=== first name
'=== computer name
sysnam = lcase(objnet.computername)
'=== interrupt logon if on a server or admin logon
if usenam="admin1" _
or usenam="admin2" _
or usenam="admin3" _
or usenam="admin4" _
or usenam="administrateur" _
or (instr(sysnam,"stas")<>0 and sysnam<>"stas-ts-02" and sysnam<>"stas-bkmag-01") then
msgbox("script interrompu" & vbcrlf & "admin1,2,3,4 ou administrateur" & vbcrlf & "ou serveur name contient ""stas""")
wscript.quit
end if
db_host = environ("stassql1") '=== SQL Server address (dos environement variable)
db_database = "winventory" '=== database name for inventory
db_user = "sa" '=== sql logon
db_password = "Unista999" '=== sql password
set database=createobject("adodb.connection")
set tag = CreateObject ("ADODB.Recordset")
conn = "driver={SQL Server};server=" & db_host & ";Database=" & db_database & ";Uid=" & db_user & ";Pwd=" & db_password
'conn = "Driver={SQL Server};Server=" & db_host & ";Integrated Security=SSPI"
database.open conn
sql = "USE " & db_database
set tag = database.execute(sql)
'=== network card find
strcomputer="."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("select * from win32_networkadapterconfiguration WHERE IPEnabled='TRUE' " _
& "AND ServiceName<>'AsyncMac' " _
& "AND ServiceName<>'VMnetx' " _
& "AND ServiceName<>'VMnetadapter' " _
& "AND ServiceName<>'Rasl2tp' " _
& "AND ServiceName<>'msloop' " _
& "AND ServiceName<>'PptpMiniport' " _
& "AND ServiceName<>'Raspti' " _
& "AND ServiceName<>'NDISWan' " _
& "AND ServiceName<>'NdisWan4' " _
& "AND ServiceName<>'RasPppoe' " _
& "AND ServiceName<>'NdisIP' " _
& "AND ServiceName<>'' " _
& "AND Description<>'PPP Adapter.'",,48)
'=== mac address find
'=== we use the mac adresse in the database inventory so the computer is unique
For Each objItem in colItems
count_all = count_all + 1
if objItem.IPAddress(0) <> "0.0.0.0" then
count = count + 1
if count = 1 then
net_ip_address = objItem.IPAddress(0)
'objOutputFile.WriteLine date & " " & time & " IP: " & net_ip_address
net_mac_address = objItem.MACAddress
end if
end if
next
'=== we record in sql the start time of the logon script
sql = "UPDATE system SET log_start={ fn NOW() } WHERE net_mac_address = '" & net_mac_address & "'"
set tag = database.execute(sql)
if usenam=debugname then
'msgbox(sql)
end if
'=== log everything for timing
'T:\log_logon
usetmp = environ("temp")
'file01 = "\\stas-host-01\stas\temporaire\log_logon\" & usenam & "_log_logon.txt"
on error resume next
'Set objfil01 = objFso.OpenTextFile(file01, 2, true)
'objFil01.WriteLine date & " " & time & " début logon "
'if usenam = debugname then
' set cursys = GetObject("LDAP://" & objUser.ComputerName)
' Set oComputer = CreateObject("ADSystemInfo")
' cName = oComputer.ComputerName
' Set ObjGroup = GetObject("LDAP://cn=informatique," & objUser.ComputerName)
' for each Group in ObjGroup.member
' If Group = ObjGroup.distinguishedName Then
' wscript.echo "Already a Member of This Group"
' Else
'ObjGroup.Add "LDAP://" & cName
' Wscript.Echo lName.ComputerName & " Added to USB Group"
'
' End If
' Next
'end if
'=== path to current user desktop
'AllUsersDesktop : D:\Documents and Settings\All Users\Bureau
'AllUsersStartMenu : D:\Documents and Settings\All Users\Menu Démarrer
'AllUsersPrograms : D:\Documents and Settings\All Users\Menu Démarrer\Programmes
'AllUsersStartup : D:\Documents and Settings\All Users\Menu Démarrer\Programmes\Démarrage
'Desktop : D:\Documents and Settings\Christophe\Bureau
'AppData : D:\Documents and Settings\Christophe\Application Data
'PrintHood : D:\Documents and Settings\Christophe\Voisinage d'impression
'Templates : D:\Documents and Settings\Christophe\Modèles
'Fonts : D:\WINDOWS\Fonts
'NetHood : D:\Documents and Settings\Christophe\Voisinage réseau
'StartMenu : D:\Documents and Settings\Christophe\Menu Démarrer
'SendTo : D:\Documents and Settings\Christophe\SendTo
'Recent : D:\Documents and Settings\Christophe\Recent
'Startup : D:\Documents and Settings\Christophe\Menu Démarrer\Programmes\Démarrage
'Favorites : D:\Documents and Settings\Christophe\Favoris
'Programs : D:\Documents and Settings\Christophe\Menu Démarrer\Programmes
alldes = objShe.SpecialFolders.Item("AllUsersDesktop")
'=== variable for user logged (when its not system)
if usenam <>"system" then
'
'=== service
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\bonjour service\start"
d=regwri(a,4,"REG_DWORD")
'=== service
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Microsoft Office Groove Audit Service\start"
d=regwri(a,4,"REG_DWORD")
'=== service
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Services\Apple Mobile Device\start"
d=regwri(a,4,"REG_DWORD")
' objFil01.WriteLine date & " " & time & " query ldap data "
usegrp = LCase(Join(CurrentUser.MemberOf)) '=== list of all groups user is in
useappdat = objShe.SpecialFolders.Item("appdata") '=== application data
allappdat = environ("ALLUSERSPROFILE") & "\Application Data" '=== application data all users
uselosappdat = environ("USERPROFILE") & "\local settings\Application Data" '=== local setting, app data
usedes = objShe.SpecialFolders.Item("Desktop") '=== user desktop - bureau
usetmp = environ("temp") '=== user temp folder
macfon = objShe.SpecialFolders.Item("Fonts")
comfil = environ("commonprogramfiles")
'=== find the path to office
useoff = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\Word\InstallRoot", "path")
if isnull(useoff) then
useoff = regrea(0, hklm, "SOFTWARE\Microsoft\Office\11.0\Word\InstallRoot", "path")
end if
useout = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\outlook\InstallRoot", "path")
if isnull(useout) then
useout = regrea(0, hklm, "SOFTWARE\Microsoft\Office\11.0\Word\InstallRoot", "path")
end if
useexc = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\excel\InstallRoot", "path")
if isnull(useoff) then
useexc = regrea(0, hklm, "SOFTWARE\Microsoft\Office\11.0\excel\InstallRoot", "path")
end if
if useoff ="" then
if usenam = debugname then
msgbox("erreur pas trouvé le path office")
end if
msgfin03=msgfin03 & "error - path office not found" & vbcrlf
end if
end if
on error resume next
if err.number<>0 then
if usenam = debugname then
msgbox(err.number & vbcrlf & err.description)
end if
msgfin03=msgfin03 & vbcrlf & "error - system name invalide - " & vbcrlf & sysnam & vbcrlf
end if
if usenam <>"system" then
if usenam = debugname then
'msgbox("vous etes serge fournier, debugger")
end if
on error resume next
err.clear
objshe.Run script01 & " DEBUT ""Bonjour`n" & usenam & "`n" & sysnam & "`n"" 15 1+16",, False
if err<>0 then
err.clear
script01 = "\\172.16.0.37\NetLogon\users\notification_balloon.vbs"
objshe.Run script01 & " DEBUT ""Bonjour`n" & usenam & "`n" & sysnam & "`n"" 15 1+16",, False
if err<>0 then
err.clear
script01 = "\\172.16.0.1\NetLogon\users\notification_balloon.vbs"
objshe.Run script01 & " DEBUT ""Bonjour`n" & usenam & "`n" & sysnam & "`n"" 15 1+16",, False
end if
end if
'=== adjust time on local computer
'objFil01.WriteLine date & " " & time & " time adjust to stas-dc-03 "
objshe.Run "net time \\stas-dc-03 /set /yes",0, false
if err.number<>0 then
if usenam = debugname then
msgbox(err.number & vbcrlf & err.description)
end if
msgfin03=msgfin03 & "error - impossible to start task bar bubble message"
end if
end if
'=== error trapping and testing by this user
if usenam = debugname then
on error goto 0
else
on error resume next
end if
'=== get system drive letter
WinDir = objfso.GetSpecialFolder(0) '=== windows dir
if windir="" then
msgfin03=msgfin03 & vbcrlf & "erreur - windows path not found" & vbcrlf
end if
sysdir = objfso.GetSpecialFolder(1) '=== system32 dir
if sysdir="" then
msgfin03=msgfin03 & vbcrlf & "erreur - system path not found" & vbcrlf
end if
'=== var environnement
'objshe.Environment.Item("WINDIR")
prodir32 = environ("programfiles(x86)")
prodir = environ("programfiles")
if prodir="" then
msgfin03=msgfin03 & vbcrlf & "erreur - program files path not found" & vbcrlf
end if
root=mid(windir,1,3)
'=== actual drive, actual directory, and "\"
thepath=WScript.ScriptFullName
p = instrRev(thepath,"\")
basedir = left(thepath,p)
'=== path serveur
ser = "\\corp.stas.local\stas\netlogon"
ser2 = "\\corp.stas.local"
serv01 = "\\corp.stas.local\stas"
serveur = "\\stas-host-01\"
'========= start mapping drives
if usenam <>"system" then
'objFil01.WriteLine date & " " & time & " drives mapping start"
msgfin02=""
toterrcop=0
'=== special config for certain groups
If InStr(usegrp, "pemp") Then
objNet.RemoveNetworkDrive "X:"
end if
Set oDrives = objnet.EnumNetworkDrives
alldri = ""
allsha = ""
'objFil01.WriteLine date & " " & time & " drives get old letters "
For i = 0 to oDrives.Count - 1 Step 2
alldri = alldri & lcase(oDrives.Item(i)) & " "
'=== futur developement if we want to unmap drives if the path is not the same
'allsha = allsha & lcase(oDrives.Item(i+1)) & " "
Next
'=== special config for certain groups
If InStr(usegrp, "pemp") Then
c = mapdri("x:",serv01 & "\PEMP",alldri)
alldri = alldri & "x: "
end if
If InStr(usegrp, "comptabilite") or InStr(usegrp, "comptabilité") Then
c = mapdri("s:",serv01 & "\ADMINIST",alldri)
alldri = alldri & "s: "
end if
'=== archives drive mapping
if usenam="fournier.serge" or _
usenam="paquet.yves" or _
usenam="mancheron.jimmy" or _
usenam="maltais.daniel" or _
usenam="belley.guy" or _
usenam="prive.dominique" or _
usenam="juneau.helaine" or _
usenam="bouchard.louis" or _
usenam="doucet.gm" then
c = mapdri("x:",serv01 & "\archives",alldri)
alldri = alldri & "x: "
end if
if usenam <>"" then
c = mapdri("h:", serv01 & "\usagers\" & usenam,alldri)
alldri = alldri & "h: "
end if
'objFil01.WriteLine date & " " & time & " drives H to Z "
c = mapdri("h:", serv01 & "\Temporaire",alldri)
c = mapdri("i:", serv01 & "\Projets",alldri)
c = mapdri("j:", serv01 & "\Elec",alldri)
c = mapdri("k:", serv01 & "\Originaux",alldri)
c = mapdri("l:", serv01 & "\Mec",alldri)
c = mapdri("M:", serv01 & "\Magica",alldri)
c = mapdri("N:", serv01 & "\LOTUS",alldri)
c = mapdri("O:", serv01 & "\WP",alldri)
if usenam = "fournier.serge" or usenam="foster.nathaniel" or usenam="fortin.dominic" then
c = mapdri("p:", serv01 & "\netlogon",alldri)
end if
c = mapdri("r:", serv01 & "\dbase",alldri)
'c = mapdri("s:", serv01 & "\Temporaire",alldri)
c = mapdri("t:", serv01 & "\Temporaire",alldri)
c = mapdri("v:", serv01 & "\ProjetsStas",alldri)
c = mapdri("u:", "http://intranet.stas.biz/Documents/",alldri)
'("Y:","\\\\nomServer\\Public",false,"nomUser","Mot de passe");
c = mapdri("w:", serv01 & "\Photos",alldri)
'c = mapdri("x:", serv01 & "\Temporaire",alldri)
c = mapdri("y:", serv01 & "\System",alldri)
c = mapdri("Z:", serv01 & "\References",alldri)
'c = mapdri("p:", serv01 & "\Netlogon",alldri)
msgfin = msgfin & "`n" & toterrcop & " err drives " & msgfin02
a = ser & "\users\_stas\"
b = root & "_stas"
e = makfol(b)
on error resume next
'=== testing dfs
Set objFolder = objFSO.GetFolder(a)
if err.number<>0 then
'=== vista frequent bug
'=== can't find server path (dfs) switch to netbios path
ser ="\\stas-dc-03\netlogon"
a = ser & "\users\_stas\"
if usenam = debugname or usenam ="admin3" then
'msgbox("switched to netbios")
end if
e = makfol(b)
end if
'=== make local dir c:\_stas
Set objFolder = objFSO.GetFolder(a)
if err.number<>0 then
if usenam = debugname or usenam ="admin3" then
msgbox("error" & vbcrlf & a & vbcrlf & err.description & vbcrlf & ser)
end if
end if
filnam = "chemin.ini"
sou = ser & "\users\" & filnam
des = "c:\_stas\apps\" & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
filnam = "chemin.ini"
sou = ser & "\users\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
a=copyfile(sou,des)
filnam = "_01_logon.vbs.lnk"
sou = ser & "\users\_stas\util\" & filnam
des = "c:\_stas\" & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
a=copyfile(sou,des)
Set objFiles = objFolder.subfolders '=== directory
'=== chek all file in each folders in c:\_stas
For Each objFile in objFiles
a = "\" & objfile.name
b = ser & "\users\_stas" & a
c = root & "_stas" & a
e = makfol(c)
d = copyfold(b,c)
if usenam = debugname then
'msgbox("test" & vbcrlf & b & vbcrlf & c)
end if
next
'=== update consigno
'objFil01.WriteLine date & " " & time & " consigno update "
a="V:\224226_elec_ing\Signature_electronique\templates\STAS_Avec_Sceau"
b=useappdat & "\.ConsignO\templates"
Set objFolder = objFSO.GetFolder(b)
if err.number<>0 then
if usenam = debugname or usenam ="admin3" then
'msgbox("error" & vbcrlf & b & vbcrlf & err.description & vbcrlf & ser)
end if
else
d = copyfold(a,b)
end if
msgfin = msgfin & "`n" & toterrcop & " err regwrite & copy"
end if
'=== map drive only if they are not aleady mapped
'=== a = letter
'=== b = share path
'=== c = all drive already used in a string
function mapdri(a,b,c)
if instr(c, lcase(a))=0 then
on error resume next
if mid(b,1,4)="http" then
objNet.MapNetworkDrive a, b, false, "",""
else
objNet.MapNetworkDrive a, b
end if
if err.number<>0 then
msgfin02 = msgfin02 & a & " "
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - " & A & " drive not mapped to " & b & vbcrlf & vbcrlf & err.description
end if
else
'=== drive exist, we dont unmap or remap
'msgfin02 = msgfin02 & a & " "
end if
end function
toterrcop =0
'====== start outlook machine
if usenam="system" or admrig = 1 then
'objFil01.WriteLine date & " " & time & " outlook setup "
'=== outlook machine setup
' filnam = "BoutonsOutlook.dll"
' sou = ser & "\users\_stas\outlook\" & filnam
' des = sysdir & "\" & filnam
' a=copyfile(sou,des)
'=========================== VISTA =====================
'=== désactiver le control usager - user access control (necessite un reboot)
'=== executing a script as true admin, bypassing all vista new security
set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set colOSes = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOS in colOSes
osCaption = objOS.Caption
If instr(osCaption, "Vista") Then
'=== vista script setup to turn off UAC (user access control)
'=== we run the scirpt as layer 1 user (elevated user)
objSheapp.ShellExecute "wscript.exe ", Chr(34) & ser & "\users\_03_vista.VBS" & Chr(34), "", "runas", 1
if err<>0 then
msgfin02 = msgfin02 & "error - " & b & vbcrlf
'toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - " & b & vbcrlf
'msgbox("erreur" & vbcrlf & b)
end if
'=== windows vista ajust adjust tweaks
'=== no windows defender
a="HKEY_LOCAL_MACHINE\System\currentcontrolset\services\windefend\start"
d=regwri(a,4,"REG_DWORD")
End If
Next
'=== outlook 2003-2007 stuff
filnam = "comdlg32.dll"
sou = ser & "\users\_stas\outlook\" & filnam
des = sysdir & "\" & filnam
a=copyfile(sou,des)
filnam = "comdlg32.ocx"
sou = ser & "\users\_stas\outlook\" & filnam
des = sysdir & "\" & filnam
a=copyfile(sou,des)
'=== outlook, our own DLL to add more functionalities
a=0
b=sysdir & "\regsvr32.exe /s c:\_stas\outlook\boutonsoutlook.dll"
a = objshe.run(b,0,true)
if a<>0 then
if usenam=debugname then
msgfin02 = msgfin02 & "error - " & b & vbcrlf
'toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - " & b & vbcrlf
'msgbox("erreur" & vbcrlf & b)
end if
end if
a=0
b=sysdir & "\regsvr32.exe /u /s " & sysdir & "\comdlg32.ocx"
a = objshe.run(b,0,true)
if a<>0 then
if usenam=debugname then
msgfin02 = msgfin02 & "error - " & b & vbcrlf
'toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - " & b & vbcrlf
'msgbox("erreur" & vbcrlf & b)
end if
end if
a=0
b=sysdir & "\regsvr32.exe /s " & sysdir & "\comdlg32.ocx"
a = objshe.run(b,0,true)
if a<>0 then
if usenam=debugname then
msgfin02 = msgfin02 & "error - " & b & vbcrlf
'toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - " & b & vbcrlf
'msgbox("erreur" & vbcrlf & b)
end if
end if
'return = WshShell.Run("ping "&strComputer&" -n 1 -w 500", 0, true)
d=regwri("HKEY_LOCAL_MACHINE\software\microsoft\jet\4.0\engines\text\format","delimited(;)","REG_SZ")
'=== environnement variables register, must relog to be effactive
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\stasfile"
b="\\Corp.stas.local\stas"
c="REG_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\stasmag"
b="\\stas-magica-02"
c="REG_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\stassql1"
b="sql.corp.stas.local"
c="REG_SZ"
d=regwri(a,b,c)
'=== fonts machine setup
b = ser & "\users\_stas\fonts"
c = macfon
e = makfol(c)
d = copyfold(b,c)
';Gets rid of tray icon for taking survey (office 2k3)
'[HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\Internet]
'"UseOnlineContent"=dword:00000002
'[HKEY_CURRENT_USER\Software\Microsoft\Office\Common]
'"QMEnable"=dword:00000000
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\Internet\UseOnlineContent"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\Internet\UseOnlineContent"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\Common\QMEnable"
d=regwri(a,0,"REG_DWORD")
'=== outlook bug SAFE MODE ON TERMINAL SERVER (version 10,11,12)
d=regdeltre(hklm,"Software\Microsoft\Windows NT\Current Version\Terminal Server\Install\Software\Microsoft\Office\10.0\Outlook\Resiliency")
d=regdeltre(hklm,"Software\Microsoft\Windows NT\Current Version\Terminal Server\Install\Software\Microsoft\Office\11.0\Outlook\Resiliency")
d=regdeltre(hklm,"Software\Microsoft\Windows NT\Current Version\Terminal Server\Install\Software\Microsoft\Office\12.0\Outlook\Resiliency")
'=== disable asking to install desktop search on outlook 2007
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Search\DisableDownloadSearchPrompt"
d=regwri(a,1,"REG_DWORD")
'=== explorer refresh après un rename etc (plus souvent)
'Windows Registry Editor Version 5.00
'[HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Update]
'"UpdateMode"=dword:00000000
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Update\UpdateMode"
d=regwri(a,0,"REG_DWORD")
'=== context menu modif
'[HKEY_CLASSES_ROOT\Drive\shell\Send_Link_by_Mail]
'@=""
'[HKEY_CLASSES_ROOT\Drive\shell\Send_Link_by_Mail\Command]
'@="\"C:\\Windows\\System32\\wscript.exe\" \"C:\\_stas\\Util\\Send_Link_by_Mail.vbs\" %1"
'[HKEY_CLASSES_ROOT\lnkfile\shell\slink]
'@="Quick Launch folder (Explore)"
'a="HKEY_CLASSES_ROOT\Drive\shell\Send_Link_by_Mail\Command\@"
'b=""C:\\Windows\\System32\\wscript.exe\" \"C:\\_stas\\Util\\Send_Link_by_Mail.vbs\" %1"
'=== add a context menu for me only (left click on files)
'=== vista = not working at all
if usenam="fournier.serge" then
'----------Installation script for right-click menu-----------
'--------Text file-------
'WSHShell.RegWrite "HKCR\*\shell\test\command\",r & "tst.vbs'","REG_SZ"
a="HKCR\txtfile\shell\test\command\"
b=sysdir & "\WScript.exe ""C:\_stas\util\t.VBS"" ""%1"""
objshe.RegWrite a, b,"REG_SZ"
'msgbox "ok right click sef"
'-----------end of script----------
end if
'si claude guérin, setup clear type fonts
'[HKEY_CURRENT_USER\Control Panel\Desktop]
'"FontSmoothing"="2"
'"FontSmoothingType"=dword:00000002
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\EnableAutoUpdateCheck"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\EnableJavaUpdate"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\NotifyDownload"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SOFTWARE\JavaSoft\Java Update\Policy\NotifyInstall"
d=regwri(a,0,"REG_DWORD")
'=== paint net paintdotnet paint.net NO UPDATE
a="HKEY_LOCAL_MACHINE\SOFTWARE\Paint.NET\CHECKFORUPDATES"
d=regwri(a,0,"REG_DWORD")
a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\FileSystem\NtfsDisable8dot3NameCreation"
d=regwri(a,0,"REG_DWORD")
'=== error norton en nom short au demarrage
d=regdel("HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\vptray")
'=== google bar destruction
des = prodir & "\google\GoogleToolbar1.dll"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== google
des = prodir & "\google\GoogleToolbar2.dll"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== yahoo
des = prodir & "\Yahoo!\Companion\Installs\cpn\yt.dll"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== Shortcuts without "Shortcut to.."
' deja fait?
'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer]
'"link"=hex:00,00,00,00
'=== Disable Tracking of Broken Shortcut Links
'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer]
'"NoResolveTrack"=dword:00000001
'=== disable restart prompt after a windows update
'[HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate\AU]
'"RebootRelaunchTimeoutEnabled"=dword:00000000
'a="HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\WindowsUpdate\AU\RebootRelaunchTimeoutEnabled"
'd=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoResolveTrack"
d=regwri(a,1,"REG_DWORD")
'=== Disable Autorun for all Drive Types
'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer]
'"NoDriveTypeAutoRun"=dword:00000091
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoDriveTypeAutoRun"
d=regwri(a,16,"REG_DWORD")
'NoDriveAutoRun or NoDriveTypeAutoRun
'=== make date update on a network folder less often
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRemoteRecursiveEvents"
d=regwri(a,1,"REG_DWORD")
'=== Add register / unregister to the context menu for .dll files
'[HKEY_CLASSES_ROOT\.dll]
'"Content Type"="application/x-msdownload"
'@="dllfile"
'[HKEY_CLASSES_ROOT\dllfile]
'@="Application Extension"
'[HKEY_CLASSES_ROOT\dllfile\Shell\Register\command]
'@="regsvr32.exe \"%1\""
'[HKEY_CLASSES_ROOT\dllfile\Shell\UnRegister\command]
'@="regsvr32.exe /u \"%1\""
'runwita="HKEY_CLASSES_ROOT\"& runwitnam &"\shell\open\command\"
'runwitb=runwitprog
'runwitc="REG_SZ"
'runwitd=regwri(runwita,runwitb,runwitc)
'objFil01.WriteLine date & " " & time & " regsvr32 for dll for power users "
'=== dll register with a simple left click on a dll file
if usenam="fournier.serge" or usenam="foster.nathaniel" or usenam="boivin.francois" then
a="HKEY_CLASSES_ROOT\.dll\Content Type"
d=regwri(a,"application/x-msdownload","REG_SZ")
a="HKEY_CLASSES_ROOT\.dll\"
d=regwri(a,"dllfile","REG_SZ")
a="HKEY_CLASSES_ROOT\dllfile\"
d=regwri(a,"Application Extension","REG_SZ")
a="HKEY_CLASSES_ROOT\dllfile\Shell\Register\command\"
d=regwri(a,"regsvr32.exe ""%1""","REG_SZ")
a="HKEY_CLASSES_ROOT\dllfile\Shell\UnRegister\command\"
d=regwri(a,"regsvr32.exe /u ""%1""","REG_SZ")
end if
'=== correct sort order in windows xp
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer\NoStrCmpLogical"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoStrCmpLogical"
d=regwri(a,1,"REG_DWORD")
end if
'========= printers mapping
if usenam<>"admin1" _
and usenam<>"admin2" _
and usenam<>"admin3" _
and usenam<>"admin4" _
and usenam<>"administrateur" _
and (instr(sysnam,"stas")=0 or sysnam="stas-ts-02") then
'and instr(usegrp, "cn=comptes_generiques")=0
if usenam<>"system" then
'objFil01.WriteLine date & " " & time & " printer mapping "
'=== reset error counter
toterrcop = 0
dim strUNCPrinter
Dim objPrinter
dim intDrive
dim intNetLetter
dim totren
dim totold
totren=0
totold=0
paspil=0
'=== user login name
strUserName = usenam
' printer server
maingroup = "employés stas"
'=== a = ldap group (the group they need to be in to have this printer installed)
'=== b = unc path of printer
'=== c = dummy
c = installprinter("SCAN2200", serveur & "SCAN2200")
c = installprinter("SCAN2200", serveur & "SCAN2200_RECTO_VERSO")
c = installprinter("SCAN2200", serveur & "SCAN2200MEC")
c = installprinter("SCAN2200", serveur & "SCAN2200MEC_RECTO_VERSO")
c = installprinter("SCAN4080", serveur & "scan4080_noir")
c = installprinter("SCAN4080", serveur & "SCAN4080_COUL")
c = installprinter("SCAN4080", serveur & "SCAN4080_RECTO_VERSO")
c = installprinter("SCAN4080", serveur & "SCAN4080_PDF")
c = installprinter("PLOT1055", serveur & "PLOT1055")
c = installprinter("PLOT1055X64", serveur & "PLOT1055X64")
c = installprinter("COUL990C", serveur & "COUL990C")
c = installprinter("ELEC5SIM", serveur & "ELEC5SIM")
c = installprinter("MECA8100", serveur & "MECA8100")
c = installprinter("CAFE3330", serveur & "CAFE3330")
c = installprinter("COMP2100", serveur & "COMP2100")
c = installprinter("EMM5100", serveur & "EMM5100")
c = installprinter("ELEC5SIM", serveur & "HP8100-02")
c = installprinter("HP8100-02", serveur & "HP8100-02")
'=== printers exception for specifics users
if strUserName = "doucet.gm" then
a = maingroup
b = serveur & "COUL3600"
c = installprinter(a, b)
b = ""
objNet.SetDefaultPrinter b
end if
if strUserName = "bourque.jf" then
a = maingroup
'=== imprimante a michelle tremblay
b = "\\dtcs316792\hplaserj"
c = installprinter(a, b)
b = "IBM proprinter xl II"
objNet.SetDefaultPrinter b
b = "\\DTCS166981\HPLJ3330PS"
c = installprinter(a, b)
end if
if strUserName = "bouchard.pierre" then
b = serveur & "SCAN2200"
err.clear
objNet.SetDefaultPrinter b
'if err.number<>0 then
' b = serveur & "scan4080_noir"
' objNet.SetDefaultPrinter b
'end if
end if
if strUserName = "fournier.serge" then
b = serveur & "scan4080_noir"
err.clear
objNet.SetDefaultPrinter b
if err.number<>0 then
b = serveur & "ELEC5SIM"
objNet.SetDefaultPrinter b
end if
end if
if strUserName = "duchesne.patrice" then
b = serveur & "SCAN2200"
err.clear
objNet.SetDefaultPrinter b
if err.number<>0 then
b = serveur & "scan4080_noir"
objNet.SetDefaultPrinter b
end if
end if
if strUserName = "guay.francois" then
a = maingroup
'=== imprimante a michelle tremblay
b = "\\dtcs316792\hplaserj"
c = installprinter(a, b)
b = "HP LaserJet 4 Plus"
objNet.SetDefaultPrinter b
b = "\\DTCS166981\HPLJ3330PS"
c = installprinter(a, b)
end if
if strUserName = "potvin.andre" then
a = maingroup
'=== imprimante a michelle tremblay
b = "\\mtre20040106\mtremblay1"
c = installprinter(a, b)
objNet.SetDefaultPrinter b
end if
if strUserName = "quenneville.anne" then
a = maingroup
'=== imprimante a jfbourque (étiquettes)
b = "\\Rla20050210\IBM Proprinter XL II"
c = installprinter(a, b)
objNet.SetDefaultPrinter b
b = "\\DTCS166981\HPLJ3330PS"
c = installprinter(a, b)
end if
if strUserName = "tremblay.m" then
b = "\\Mtre20040106\HPLaserJ"
objNet.SetDefaultPrinter b
end if
'objFil01.WriteLine date & " " & time & " printer no color by default "
'=== we dont want color printer to be the default printer, so if it is, we put black and white
a = "SCAN4080"
b = serveur & "SCAN4080_COUL"
c = serveur & "SCAN4080_NOIR"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
'objFil01.WriteLine date & " " & time & " printer black become recto verso "
if usenam<>"morin.pierre" and usenam<>"morin.gilles" and usenam<> "mancheron.jimmy" and usenam<>"duchaine.robin" then
a = "SCAN4080"
b = serveur & "SCAN4080_NOIR"
c = serveur & "SCAN4080_RECTO_VERSO"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
end if
a = "SCAN2200"
b = serveur & "SCAN2200_RECTO_VERSO"
c = serveur & "SCAN2200"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
a = "SCAN2200MEC"
b = serveur & "SCAN2200MEC"
c = serveur & "SCAN2200MEC_RECTO_VERSO"
strComputer = "."
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colPrinters = objWMIService.ExecQuery("Select * from Win32_Printer Where Default = TRUE")
For Each objPrinter in colPrinters
strOldDefault = objPrinter.Name
'strOldDefault = Replace(strOldDefault, "\", "\\")
Next
if lcase(b) = lcase(strOldDefault) then
objNet.SetDefaultPrinter c
end if
'msgfin = msgfin & paspil
''''objshe.Run script01 & " FIN ""Imprimantes installées`n" & totren & " / " & totold & "`n" & msgfin & """ 15 1+16",, False
end if
'=== outlook 2007 is there, we copy our macro pack
a = regrea(0, hklm, "SOFTWARE\Microsoft\Office\12.0\outlook\InstallRoot", "path")
b = 0
if isnull(a) then
else
des = a & "outlook.exe"
if objFSO.fileEXISTS(des) then
b = 1
end if
end if
'=== outlook message change before send
'HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail
'HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Options\Mail
'Clé DWORD : « Send Pictures With Document » = 0
des = useout & "outlook.exe"
if objFSO.fileEXISTS(des) then
'objFil01.WriteLine date & " " & time & " outlook repair hyperlinks "
'=== hyperlink repair outlook 2007
a="HKEY_CLASSES_ROOT\outlook\URL Protocol"
d=regwri(a,"","REG_SZ")
a="HKEY_CLASSES_ROOT\outlook\"
d=regwri(a,"URL:Outlook Folders","REG_SZ")
a="HKEY_CLASSES_ROOT\outlook\shell\"
d=regwri(a,"open","REG_SZ")
a="HKEY_CLASSES_ROOT\outlook\shell\open\"
d=regwri(a,"","REG_SZ")
'=== hyperlink repair outlook 2007 (all version modif)
a="HKEY_CLASSES_ROOT\outlook\shell\open\command\"
d=regwri(a,"""" & des & """ /select ""%1""","REG_SZ")
end if
For each i in arroff
a="HKEY_CURRENT_USER\Software\Microsoft\Office\" & i & ".0\Outlook\Options\Mail\Send Pictures With Document"
d=regwri(a,0,"REG_DWORD")
next
'=== outlook macro project copy on certain clients
'objFil01.WriteLine date & " " & time & " outlook projet macros "
if usenam<>"system" and _
(b=1 and usenam<>"boivin.francois") or _
(b=1 and usenam<>"fournier.serge") or _
(usenam="fournier.serge" and sysnam="stas-ts-02") or _
(usenam="boivin.francois" and sysnam="stas-ts-02") or _
usenam="boulianne.robin" or _
usenam="dufour.christian" or _
usenam="desbiens.jf" or _
usenam="pichette.chantal" or _
usenam="fortin.carl" or _
usenam="vezina.pascal" or _
usenam="duchesne.patrice" or _
usenam="guerin.claude" or _
usenam="cote.lise" or _
usenam="paiement.mf" or _
usenam="receptionniste" or _
usenam="réceptionniste" or _
usenam="gauthier.helene" then
'=== outlook vba machine setup
filnam = "VbaProject.OTM"
sou = ser & "\users\_stas\outlook\" & filnam
des = useappdat & "\Microsoft\Outlook\" & filnam
objFSO.copyFile sou, des, TRUE
if err<>0 and usenam=debugname then
'msgbox("ERROR" & vbcrlf & "macro outlook pas copiees")
msgfin = msgfin & "`n" & "DEBUG macro outlook pas copiees"
msgfin03 = msgfin03 & VBCRLF & "DEBUG macro outlook pas copiees"
elseif usenam=debugname then
'msgbox(sou & vbcrlf & des)
end if
'=== barre outils acces rapide (QAT) quick access tool bar
filnam = "olkmailitem.qat"
sou = ser & "\users\_stas\outlook\" & filnam
des = uselosappdat & "\Microsoft\office\" & filnam
objFSO.copyFile sou, des, TRUE
if err<>0 and usenam=debugname then
'msgbox("ERROR" & vbcrlf & "QAT pas copie" & vbcrlf & sou & vbcrlf & des)
msgfin03 = msgfin03 & VBCRLF & "DEBUG QAT pas copie"
msgfin = msgfin & "`n" & "DEBUG QAT pas copie"
elseif usenam=debugname then
'msgbox(sou & vbcrlf & des)
end if
end if
'========= start outlook user
if usenam <>"system"_
and usernam <> "admin1" _
and usernam <> "admin2" _
and usernam <> "admin3" _
then
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Policies\Microsoft\Office\11.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Policies\Microsoft\Office\12.0\Common\DisableHyperlinkWarning"
d=regwri(a,1,"REG_DWORD")
'=== display contacts in outlook 2007
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\ShowContactField"
d=regwri(a,1,"REG_DWORD")
'=== outlook windows position
'strRegKey = "Software\Microsoft\Office\11.0\Outlook\"
'arrRegData = array(&h3f,&H05,&Hc0,&H7c,&Hff,&Hff,&Hff,&Hff,&H06,&H89,&H00,&H00,&H06,&H89,&H00,&H00,&H04,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H04,&H00,&H00,&H00)
'strRegValue = "settings"
'objReg.SetBinaryValue HKCU, strRegKey, strRegValue, arrRegData
'=== outlook goes to tray when minimized outlook tray outlook minimized
if usenam="larouche.michel"_
or usenam="pettersen.mathieu"_
or usenam="fournier.serge"_
or usenam="dufour.stephane"_
then
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\MinToTray"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\MinToTray"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\MinToTray"
d=regwri(a,1,"REG_DWORD")
else
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\MinToTray"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\MinToTray"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\MinToTray"
d=regwri(a,0,"REG_DWORD")
end if
'=== ambiguous name resolution offline --> online outlook 10.0 et 11.0 ===============
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Cached Mode\ANR Include Online GAL"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Cached Mode\ANR Include Online GAL"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Cached Mode\ANR Include Online GAL"
d=regwri(a,1,"REG_DWORD")
'=== macro securite off dans outlook 10 et 11
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\VBAWarnings"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\DataConnectionWarnings"
d=regwri(a,0,"REG_DWORD")
'=== manual registration of dll file to use with object oriented application
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\Description"
'b="Add-In Project Template"
'c="REG_SZ"
'd=regwri(a,b,c)
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\FriendlyName"
'b="My Add-In"
'c="REG_SZ"
'd=regwri(a,b,c)
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\LoadBehavior"
'b=3
'c="REG_DWORD"
'd=regwri(a,b,c)
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\Outlook\AddIns\BoutonsOutlookSTAS.Connect\CommandLineSafe"
'b=0
'c="REG_DWORD"
'd=regwri(a,b,c)
'=== outlook cached mode with favorites publics in cache
'=== Registry constants
' const CLASSID_SUBKEY = "CLSID\{0006F03A-0000-0000-C000-000000000046}\LocalServer32"
if usenam<>"fortin.dominic" and usenam <>"dufour.christian" then
const PROFILE_SUBKEY = "Software\Microsoft\Windows NT\CurrentVersion\Windows Messaging Subsystem\Profiles"
const EXCHCFG_VALUE = "00036601"
dim objreg , lngRC, lngValueType, vntValueData
dim arrnames, lngn, arrTypes ,a
Set objReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\default:StdRegProv")
'=== read default outlook profile name
err.clear
defpro=""
b = "defaultprofile"
lngRC = objReg.GetStringValue(HKCU, PROFILE_SUBKEY , b, defpro)
if err<>0 then
msgbox("CAnnot find defaut outlook profile" & vbcrlf & PROFILE_SUBKEY & vbcrlf & b)
end if
'=== read config
if defpro<>"" then
c = PROFILE_SUBKEY & "\" & defpro & "\13dbb0c8aa05101a9bb000aa002fc45a"
d = "00036601"
lngRC = objReg.GetBinaryValue(HKCU, c, d, arrcfgout)
end if
'=== change outlook cache config
'objFil01.WriteLine date & " " & time & " outlook cache mode "
'=== if we are on terminal server, outlook cache OFF
if sysnam="stas-ts-02" then
arrcfgout(0) = arrcfgout(0) And &H7F ' Disable 8th bit in 1st byte
arrcfgout(1) = arrcfgout(1) And &HFa ' Disable 1st bit in 2nd byte
else
arrcfgout(0) = arrcfgout(0) Or &H80 ' Enable 8th bit in 1st byte
' Enable 1st bit in 2nd byte = cached mode
' Enable 3rd bit in 2nd byte = cached mode favorite public folders
arrcfgout(1) = arrcfgout(1) Or &H05
end if
'=== save outlook cache config
objReg.SetBinaryValue hkcu, c, d, arrcfgout
end if
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err outlook"
end if
end if
'====== end outlook user
'========= end outlook
'====== start reg inscriptions =========== GENERAL SECTION
if usenam="system" or admrig = 1 then
'=== nrg file will run with daemon tools
'=== need admin right for this one
a=""
f = prodir & "\d-tools"
e = "\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f = prodir & "\daemon tools"
e = "\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir32 & "\d-tools"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir32 & "\daemon tools"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir & "\daemon tools Lite"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
f=prodir32 & "\daemon tools Lite"
e="\daemon.exe"
if objFSO.fileEXISTS(f & e) then
a =f & e
d = f
end if
if a<>"" then
b="iso"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="bin"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="nrg"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="img"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="ccd"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="cue"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
b="000"
c=runwit(a &" -mount 0, ""%l""",b,"imagecd" & b)
'=== remove cd in virtual cd rom drive
if usenam = debugname then
'msgbox (chr(34) & a & " -unmount 0" & chr(34))
end if
'objshe.Run chr(34) & a & chr(34) & " -unmount 0",, false
'=== remove update chek for daemon
'=== d = directory where it was found
des = d & "\chkupd.exe"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
end if
'=== image disquettes dans le b:
b="ima"
c=runwit("c:\_stas\virtual_floppy\vfdwin.exe /open ""%l""",b,"imagefloppy" & b)
end if
if usenam <>"system" then
toterrcop =0
'objFil01.WriteLine date & " " & time & " exlorer setup "
'====== INTERNET EXPLORER
'=== WINDOW POSITION (need a relog to be effective)
'=== disable regdebugger in iexplorer
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Disable Script Debugger","yes","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\Error Dlg Displayed On Every Error","no","REG_SZ")
'=== reset internet explorer windows position
if usenam<>"dufour.stephane" then
a = "Software\Microsoft\Internet Explorer\Main\"
b = "Window_Placement"
c = array(&h2c,&h00,&h00,&h00,&h00,&h00,&h00,&h00,&h01,&h00,&h00,&h00,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&hff,&h82,&h01,&h00,&h00,&h6a,&h00,&h00,&h00,&hf9,&h03,&h00,&h00,&h60,&h02,&h00,&h00)
d = regwribin(hkcu,a,b,c)
end if
if usenam="réceptionniste" or usenam="receptionniste" or usenam="fournier.serge" then
'=== find most recent office folder for temp files outlook attachements
'=== to prevent bug where image in outlook are not displayed
useoutfol=""
for each a in arroff
useoutfol = regrea(0, hkcu, "Software\Microsoft\Office\" & a & ".0\Outlook\Security", "OutlookSecureTempFolder")
if len(useoutfol)<>0 then exit for
next
'=== folder exist chekup
if objfso.folderexists(useoutfol)<>0 then
'msgbox(useoutfol)
'objshe.Run "explorer.exe " & useoutfol
sou=useoutfol
Set objFolder = objFSO.GetFolder(sou)'=== dir
Set objFiles = objFolder.files '=== directory
'=== chek all file in folder
For Each objFile in objFiles
'=== delete files in that folder
a=objFile.Name
aa=useoutfol & "\" & a
objfso.deletefile(aa),true
next
end if
end if
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\main\runoncecomplete"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\main\runoncehasshown"
d=regwri(a,1,"REG_DWORD")
'=== internet default search bar
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\DefaultScope"
d=regwri(a,"{6B9974B2-B820-4CA9-A7BA-059ADD46CF34}","REG_SZ")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\Version"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\{6B9974B2-B820-4CA9-A7BA-059ADD46CF34}\DisplayName"
d=regwri(a,"Google","REG_SZ")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\SearchScopes\{6B9974B2-B820-4CA9-A7BA-059ADD46CF34}\URL"
d=regwri(a,"http://www.google.com/search?q={searchTerms}&rls=com.microsoft:{language}&ie={inputEncoding}&oe={outputEncoding}&startIndex={startIndex?}&startPage={startPage}","REG_SZ")
a = "HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Desktop\Components\GeneralFlags"
d=regwri(a,0,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Url History\DaysToKeep"
d=regwri(a,14,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\stas.biz\www\http"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1001"
d=regwri(a,0,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1004"
d=regwri(a,0,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\1201"
d=regwri(a,0,"REG_DWORD")
a = "Software\Microsoft\Windows\CurrentVersion\Internet Settings\Zones\1\"
b = "1c00"
c = array(&h00,&h00,&h02,&h00)
d = regwribin(hkcu,a,b,c)
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\EnableNegotiate"
d=regwri(a,1,"REG_DWORD")
a= "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\intranet.stas.biz\*"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\stas.biz\intranet\http"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\stas.biz\www\"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\EscDomains\stas.biz\www\http"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\unigec.com\*"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Domains\intranet.corp.stas.local\*"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Ranges\Range1\http"
d=regwri(a,2,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\ZoneMap\Ranges\Range1\http\:Range"
d=regwri(a,"172.16.0.50","REG_SZ")
'====== WINDOWS XP
'====== explorer
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\LinkResolveIgnoreLinkInfo"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoResolveTrack"
d=regwri(a,1,"REG_DWORD")
'=== display hidden extension (of known files)
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\HideFileExt"
d=regwri(a,0,"REG_DWORD")
'=== remove web view
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\WebView"
d=regwri(a,0,"REG_DWORD")
'=== remove personalized menu
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\IntelliMenus"
d=regwri(a,"No","REG_SZ")
a="HKEY_CURRENT_USER\Software\Microsoft\Internet Explorer\Main\FavIntelliMenus"
d=regwri(a,"No","REG_SZ")
'=== explorer in classic mode
'=== if the user is not in thos global group in domain, he get classic mode
if instr(usegrp, "cn=exception_winxp_classic")=0 then
a = "Software\Microsoft\Windows\CurrentVersion\Explorer\"
b = "shellstate"
c = array(&h24,&H00,&H00,&H00,&H33,&H08,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H01,&H00,&H00,&H00,&H0d,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00,&H00)
d = regwribin(hkcu,a,b,c)
'===
a = "Software\Microsoft\Windows\CurrentVersion\Explorer\"
b = "IconUnderline"
c = array(&h03, &h00, &h00, &h00)
d = regwribin(hkcu,a,b,c)
'=== hide unused icons in task bar
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\EnableAutoTray"
d=regwri(a,0,"REG_DWORD")
'=== classic icons win 2003 et win xp
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\ForceClassicControlPanel"
d=regwri(a,1,"REG_DWORD")
'=== do not remember folder setting
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ClassicViewState"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\IntelliMenus"
d=regwri(a,"No","REG_SZ")
'=== lock task bar or not
if usenam="fournier.serge" or usenam="admin3" then
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\TaskbarSizeMove"
'1 = not locked
d=regwri(a,1,"REG_DWORD")
end if
'=== group similars elements in task bar
if usenam="fournier.serge" or usenam="admin3" then
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\TaskbarGlomming"
d=regwri(a,0,"REG_DWORD")
end if
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\WebViewBarricade"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\FolderContentsInfoTip"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\FriendlyTree"
d=regwri(a,1,"REG_DWORD")
'=== system file and hidden = superhidden
'a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\ShowSuperHidden"
'd=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\DisableThumbnailCache"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\NoNetCrawling"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\PersistBrowsers"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced\Hidden"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\HideMyComputerIcons\{21EC2020-3AEA-1069-A2DD-08002B30309D}"
d=regwri(a,0,"REG_DWORD")
end if
a = "Software\Microsoft\Windows\CurrentVersion\Explorer\"
b = "link"
c = array(&h00,&h00,&h00,&h00)
d = regwribin(hkcu,a,b,c)
'=== visite guidee a off - windows tour off
a="HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Applets\Tour\RunCount"
d=regwri(a,0,"REG_DWORD")
'=== office macro security
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Options\QuerySecurity"
d=regwri(a,2,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Options\QuerySecurity"
d=regwri(a,2,"REG_DWORD")
'=== bug avec office 2003 sp3 et office 2007 (old files version not openable)
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Word\Security\Fileopenblock"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Word\Security\Fileopenblock"
d=regwri(a,0,"REG_DWORD")
'LotusandQuattroFiles
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\excel\Security\Fileopenblock\LotusandQuattroFiles"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\Fileopenblock\LotusandQuattroFiles"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\excel\Security\Fileopenblock\DifandSylkFiles"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\excel\Security\Fileopenblock\DifandSylkFiles"
d=regwri(a,0,"REG_DWORD")
a="Hkey_current_user\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer\NoRecentDocsNetHood"
'=== OFF (bug)
'd=regwri(a,1,"REG_DWORD")
'====== odbc sql ========
'objFil01.WriteLine date & " " & time & " odbc sql etc "
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Driver"
d=regwri(a,"%windir%\system32\SQLSRV32.dll","REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Description"
d=regwri(a,"sql01","REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Server"
d=regwri(a,"sql.corp.stas.local","REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\UID"
d=regwri(a,usenam,"REG_SZ")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Trusted_Connection"
d=regwri(a,"Yes","REG_SZ")
'=== créer un path sans valeur "\" at end, c = "" (type)
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\sql01\Engines\"
d=regwri(a,"","")
a="HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources\sql01"
d=regwri(a,"SQL server","REG_SZ")
'=== excel odbc on pc 64 bits
'ACEODBC.DLL
'C:\Program Files\Fichiers communs\Microsoft Shared\OFFICE12
'commonprogramfiles
b=0
for each a in arroff
filnam = "ACEODBC.DLL"
desdir = comfil & "\Microsoft Shared\office" & a
des = desdir & "\" & filnam
if objFSO.fileEXISTS(des) then
b=b+1
if usenam=debugname then
'msgbox(des)
end if
end if
next
'=== did not find the dll for excel database in any version of office
if b=0 then
'=== on prend le office le plus récent (last of array)
a=ubound(arroff)
desdir = comfil & "\Microsoft Shared\office" & arroff(a)
if objfso.folderexists(desdir)=0 then
a=makfol(desdir)
end if
filnam = "ACEODBC.DLL"
sou = ser & "\users\office\" & filnam
des = desdir & "\" & filnam
a=copyfile(sou,des)
end if
'====== odbc CSV magicacsv======== bug avec windows 64
'=== use odbcad32.exe in syswow64 to edit
filnam = "odbcjt32.dll"
sou = ser & "\users\office\" & filnam
desdir = windir & "\syswow64"
des = desdir & "\" & filnam
if objFSO.fileEXISTS(des)=0 then
a=copyfile(sou,des)
end if
if objFSO.fileEXISTS(des) then
'=== register modif
a="HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\Microsoft Text Driver (*.txt; *.csv)\Driver"
d=regwri(a,"C:\WINDOWS\syswow64\odbcjt32.dll","REG_SZ")
end if
filnam = "odtext32.dll"
sou = windir & "\syswow64\" & filnam
if objFSO.fileEXISTS(sou) then
a="HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\Microsoft Text Driver (*.txt; *.csv)\Setup"
d=regwri(a,"C:\WINDOWS\syswow64\odtext32.dll","REG_SZ")
'=== odbcinst.ini modif
end if
filnam = "odbcjt32.dll"
sou = windir & "\syswow64\" & filnam
filnam = "odtext32.dll"
sou2 = windir & "\syswow64\" & filnam
'=== driver missing in windows 64 bits (require reboot)
filnam = "p2sodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\system32\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "p2sodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\syswow64\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "pdsodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\system32\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "pdsodbc.dll"
sou = ser & "\users\_stas\magica_odbc_text\" & filnam
desdir = windir & "\syswow64\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
if objFSO.fileEXISTS(sou) and objFSO.fileEXISTS(sou2) then
sou = windir & "\odbcinst.ini"
Set OBJFILE01 = objFso.OpenTextFile(sou, 1)
SOU = windir & "\odbcinst.ini.new"
Set objfile02 = objFso.OpenTextFile(sou, 2, true)
if usenam = debugname then
'msgbox(sou)
end if
If Err.number = 0 Then
b=0
do while OBJFILE01.AtEndOfStream <> True
b=b+1
a=lcase(objFile01.ReadLine)
c=lcase("[Microsoft Text Driver (*.txt; *.csv) (32 bits)]")
d=lcase("[microsoft text driver (*.txt; *.csv) (32 bit)]")
if a=c or a=d then
objfile02.writeline a
a=lcase(objFile01.ReadLine)
c=lcase("driver=c:\windows\system32\odbcjt32.dll")
if a=c then
a=lcase("driver=c:\windows\syswow64\odbcjt32.dll")
end if
objfile02.writeline a
a=lcase(objFile01.ReadLine)
c=lcase("setup=c:\windows\system32\odtext32.dll")
if a=c then
a=lcase("setup=c:\windows\syswow64\odtext32.dll")
end if
end if
objfile02.writeline a
Loop
objfile01.close
objfile02.close
sou = windir & "\odbcinst.ini"
des = windir & "\odbcinst.ini.old"
a=copyfile(sou,des)
sou = windir & "\odbcinst.ini.new"
des = windir & "\odbcinst.ini"
a=copyfile(sou,des)
else
'msgbox("error - sef- " & vbcrlf & err.description)
'toterrcop = toterrcop +1
msgfin03 = msgfin03 & "error - fichier pas trouvé" & vbcrlf & sou & vbcrlf & vbcrlf
msgfin03 = msgfin03 & "error - fichier pas trouvé" & vbcrlf & sou2 & vbcrlf & vbcrlf
END IF
end if
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\MagicaCsv]
'"DefaultDir"="C:\\DOCUME~1\\FOURNI~1.SER\\LOCALS~1\\Temp\\MagicaCsv"
'"Driver"="odbcjt32.dll"
'"DriverId"=dword:0000001b
'"Fil"="text;"
'"SafeTransactions"=dword:00000001
'"UID"=" "
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\MagicaCsv\Engines]
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\MagicaCsv\Engines\Text]
'"Extensions"="txt,csv,tab,asc"
'"ImplicitCommitSync"="Yes"
'"UserCommitSync"="Yes"
'"Threads"=dword:00000003
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources]
'"MagicaCsv"="Microsoft Text Driver (*.txt; *.csv)"
'[HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text]
'"ImplicitCommitSync"=""
'"Threads"=dword:00000003
'"UserCommitSync"="Yes"
'objFil01.WriteLine date & " " & time & " sweet cd media "
'=== cd sweet cd media
a="HKEY_CURRENT_USER\Software\The McGraw-Hill Companies\Sweet's CD\Path\Media1"
d=regwri(a,"\\corp\stas\references\sweetcd\cd1","REG_SZ")
a="HKEY_CURRENT_USER\Software\The McGraw-Hill Companies\Sweet's CD\Path\Media2"
d=regwri(a,"\\corp\stas\references\sweetcd\cd2","REG_SZ")
a="HKEY_CURRENT_USER\Software\The McGraw-Hill Companies\Sweet's CD\Path\Media3"
d=regwri(a,"\\corp\stas\references\sweetcd\cd3","REG_SZ")
'====== office 10 and 11
'=== remove personalized menu
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Common\Toolbars\AdaptiveMenus"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Common\Toolbars\AdaptiveMenus"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Common\Toolbars\AdaptiveMenus"
d=regwri(a,0,"REG_DWORD")
'=== security macros
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Word\Security\Level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Word\Security\Level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Word\Security\Level"
d=regwri(a,1,"REG_DWORD")
'=== excel security
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Excel\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Excel\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Excel\Security\level"
d=regwri(a,1,"REG_DWORD")
'=== access security
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\access\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\access\Security\level"
d=regwri(a,1,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\access\Security\level"
d=regwri(a,1,"REG_DWORD")
'=== access sandbox pour les securité dans access
a="HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Jet\4.0\Engines\SandBoxMode"
d=regwri(a,2,"REG_DWORD")
'=== outlook disable autoarchive
'=== delkey
'HKEY_LOCAL_MACHINE\Software\Microsoft\Office\10.0\Outlook
a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\DoAging"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\DoAging"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Preferences\DoAging"
d=regwri(a,0,"REG_DWORD")
'GetBinaryValue - reads regisry value of BINARY type
'GetDWORDValue - reads registry value of DWORD type
'GetExpandedStringValue - reads registry value of EXPANDED STRING type
'GetMultiStringValue - reads registry value of MULTI STRING type
'GetStringValue - reads registry value of STRING type
'CreateKey - creates registry key
'SetBinaryValue - writes registry value of BINARY type
'SetDWORDValue - writes registry value of DWORD type
'SetExpandedStringValue - writes registry value of EXPANDED STRING type
'SetMultiStringValue - writes registry value of MULTI STRING type
'SetStringValue - writes registry value of STRING type
'DeleteKey - deletes registry key
'DeleteValue - deleting registry value
'EnumKey - enumerates registry key
'EnumValues - enumerates registry value
'CheckAccess - checks permissions on registry key
'Const HKEY_CLASSES_ROOT = &H80000000
'Const HKEY_CURRENT_USER = &H80000001 HKCU
'Const HKEY_LOCAL_MACHINE = &H80000002
'Const HKEY_USERS = &H80000003
'Const HKEY_CURRENT_CONFIG= &H80000005
'=== office default name and initials
'str01="11.012.0"
'for x=0 to len(stroff)/int01
a = "Software\Microsoft\Office\11.0\Common\UserInfo\"
b = "UserName"
c = StringToArray(usefna & " " & uselna)
d = regwribin(hkcu,a,b,c)
a = "Software\Microsoft\Office\11.0\Common\UserInfo\"
b = "UserInitials"
c = StringToArray(Left(usefna, 1) + Left(uselna, 1))
d = regwribin(hkcu,a,b,c)
a = "Software\Microsoft\Office\11.0\Common\UserInfo\"
b = "Company"
c = StringToArray("Stas")
d = regwribin(hkcu,a,b,c)
'next x
'=== acrobat remove security warning
'=== delkey
'=== adobe Disable Adobe automatic updates
a="HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\6.0\Updater\iUpdateFrequency"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\7.0\Updater\iUpdateFrequency"
d=regwri(a,0,"REG_DWORD")
a="HKEY_CURRENT_USER\Software\Adobe\Acrobat Reader\8.0\Updater\iUpdateFrequency"
d=regwri(a,0,"REG_DWORD")
d=regdeltre(hkcu,"Software\Adobe\Acrobat Distiller\4.0\Security")
d=regdeltre(hkcu,"Software\Adobe\Acrobat Distiller\5.0\Security")
'=== keyboard adjust
d=regdeltre(hkcu,"Keyboard Layout\Preload")
d=regdeltre(hkcu,"Keyboard Layout\Substitutes")
a="HKEY_CURRENT_USER\Keyboard Layout\Preload\1"
d=regwri(a,"00000c0c","REG_SZ")
a="HKEY_CURRENT_USER\Keyboard Layout\Substitutes\00000c0c"
d=regwri(a,"00001009","REG_SZ")
'=== no welcome screen statup
a="HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\tips\Show"
d=regwri(a,0,"REG_DWORD")
'=== outlook editor not word
if instr(usegrp, "cn=exception_outlook_editeur")=0 then
'a="HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Options\Mail\EditorPreference"
'd=regwri(a,"196610","REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Options\Mail\EditorPreference"
d=regwri(a,"196610","REG_DWORD")
a="HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Options\Mail\EditorPreference"
d=regwri(a,"196610","REG_DWORD")
end if
'objFil01.WriteLine date & " " & time & " regional setting "
'=== regional parameters canada
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sList",";","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sLanguage","FRC","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sLongDate","d MMMM yyyy","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sShortDate","yyyy-MM-dd","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sThousand"," ","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sTimeFormat","HH:mm:ss","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sMonDecimalSep",",","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sMonThousandSep"," ","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iCountry","2","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iCurrency","3","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iDate","2","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iMeasure","0","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iNegCurr","15","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iTime","1","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\iTLZero","1","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\Locale","00000C0C","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\s1159","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\s2359","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sCountry","Canada","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Control Panel\International\sDecimal",",","REG_SZ")
'=== remove transition effect info bubble
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\UserPreferencesMask",90320080,"REG_BINARY")
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\SmoothScroll","0","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\MinAnimate","0","REG_SZ")
'=== dont display window content when mooving it
d=regwri("HKEY_CURRENT_USER\Control Panel\Desktop\DragFullWindows","0","REG_SZ")
'=== csv datasource magica
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Driver","c:\WINdows\Syswow64\odbcjt32.dll","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\DefaultDir","M:\TEMP\CLIENTS","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Description","Données Magica sur les clients","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\DriverId","27","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\FIL","text;","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\SafeTransactions","00000000","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\UID","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text\ImplicitCommitSync","","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text\Threads","00000003","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\Clients\Engines\Text\UserCommitSync","Yes","REG_SZ")
d=regwri("HKEY_CURRENT_USER\Software\ODBC\ODBC.INI\ODBC Data Sources\Clients","Microsoft Text Driver (*.txt; *.csv)","REG_SZ")
'=== numlock on
d=regwri("HKEY_CURRENT_USER\Control Panel\Keyboard\InitialKeyboardIndicators","2","REG_SZ")
'=== come back to inbox after a open message move or delete
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\10.0\Outlook\Preferences\AfterMove","1","REG_DWORD")
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Preferences\AfterMove","1","REG_DWORD")
'=== internet explorer refresh each visit
b=regwri("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\SyncMode5","3","REG_DWORD")
'=== internet explorer cache 15 mb
if instr(usegrp, "cn=exception_15mbiecache")=0 then
b=regwri("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\5.0\Cache\Content\CacheLimit","15360","REG_DWORD")
b=regwri("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Internet Settings\Cache\Content\CacheLimit","15360","REG_DWORD")
end if
'=== internet explorer assistant completed
d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Internet Connection Wizard\Completed","1","REG_DWORD")
'=== file management (cache of certain files locally on computers)
'=== copy users\_stas and 1 level of subfolders in c:\_stas
'=== warning: dont create a second level of subfolders, it wont copy!!!
end if
'objFil01.WriteLine date & " " & time & " vente logiciel update "
'=== update logiciel ventes (Exe)
'=== futur faire une version pour 64bit "program files (x86)"
if usenam <>"system" then
toterrcop = 0
filnam = "tachevente.exe"
sou = ser & "\users\tachevente\" & filnam
des = prodir & "\stas ventes\gestion taches\" & filnam
if objFSO.fileEXISTS(des) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
'=== copy des .rpt dans le root du c:\ car un path absolu ne bug pas
filnam = "ReportTacheDateRemise.rpt"
sou = prodir & "\stas ventes\gestion taches\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
filnam = "ReportTachePers.rpt"
sou = prodir & "\stas ventes\gestion taches\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
filnam = "ReportTacheResponsable.rpt"
sou = prodir & "\stas ventes\gestion taches\" & filnam
des = "c:\" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err tacheventes"
end if
end if
end if
'\\corp.stas.local\stas\NetLogon\users\WinZip\winzip32.exe /noqp /noc4u /notip /nodesktop /autoinstall
'Copier le fichier de licence
'\\corp.stas.local\stas\NetLogon\users\WinZip\winzip.wzmul
'Dance ce répertoire!
'C:\Documents and Settings\All Users\Application Data\WinZip\WinZip.wzmul
sub removed01
if usenam ="system" or admrig=1 then
'objFil01.WriteLine date & " " & time & " licence winzip "
FILNAM = "WINZIP32.EXE"
DES = prodir & "\winzip"
a=makfol(des)
DES = prodir & "\winzip" & filnam
if objFSO.fileEXISTS(des)=0 or usenam = debugname then
sou = ser & "\users\WinZip\"
DES = prodir & "\winzip"
a= copyfold(sou,des)
a = chr(34) & prodir & "\winzip\winzip32.exe" & chr(34) & " /noqp /noc4u /notip /nodesktop /autoinstall"
if usenam = debugname then
'msgbox(a)
end if
objshe.Run A,, false
end if
filnam = "winzip.wzmul"
sou = ser & "\users\WinZip\" & filnam
des = allappdat & "\winzip"
a=makfol(des)
des = allappdat & "\winzip" & filnam
if objFSO.fileEXISTS(sou) then
a=copyfile(sou,des)
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err winzip"
end if
end if
END IF
end sub
if usenam ="system" or admrig=1 then
'=== telephonie ip
'objFil01.WriteLine date & " " & time & " telephone ip "
filnam = "i2050.exe"
des = prodir & "\Nortel Networks\i2050SoftwarePhone\" & filnam
'=== installe client a un user et ne reboot pas
if objFSO.fileEXISTS(des)=0 then
if (usenam="fournier.serge" and sysnam = "ltcs25242") or _
(usenam="boivin.francois" and sysnam = "dtcs353061") or _
(usenam="fournier.serge" and sysnam = "dtcs383642")_
then
filnam= "setup.exe"
des = "Y:\Apps\telephonie_Nortel\" & filnam
if objFSO.fileEXISTS(des) then
A = des & " /s /v/qn"
'objshe.Run A,, false
end if
end if
end if
filnam = "i2050.exe"
des = prodir & "\Nortel Networks\i2050SoftwarePhone\" & filnam
if objFSO.fileEXISTS(des) then
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\TPS_Port"
d = regwri(a,"7000","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\Listener_Port"
d = regwri(a,"7000","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\Listener_IP"
d = regwri(a,"*","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\RUDPTimeOut"
d = regwri(a,2,"REG_DWORD")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\TPS_IP"
d = regwri(a,"172.16.0.18","REG_SZ")
a = "SOFTWARE\Nortel Networks\Soft Phone\TPSAbL\"
b = "UseDHCP"
c = array(&h00,&h00,&h00,&h00)
d = regwribin(hklm,a,b,c)
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\i2004\M1"
d = regwri(a,"0","REG_SZ")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\i2004\ServerType"
d = regwri(a,2,"REG_DWORD")
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Nortel Networks\Soft Phone\i2004\BCM"
d = regwri(a,"1","REG_SZ")
if usenam="fournier.serge" and sysnam = "dtcs383642" then
filnam = "i2050.exe"
des = chr(34) & prodir & "\Nortel Networks\i2050SoftwarePhone\" & filnam & chr(34)
objshe.Run des,, false
end if
'=== media player
if usenam="fournier.serge" then
'=== correction media player 11
'setup_wm.exe
filnam = "LegitLibM.dll"
des = prodir & "\Windows Media Player\" & filnam
if objFSO.fileEXISTS(des) then
'LegitLibM.dll renommer .old
'ouvrir media player dire: valider
end if
end if
'=== analyse des fichier video off
' regsvr32 /u shmedia.dll
'=== eula accepted media player 10 11
'KEY: HKLM\Software\Classes\Software\Microsoft\MediaPlayer\Preferences
'VALUE: AcceptedEULA
'TYPE: REG_DWORD
'DATA: 1
'KEY: HKCU\Software\Microsoft\MediaPlayer\Preferences
'VALUE: AcceptedPrivacyStatement
'TYPE: REG_DWORD
'DATA: 1
end if
'=== delete key for terminal server to renew it
a = Regdeltre(hklm, "SOFTWARE\Microsoft\MSLicensing")
end if
'=== magica folders etc
if usenam <>"system" then
'objFil01.WriteLine date & " " & time & " magica update "
toterrcop = 0
totnocopy = 0
tottrycopy = 0
a = serv01 & "\magica\Installation\dllcrystal85\dll85"
b = windir & "\syswow64"
If objFSO.FOLDEREXISTS(b) Then
c = copyfold(a,b)
a = serv01 & "\magica\Installation\MagicaDll"
b = windir & "\syswow64"
c = copyfold(a,b)
end if
a = serv01 & "\magica\Installation\dllcrystal85\dll85"
b = sysdir
c = copyfold(a,b)
a = serv01 & "\magica\Installation\MagicaDll"
b = sysdir
c = copyfold(a,b)
msgfin = msgfin & "`n" & (tottrycopy - (totnocopy+toterrcop)) & " / " & tottrycopy & " cop magica"
'=== magica create folders
desdir=root & "temp"
a=makfol(desdir)
desdir=desdir & "\magicacsv"
a=makfol(desdir)
desdir=root & "magica"
a=makfol(desdir)
desdir=desdir & "\csv"
a=makfol(desdir)
'if usenam="fournier.serge" then
' a="HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\Session Manager\Environment\temp"
' b="c:\temp"
' c="REG_SZ"
' d=regwri(a,b,c)
'end if
msgfin = msgfin & "`n" & toterrcop & " err magica"
end if
'======================= applications --------
if usenam <>"system" then
toterrcop = 0
'objFil01.WriteLine date & " " & time & " cad setup "
'====== autocad
'=== format save on terminal server
if sysnam ="stas-ts-01" then
a="HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R16.0\ACAD-201:409\Profiles\<<Unnamed Profile>>\General\DefaultFormatForSave"
d=regwri(a,"0000000c","REG_DWORD")
end if
'=== format save cad 2008 ele
a="HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\R17.1\ACAD-6007:40C\Profiles\<<ACADE>>\General\DefaultFormatForSave"
d=regwri(a,"00000024","REG_DWORD")
'=== ecrase le default_wdtitle.wdl
filnam = "default_wdtitle.wdl"
sou = serv01 & "\elec\Electrical_Shared_2008\Config_Cart_Std_STAS\" & filnam
desdir = "c:\program files\autodesk\Acade 2008\support\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
filnam = "default.wdt"
sou = serv01 & "\elec\Electrical_Shared_2008\Config_Cart_Std_STAS\" & filnam
desdir = "c:\program files\autodesk\Acade 2008\support\"
des = desdir & filnam
if objfso.folderexists(desdir) then
a=copyfile(sou,des)
end if
'=== ecrase le default.wdt
'test="xcopy " & chr(34) & "J:\Electrical_Shared_2008\Config_Cart_Std_STAS\default.wdt" & chr(34) & " "& chr(34) & "c:\program files\autodesk\Acade 2008\support\" & chr(34) & " /d /h /c /r /y"
'WshShell.Run app & test,1,true
'=== corrige le raccourci dans c:\stascade8 et c:\stascade
arrcad=""
arrcad = array("c:\stascade\plot\Assistant Ajouter un traceur.lnk","c:\stascade8\plot\Assistant Ajouter un traceur.lnk")
For each i in arrcad
set oMyShortcut = objshe.CreateShortcut(i)
a=OMyShortcut.TargetPath
if objFSO.fileEXISTS(a)=0 then
objfso.deletefile(i),true
end if
next
arrcad=""
arrcad = array("C:\Program Files\Autodesk\Acade 2006\addplwiz.exe","C:\Program Files\Autodesk\Acade 2008\addplwiz.exe")
For each i in arrcad
if objFSO.fileEXISTS(i) then
sou = i
if instr(i,"2008") then
des = "c:\stascade8\plot\Assistant Ajouter un traceur.lnk"
elseif instr(i,"2006") then
des = "c:\stascade\plot\Assistant Ajouter un traceur.lnk"
end if
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
end if
next
'=== AJUSTEMENT FICHIERS MECANIQUE
A="C:\stas\STASCART\PETIT_CARTOUCHE_POUR_CLIENT.dwg"
if objFSO.fileEXISTS(A) then
objfso.deletefile(A),true
end if
'=== ajustement approuve.lsp TOUS les cad
filnam = "approuve.lsp"
sou = serv01 & "\system\Apps\CAD_2008_ELECTRICAL\stas\approuve\" & filnam
desdir = "c:\stas\approuve\"
des = desdir & filnam
if objfso.folderexists(desdir) then
if debugname="fournier.serge" then
'msgbox("fichier approuve copié" & vbcrlf & sou & vbcrlf & des)
'=== error log
'filnam = "_01_logon_log.txt"
'Set File02 = objFso.OpenTextFile("c:\_stas\logs\" & filnam, 2, true)
'File02.WriteLine date & " " & time & " " & usegrp
'file02.close
end if
if instr(usegrp, "cn=tec_ele_ing")<>0 or instr(usegrp, "cn=tec_ele_tec")<>0 then
a=copyfile(sou,des)
if debugname="fournier.serge" then
'msgbox("fichier approuve copié" & vbcrlf & sou & vbcrlf & des)
end if
end if
end if
'=== cn=sec (secretariat) group specific caching of files in \_stas
If InStr(usegrp, "cn=sec") or usenam = debugname Then
end if
filnam = "notepad2.exe"
sou = ser & "\users\_stas\util\" & filnam
des = sysdir & "\" & filnam
a=copyfile(sou,des)
If InStr(usegrp, "cn=inf") or usenam = debugname Then
filnam = "notepad2.exe"
sou = ser & "\users\_stas\util\" & filnam
des = sysdir & filnam
a=copyfile(sou,des)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\VBSFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\txtFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\txtFile\Shell\Open\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\batFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\regFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
a="HKEY_LOCAL_MACHINE\SOFTWARE\Classes\cmdFile\Shell\Edit\command\"
b="%SystemRoot%\system32\NOTEPAD2.EXE %1"
c="REG_EXPAND_SZ"
d=regwri(a,b,c)
end if
'objFil01.WriteLine date & " " & time & " raccourcis "
If InStr(usegrp, "cn=informatique") _
or InStr(usegrp, "cn=inf") _
or usenam = debugname _
or usenam="dufour.stephane" _
or usenam="boulianne.robin" _
or usenam="doucet.gm" _
or usenam="mancheron.jimmy" _
Then
sou = "C:\_stas\224211-INFORMATIQUE\_01_désarchivage_x2t.vbs"
des = usedes & "\Désarchivage.lnk"
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
end if
'=== desktop shortcuts
if usenam<>"mancheron.jimmy" _
and usenam<>"fortin.dominic" then
sou = "u:\"
des = usedes & "\Modèles STAS et UNIGEC.lnk"
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
sou = "Z:\BIBLIOROM\AAMSSTP\APP\BIBLIROM.EXE"
des = alldes & "\biblirom.lnk"
ico = sou
arg = ""
hotkey = ""
a = maksho(sou, des, ico, arg,hotkey)
'=== biblio exe update (only if it exist)
des = usedes & "\bibliotheque.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
filnam = "biblio.exe"
sou = ser & "\users\" & filnam
des = prodir & "\biblio\" & filnam
If objFSO.fileEXISTS(des) Then
a=copyfile(sou,des)
sou = prodir & "\biblio\" & filnam
des = alldes & "\bibliotheque.lnk"
ico = "c:\_stas\icons\biblio.ico"
a = maksho(sou, des, ico, "","")
end if
filnam = "biblio.exe"
sou = ser & "\users\" & filnam
des = prodir32 & "\biblio\" & filnam
If objFSO.fileEXISTS(des)=true Then
a=copyfile(sou,des)
sou = prodir32 & "\biblio\" & filnam
des = alldes & "\bibliotheque.lnk"
ico = "c:\_stas\icons\biblio.ico"
a = maksho(sou, des, ico, "","")
end if
'=== bibliorom biblirom
des = usedes & "\biblirom.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
des = usedes & "\bibliorom.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
'=== magica arrêt
filnam = "\Arret magica.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "C:\_stas\util\KillMagicac.bat"
des = alldes & filnam
ico = "C:\_stas\icons\magicaarret.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
'=== magica depart
filnam = "\Départ magica.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "m:\system\depart.bat"
des = alldes & filnam
ico = "C:\_stas\icons\magicadepart.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
'=== shortcut ressources
filnam = "\Ressources.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "\\corp.stas.local\stas\netlogon\users\ressources"
des = alldes & filnam
ico = "C:\_stas\icons\OUTLOOK_1_3.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
end if
if usenam = "fournier.serge" or _
usenam = "juneau.helaine" then
sou = "c:\_stas\util\5tab.vbs"
des = usedes & "\5tab.lnk"
ico = sou
arg = ""
hotkey = "F11"
a = maksho(sou, des, ico, arg,hotkey)
else
des = usedes & "\5tab.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
des = alldes & "\5tab.lnk"
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
end if
if usenam = "fournier.serge" or _
usenam = "pichette.chantal" then
sou = "c:\_stas\util\demandedeprix.vbs"
des = usedes & "\demandedeprix.lnk"
ico = sou
arg = ""
hotkey = "F2"
a = maksho(sou, des, ico, arg,hotkey)
'=== add hidden and system attribute to the shortcut
if usenam=debugname then
Set demofile = objfso.GetFile(des)
date01 = demofile.attributes
'=== super hidden (system attribute on)
date01 = date01 or &hf7
demofile.attributes = date01
end if
end if
'objFil01.WriteLine date & " " & time & " dossier projet update "
'=== dossiers projets creation
If (InStr(usegrp, "cn=comptabilite") or InStr(usegrp, "cn=comptabilité") or usenam="fournier.serge")_
and usenam<>"fortin.dominic" Then
filnam = "Dossier_r03.exe"
sou = ser2 & "\stas\projetsstas\224211-INFORMATIQUE\_programmation\prog_structure-projet\" & filnam
des = usedes & "\" & filnam
If objFSO.fileEXISTS(sou)=true Then
a=copyfile(sou,des)
else
if usenam=debugname then
'msgbox("existe pas" & vbcrlf & sou & vbcrlf & des)
msgfin03=msgfin03 & vbcrlf & "DEBUG system name invalide - " & vbcrlf & sysnam & vbcrlf
msgfin = msgfin & "`n" & "DEBUG DOSSIER_r03.exe pas copie"
end if
end if
end if
'=== machinery handbook
If InStr(usegrp, "cn=meca8100") or usenam = debugname Then
filnam = "\Machinery's Handbook.lnk"
des = usedes & filnam
if objFSO.fileEXISTS(des) then
objfso.deletefile(des),true
end if
sou = "Z:\machinerys-handbook\Handbook.pdf"
des = alldes & filnam
ico = "C:\_stas\icons\AcroRd32_2.ico"
arg = ""
hotkey = ""
a = maksho(sou,des,ico,arg, hotkey)
end if
desdir=useoff & "\Macrolib"
a=makfol(desdir)
'=== excel macro
filnam = "Assismod.xla"
sou = ser & "\users\_stas\macros\" & filnam
des = useoff & "\Macrolib\" & filnam
a=copyfile(sou,des)
'=== office macro
filnam = "XLODBC.XLA"
sou = ser & "\users\_stas\db_sql\" & filnam
des = useoff & "\Macrolib\" & filnam
a=copyfile(sou,des)
'=== office calendar component
filnam = "MSCAL.HLP"
sou = ser & "\users\office\" & filnam
des = useexc & filnam
a=copyfile(sou,des)
filnam = "MSCAL.OCX"
sou = ser & "\users\office\" & filnam
des = useexc & filnam
a=copyfile(sou,des)
test = "regsvr32.exe /s " & des
'if usenam=debugname then
' on error goto 0
' msgbox(test)
' test = "regsvr32.exe /s " & des
' objshe.run test,0,true
' on error resume next
'end if
objshe.run test,0,true
'regsvr32.exe mscal.ocx
'====== approveit
'=== LAST VALUE OF A REG FILE FOR CHEKUP MUST BE A REGULAIR CHAR CHAIN
'a = regfil(basedir & "approveit.reg")
'[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ApproveIt MS Office\Dir]
'"CapturedSigPath"="J:\\SIGNATUR\\CAPTURE"
'[HKEY_CURRENT_USER\Software\VB and VBA Program Settings\ApproveIt MS Office\Files]
'"ReportPath"="c:\\temp\\"
'C:\Program Files\Microsoft Office\Office12
'prodir
'=== library office 12 for macro outlook
filnam = "MSWORD.OLB"
sou = ser & "\users\office\" & filnam
des = prodir & "\Microsoft Office\Office12"
if objFSO.FOLDEREXISTS(des)=0 then
a = makfol(des)
end if
des=des & "\" & filnam
a=copyfile(sou,des)
'======================= end of error trapping ===================================
if toterrcop<>0 then
msgfin = msgfin & "`n" & toterrcop & " err applications"
end if
'=== from now on, no error display, cause its all wastable copies
'====== seagate software
'=== not mandatory, after all error display we do this copy
b = prodir & "\seagate software\viewers\activexviewer\"
if objFSO.FOLDEREXISTS(b) then
filnam = "xqviewer.dll"
sou = ser & "\users\" & filnam
des = b & filnam
a=copyfile(sou,des)
end if
'objFil01.WriteLine date & " " & time & " bibliorom "
'=== path of bibliorom in z: for network user for the cd
if usenam<>"dufour.christian" then
a = regwri("HKEY_CURRENT_USER\Software\Microsoft\Microsoft Reference\BookshelfF\96\Options\Drive","Z:\BIBLIOROM","REG_SZ")
end if
'====== outlook & config if first start
'=== outlook === path de office + outlook.exe = process a executer (variable test)
'=== arroff = all office versions
For each i in arroff
next
'if objFSO.fileEXISTS(useappdat & "\Microsoft\Office\MSOut11.pip")=0 then
' d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Setup\firstrun","-","REG_SZ")
' d=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\11.0\Outlook\Setup\ImportPRF","c:\_stas\outlook\outlook2k3.prf","REG_SZ")
'end if
if objFSO.fileEXISTS(useappdat & "\Microsoft\Office\MSOut12.pip")=0 then
'd=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\firstrun","-","REG_SZ")
'd=regwri("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\ImportPRF","c:\_stas\outlook\outlook2k3.prf","REG_SZ")
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\firstrun")
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\ImportPRF")
else
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\firstrun")
d=regdel("HKEY_CURRENT_USER\Software\Microsoft\Office\12.0\Outlook\Setup\ImportPRF")
end if
'=== outlook do not start it if...
if instr(usegrp, "cn=exception_outlook")=0 and cint(mid(now(),12,2))<9 then
if sysnam<>"stas-ts-02" and sysnam<>"dtid00019" and instr(usenam,"admin")=0 then
b = mid(sysdir,1,3)
for each i in arroff
for each y in arrwin
file01=b & "Program Files"& y &"\microsoft office\OFFICE"& i &"\outlook.exe"
if objfso.FileExists(file01) then
a = doprocess(file01,"")
end if
next
next
end if
end if
'====== adobe acrobat
'=== bug avec version 8 acrobat et version 7 plugin acrobat Pdfdacengine.dll
b = prodir & "\approveit\office\"
if objFSO.FOLDEREXISTS(b) then
filnam = "Pdfdacengine.dll"
sou = ser & "\users\_stas\util\" & filnam
des = b & filnam
a=copyfile(sou,des)
end if
'=== acrobat reference: Y:\Apps\ApproveIt Desktop 5.7.1\ADT56_acrobat_install_manuel
b = prodir & "\Adobe\Acrobat 8.0\Acrobat\plug_ins\"
if objFSO.FOLDEREXISTS(b) then
msgfin03 = msgfin03 & vbcrlf & "acrobat 8 existe" & vbcrlf
if objFSO.FOLDEREXISTS(prodir & "\approveit\") then
filnam = "ApproveItAcrobat.api"
sou = ser & "\users\_stas\util\" & filnam
des = b & filnam
'=== approve it désactivé dans acrobat 8
'a=copyfile(sou,des)
objFSO.deleteFile(des)
else
filnam = "ApproveItAcrobat.api"
des = b & filnam
if objFSO.fileEXISTS(des) then
objFSO.deleteFile(des)
end if
end if
end if
b = prodir & "\Adobe\Acrobat 7.0\Acrobat\plug_ins\"
if objFSO.FOLDEREXISTS(b) then
msgfin03 = msgfin03 & vbcrlf & "acrobat 7 existe" & vbcrlf
if objFSO.FOLDEREXISTS(prodir & "\approveit\") then
filnam = "ApproveItAcrobat.api"
sou = ser & "\users\_stas\util\" & filnam
des = b & filnam
a=copyfile(sou,des)
else
filnam = "ApproveItAcrobat.api"
des = b & filnam
objFSO.deleteFile(des)
end if
end if
'=== internet explorer for intranet
if instr(usegrp, "cn=exception_intranet")=0 and usenam <> "fournier.serge" then
a = doprocess(prodir & "\internet explorer\iexplore.exe","http://intranet.stas.biz/")
end if
'=== inventaire inventory
'=== start inventory script, but with lower than average cpu priority
'=== execute seulement si le log est présent et plus vieux X * 24 heures
'objFil01.WriteLine date & " " & time & " inventaire possible "
file01 = usetmp & "\zzz_log_inventaire.txt"
if objfso.FileExists(file01) then
Set demofile = objfso.GetFile(file01)
date01 = demofile.Datelastmodified
'=== if date difference is more than 3 days we do inventory
if datediff("h",date01,now)>7*24 then
a = doprocess(sysdir & "\cscript.exe",ser & "\users\audit_v0804_v4.vbs")
'objFil01.WriteLine date & " " & time & " inventory (renew): " & now
msgfin03 = msgfin03 & vbcrlf & "inventory (renew): " & now & " " & date01 & vbcrlf
end if
else
'=== if inventory file log does not exist we do it
a = doprocess(sysdir & "\cscript.exe",ser & "\users\audit_v0804_v4.vbs")
'objFil01.WriteLine date & " " & time & " inventory (first): " & now
msgfin03 = msgfin03 & vbcrlf & "inventory (first): " & now & vbcrlf
end if
'=== outlook time adjust
'=== tzmove.exe /quiet
'=== keep this for future patch we would need to do with a log file to know if its done
'file01 = usetmp & "\zzz_log_patchoutlook.txt"
'if objfso.FileExists(file01)=0 then
' a = doprocess(ser & "\users\tzmove.exe","/quiet")
' msgfin03 = msgfin03 & vbcrlf & "patch outlook tzmove.exe /quiet done" & vbcrlf
' Set objOutputFile = objfso.OpenTextFile(file01, 2, true)
' objOutputFile.WriteLine date & " " & time & " patch outlook ajust time done "
' objOutputFile.close
' set objOutputFile=nothing
'end if
end if
'=== final error message display
if usenam <>"system" then
on error resume next
'=== fin logon
a=script01 & " FIN ""Imprimantes`n" & totren & " / " & totold & "`n" & msgfin & """ 15 1+16"
if usenam=debugname then
'msgbox(a)
end if
objshe.Run a,, False
if err.number<>0 then
if usenam = debugname then
msgbox(msgfin)
end if
end if
'=== write error msgfin03 in event viewer
'Utilisez ces constantes pour désigner le type du journal des événements.
'const SUCCESS = 0
'const ERROR = 1
'const WARNING = 2
'const INFORMATION = 4
'const AUDIT_SUCCESS = 8
'const AUDIT_FAILURE = 16
dim WshShell
a=msgfin03 & vbcrlf & msgfin04 & vbcrlf & "fin du script login"
on error resume next
objshe.Logevent 4, a
'if err<>0 then
filnam = "c:\_stas\logs\_logon_log.txt"
Set File02 = objFso.OpenTextFile(filnam, 2, true)
file02.WriteLine date & " " & time & " LOG " & a
file02.close
file02=nothing
'end if
objshe.Run "%windir%\System32\RUNDLL32.EXE user32.dll,UpdatePerUserSystemParameters", 1, True
end if
else
'=== you are admin
objshe.Run script01 & " FIN ""YOU ARE ADMIN NO GADGETS IN SCRIPT`n" & totren & " / " & totold & "`n" & msgfin & """ 15 1+16",, False
end if
'=== reactivate security chek for zone
objEnv.Remove("SEE_MASK_NOZONECHECKS")
'objFil01.WriteLine date & " " & time & " fin logon "
'objFil01.close
sql = "UPDATE system SET log_end={ fn NOW() } WHERE net_mac_address = '" & net_mac_address & "'"
set tag = database.execute(sql)
database.close conn
wscript.quit
'-------------------------------------------------------------------------------
'================================= end all =============================
'====== copy a folder and 1 sub folder level (just 1)
function copyfold(sou2, des2)
on error resume next
Set objFolder = objFSO.GetFolder(sou2)'=== dir
if err.number<>0 then
'toterrcop = toterrcop + 1
msgfin03 = msgfin03 & "warning - copyfold - source does not exist: " & bb2 & vbcrlf & vbcrlf
end if
Set objFiles = objFolder.files '=== directory
'=== chek all file in folder
For Each objFile in objFiles
'=== get a file's name
strName = objFile.Name
aa2=sou2 & "\" & strname
bb2=des2 & "\" & strname
on error resume next
cc=copyfile(aa2,bb2)
'msgbox("destination not there") & vbcrlf & aa2 & vbcrlf & bb2
'toterrcop = toterrcop + 1
msgfin03 = msgfin03 & "warning - copyfold - destination does not exist: " & bb2 & vbcrlf & vbcrlf
'=== error trapping is in copyfile function - no need here
next
Set objFiles = nothing
Set objFolder = nothing
end function
'=== create folder if it does not exist
function makfol(folder01)
If objFSO.FOLDEREXISTS(folder01)=FALSE Then
on error resume next
aa=OBJfso.CreateFolder(folder01)
if err.number<>0 then
'toterrcop = toterrcop + 1
msgfin03 = msgfin03 & "error - cannot create folder: " & folder01 & vbcrlf
end if
end if
end function
'====== write a value in registry, trap error
function regwri(regkey, value, type01)
if type01<>"" then
on error resume next
objshe.RegWrite regkey,value,type01
else
objshe.RegWrite regkey,""
end if
if err.number<>0 then
'msgfin = msgfin & "`n" & regkey & "`n"
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - register base not written: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
if usenam = debugname then
'msgbox("cannot write key" & vbcrlf & regkey & vbcrlf & value)
end if
end if
end function
'====== delete a value in registry, trap error
function regdel(regkey)
on error resume next
objshe.Regdelete(regkey)
if err.number <>0 then
err.clear
objshe.Regdelete(regkey & "\")
if err.number <>0 then
'msgfin = msgfin & "`n" & regkey & "`n"
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - register base not deleted: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
end if
end if
end function
'====== function copy a file
function copyfile(sou,des)
aa = instrRev(sou,"\")
bb = right(sou,len(sou)-aa)
If objFSO.fileEXISTS(sou)=true then
If objFSO.fileEXISTS(des)=FALSE then
'=== destination file does not exist, so no danger, we copy
'msgfin03 = msgfin03 & "error - destination does not exist:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
tottrycopy = tottrycopy + 1
on error resume next
objFSO.copyFile sou, des, TRUE
if err.number <>0 then
toterrcop = toterrcop + 1
'msgbox("fichier pas copie " & vbcrlf & sou & vbcrlf & des & vbcrlf & err.description)
msgfin03 = msgfin03 & vbcrlf & "error - unable to copy on empty destination:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
else
'msgbox("fichier OK " & vbcrlf & sou & vbcrlf & des & vbcrlf & err.description)
end if
else
'=== destination exist, so we get that object to chek his date etc
Set objFile1 = objFSO.GetFile(sou)
Set objFile2 = objFSO.GetFile(des)
tottrycopy = tottrycopy + 1
if objfile2.Datelastmodified<objfile1.Datelastmodified then
on error resume next
objFSO.copyFile sou, des, TRUE
if err.number <>0 then
'=== err - not able to overwrite
toterrcop = toterrcop + 1
msgfin = msgfin & "`nerror copy: "& b &"`n"
msgfin03 = msgfin03 & vbcrlf & "error - file more recent not copied:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
end if
'msgfin = msgfin & "copie faite`n"
else
totnocopy = totnocopy + 1
'toterrcop = toterrcop + 1
'msgfin = msgfin & "nocopy " & b & "`n"
end if
end if
else
'=== source existe pas
toterrcop = toterrcop + 1
'msgfin = msgfin & "`nerror copy: "& sou
msgfin03 = msgfin03 & vbcrlf & "error - source does not exist:" & vbcrlf & "FROM: " & sou & vbcrlf & "TO..: " & des & vbcrlf & err.description & vbcrlf
if usenam = debugname then
'msgbox("source does not exist:" & vbcrlf & sou)
end if
end if
end function
'====== function install printer ==================
function installprinter(a,b)
If InStr(usegrp, lcase(A)) Then
Set objPrinter = objNet.EnumPrinterConnections
If objPrinter.Count = 0 Then
noprinters = 1 '=== we will set a default
end if
dejafaite = 0
For intDrive = 0 to objPrinter.Count -1 Step 2
intNetLetter = IntNetLetter +1
if lcase(b) = lcase(objPrinter.Item(intDrive +1)) then
dejafaite =1
totold= totold + 1
end if
'WScript.Echo "UNC Path " & objPrinter.Item(intDrive) & " = " & objPrinter.Item(intDrive +1) & " Printer : " & intDrive
next
'=== if efface = 1 then it will erase the printer and reinstall it
efface = 1
if (dejafaite=1 and efface=1) then
'msgbox("-" & lcase(b) & "-" & lcase(serveur & "SCAN4080_COUL") & "-" & " - " & dejafaite & " " & len(b) & " " & len(serveur & "SCAN4080_COUL"))
d=cstr(b)
d=lcase(d)
if d = lcase(serveur & "scan4080_coul") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
if d = lcase(serveur & "scan4080_noir") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
if d = lcase(serveur & "scan4080_pdf") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
if d = lcase(serveur & "scan4080_recto_Verso") then
objNet.RemovePrinterConnection b
dejafaite =0
totren=totren+1
end if
end if
if dejafaite = 0 then
'=== install printer
'err.clear
on error resume next
objNet.AddWindowsPrinterConnection b
if err.number<>0 then
c=err.description
if paspil=0 then
msgfin = msgfin & "`nImprimante non installées`nfaute de pilote`n"
end if
msgfin03 = msgfin03 & "error - printer not installed: " & b & vbcrlf & c
paspil = paspil + 1
end if
err.clear
end if
'if noprinters=1 then
'=== set default parce qu'il avait 0 printer
'objNet.SetDefaultPrinter b
'end if
end if
end function
'=============================
'====== SUB fonction pour extraire une variable d'environnement du dos
Function Environ(VarName)
Dim wss, env
Set wss = CreateObject("WScript.Shell")
Set env = wss.environment("process")
Environ = env(VarName)
If Environ = "" Then
Set env = wss.environment("system")
Environ = env(VarName)
End If
End Function
'======= register a certain extension to run with a certain program
function runwit(runwitprog, runwitext, runwitnam)
runwita="HKEY_CLASSES_ROOT\."& runwitext &"\"
runwitb=runwitnam
runwitc="REG_SZ"
runwitd=regwri(runwita,runwitb,runwitc)
runwita="HKEY_CLASSES_ROOT\"& runwitnam &"\"
runwitb=runwitnam
runwitc="REG_SZ"
runwitd=regwri(runwita,runwitb,runwitc)
runwita="HKEY_CLASSES_ROOT\"& runwitnam &"\shell\open\command\"
runwitb=runwitprog
runwitc="REG_SZ"
runwitd=regwri(runwita,runwitb,runwitc)
end function
'====== create a process
function doprocess(strcommand, param)
Const SW_NORMAL = 1
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
' Configure the Notepad process to show a window
Set objStartup = objWMIService.Get("Win32_ProcessStartup")
Set objConfig = objStartup.SpawnInstance_
' 1 - Window is shown minimized
' 3 - Window is shown maximized
' 5 - Window is shown in normal view
' 12 - Window is hidden and not displayed to the user
objConfig.ShowWindow = 1
a=right(strcommand,11)
if a="cscript.exe" or a="wscript.exe" then
objConfig.ShowWindow = 12
end if
IF A ="outlook.exe" then
strQuery = "Select * from Win32_Process Where Name = 'Outlook.exe'"
Set colProcesses = objWMIService.ExecQuery(strQuery)
For Each objProcess In colProcesses
If lCase(objProcess.Name) = "outlook.exe" Then
outrun=1
Else
Outrun=0
End If
Next
end if
'Const LOW = 64
'Const BELOW_NORMAL = 16384
'Const NORMAL = 32
'Const ABOVE_NORMAL = 32768
'Const HIGH = 128
objConfig.PriorityClass = 16384
'=== Create Notepad process
Set objProcess = objWMIService.Get("Win32_Process")
if param<>"" then
strcommand = strcommand & " " & param
end if
IF (A ="outlook.exe" and outrun=0) or a<>"outlook.exe" then
intReturn = objProcess.Create(strCommand, Null, objConfig, intProcessID)
end if
end function
'====== adjust a process priority
function adjprocess()
'Const LOW = 64
'Const BELOW_NORMAL = 16384
'Const NORMAL = 32
'Const ABOVE_NORMAL = 32768
'Const HIGH = 128
Const ABOVE_NORMAL = 32768
strComputer = "."
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")
Set colProcesses = objWMIService.ExecQuery("Select * from Win32_Process Where Name = 'nsrexecd.exe'")
For Each objProcess in colProcesses
objProcess.SetPriority(ABOVE_NORMAL)
Next
end function
'====== write a binary in register base
function regwribin(section,path01,key,value)
on error resume next
objReg.SetBinaryValue section, path01, key, value
if err.number<>0 then
toterrcop = toterrcop +1
msgfin03 = msgfin03 & vbcrlf & "error - reg write binary: " & vbcrlf & path01 & vbcrlf & key & vbcrlf
if usenam=debugname then
msgbox("erreur écriture dans reg base avec binary" & vbcrlf & err.description & vbcrlf & path01 & vbcrlf & key)
end if
end if
end function
'====== function string to array to write in register base as binary, a string
Function StringToArray(ByVal ss)
Dim ii, jj
ReDim aa(Len(ss) * 2 + 1)
ii = -1
For jj = 1 To Len(ss)
ii = ii + 1 : aa(ii) = Asc(Mid(ss, jj, 1))
ii = ii + 1 : aa(ii) = 0
Next
ii = ii + 1 : aa(ii) = 0
ii = ii + 1 : aa(ii) = 0
StringToArray = aa
End Function
'====== delete a registry key tree (all of it)
Function Regdeltre(sHive, sEnumPath)
'=== Attempt to delete key. If it fails, start the subkey enumeration process.
on error resume next
regsubtree=0
lRC = objReg.DeleteKey(sHive, sEnumPath)
'=== The deletion failed, start deleting subkeys.
If (lRC <> 0) Then
'=== Subkey Enumerator
On Error Resume Next
objReg.EnumKey sHive, sEnumPath, sNames
If (IsArray(sNames)) Then
For Each sKeyName In sNames
lRC = regdeltre(sHive, sEnumPath & "\" & sKeyName)
Next
regsubtre = 1
end if
'=== try delete the main registry key again
lRC = objReg.DeleteKey(sHive, sEnumPath)
if (lrc<>0) and regsubtre=0 then
'toterrcop = toterrcop +1
msgfin04 = msgfin04 & vbcrlf & "WARNING regdeltre - del registry tree does not exist: " & vbcrlf & hex(sHive) & "\" & sEnumPath & vbcrlf
if usenam=debugname then
'msgbox("erreur del reg tree" & vbcrlf & err.description & vbcrlf & hex(sHive) & vbcrlf & sEnumPath)
end if
elseif (lrc<>0) and regsubtre=1 then
toterrcop = toterrcop +1
msgfin03 = msgfin03 & vbcrlf & "ERROR regdeltre - del registry tree failed: " & vbcrlf & hex(sHive) & "\" & sEnumPath & vbcrlf
if usenam=debugname then
msgbox("ERROR regdeltre" & vbcrlf & err.description & vbcrlf & hex(sHive) & vbcrlf & sEnumPath)
end if
end if
End If
End Function
'=== lis le registre en mode 32 bits, si rien, lis en 64 bits
function regrea(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
if regrea_mode=0 then
r2egrea_mode=32
end if
regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
IF ISNULL(regrea) THEN
r2egrea_mode=64
regrea = regrea2(r2egrea_mode, r2egrea_clef01, r2egrea_clef02, r2egrea_clef03)
end if
end function
'=== lis le registre en mode regrea_mode
function regrea2(regrea_mode, regrea_clef01, regrea_clef02, regrea_clef03)
Set objCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
on error resume next
objCtx.Add "__ProviderArchitecture", regrea_mode
if err.number<>0 then
toterrcop = toterrcop +1
msgfin03 = msgfin03 & vbcrlf & "error - __ProviderArchitecture: " & vbcrlf
if usenam=debugname then
msgbox("erreur __ProviderArchitecture" & vbcrlf & err.description & vbcrlf & path01 & vbcrlf & key)
end if
end if
Set objLocator = CreateObject("Wbemscripting.SWbemLocator")
Set objServices = objLocator.ConnectServer("","root\default","","",,,,objCtx)
Set objStdRegProv = objServices.Get("StdRegProv")
Set Inparams = objStdRegProv.Methods_("GetStringValue").Inparameters
Inparams.Hdefkey = regrea_clef01
Inparams.Ssubkeyname = regrea_clef02
Inparams.Svaluename = regrea_clef03
set Outparams = objStdRegProv.ExecMethod_("GetStringValue", Inparams,,objCtx)
'=== show output parameters object and the registry value HKLM\SOFTWARE\
'WScript.Echo Outparams.GetObjectText_
'WScript.Echo "WMI Logging is set to " & Outparams.SValue
regrea2 = Outparams.SValue
end function
'=== fais un raccourci
function maksho(source, destination, icone, argument, hotkey)
'=== delete shortcut before recreating it
if objFSO.fileEXISTS(destination) then
objfso.deletefile(destination),true
end if
'and instr(source,"_01_désarchivage_x2t")=0
' If usenam<>"fortin.dominic" _
' and (usenam<>"mancheron.jimmy" _
' and instr(source,"sarchivage_x2t")=0) _
' Then
set oMyShortcut = objshe.CreateShortcut(destination)
'=== 3=Maximized 7=Minimized 4=Normal
oMyShortcut.WindowStyle = 4
oMyShortcut.IconLocation = icone
OMyShortcut.TargetPath = source
oMyShortCut.Hotkey = hotkey
oMyShortCut.Save
' end if
end function
'====== fin functions
vista logon script
part 3 of 4
---------- 03_vista.vbs -----------
some setup for vista
like disabling UAC (user access control)
i will change this one and add more setup in it, like activating network browsing
part 3 of 4
---------- 03_vista.vbs -----------
some setup for vista
like disabling UAC (user access control)
i will change this one and add more setup in it, like activating network browsing
Set objshe = WScript.CreateObject("WScript.Shell")
toterrcop=0
'=== disable UCA
a = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\System\EnableLUA"
d=regwri(a,0,"REG_DWORD")
a = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\System\ConsentPromptBehaviorAdmin"
d=regwri(a,2,"REG_DWORD")
a = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\System\ConsentPromptBehaviorUser"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Policies\System\EnableInstallerDetection"
d=regwri(a,1,"REG_DWORD")
'=== network discovery ON in domain
'Windows Registry Editor Version 5.00
'[HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD]
'"EnableLLTDIO"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\EnableLLTDIO"
d=regwri(a,1,"REG_DWORD")
'"AllowLLTDIOOnDomain"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\AllowLLTDIOOnDomain"
d=regwri(a,1,"REG_DWORD")
'"AllowLLTDIOOnPublicNet"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\AllowLLTDIOOnPublicNet"
d=regwri(a,1,"REG_DWORD")
'"ProhibitLLTDIOOnPrivateNet"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\ProhibitLLTDIOOnPrivateNet"
d=regwri(a,0,"REG_DWORD")
'"EnableRspndr"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\EnableRspndr"
d=regwri(a,1,"REG_DWORD")
'"AllowRspndrOnDomain"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\AllowRspndrOnDomain"
d=regwri(a,1,"REG_DWORD")
'"AllowRspndrOnPublicNet"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\AllowRspndrOnPublicNet"
d=regwri(a,1,"REG_DWORD")
'"ProhibitRspndrOnPrivateNet"=dword:00000001
a = "HKEY_LOCAL_MACHINE\SOFTWARE\Policies\Microsoft\Windows\LLTD\ProhibitRspndrOnPrivateNet"
d=regwri(a,0,"REG_DWORD")
'=== printers install access automated
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{C4394F32-97BE-4DAA-8F01-179CD4843923}User\Software\Policies\Microsoft\Windows NT\Printers\PointAndPrint\InForest"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{C4394F32-97BE-4DAA-8F01-179CD4843923}User\Software\Policies\Microsoft\Windows NT\Printers\PointAndPrint\NoWarningNoElevationOnInstall"
d=regwri(a,1,"REG_DWORD")
a = "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{C4394F32-97BE-4DAA-8F01-179CD4843923}User\Software\Policies\Microsoft\Windows NT\Printers\PointAndPrint\UpdatePromptSettings"
d=regwri(a,2,"REG_DWORD")
'[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Group Policy Objects\{C4394F32-97BE-4DAA-8F01-179CD4843923}User\Software\Policies\Microsoft\Windows NT\Printers\PointAndPrint]
'"Restricted"=dword:00000001
'"TrustedServers"=dword:00000000
'"ServerList"=""
'"InForest"=dword:00000001
'"NoWarningNoElevationOnInstall"=dword:00000001
'"UpdatePromptSettings"=dword:00000002
'====== write a value in registry, trap error
function regwri(regkey, value, type01)
if type01<>"" then
on error resume next
objshe.RegWrite regkey,value,type01
else
objshe.RegWrite regkey,""
end if
if err.number<>0 then
'msgfin = msgfin & "`n" & regkey & "`n"
toterrcop = toterrcop + 1
msgfin03 = msgfin03 & vbcrlf & "error - register base not written: " & vbcrlf & regkey & vbcrlf & err.description & vbcrlf
if usenam = debugname then
msgbox("cannot write key" & vbcrlf & regkey & vbcrlf & value)
end if
end if
end function
vista logon script
part 3 of 4
---------- _04_launch.vbs -----------
this script is used in part 1 to launch part 2, in a task/event way
for vista to execute it as elevated user
sometimes the task start later on some vista computers (slow, up to 5 min)
that is the last bug i have left (slow start)
CORRECTIONS:
_01_logon.vbs not 01_logon
_02_logon.vbs not 02_logon
_03_vista.vbs not 03_vista
also, my domain controller have some problem with DFS
so i have a IF that redirect the execution to the ip adress (in script 01 and 02) of one of my domain controller
you might not have this problem, i have it on 64 bits windows xp computers
part 3 of 4
---------- _04_launch.vbs -----------
this script is used in part 1 to launch part 2, in a task/event way
for vista to execute it as elevated user
sometimes the task start later on some vista computers (slow, up to 5 min)
that is the last bug i have left (slow start)
CORRECTIONS:
_01_logon.vbs not 01_logon
_02_logon.vbs not 02_logon
_03_vista.vbs not 03_vista
also, my domain controller have some problem with DFS
so i have a IF that redirect the execution to the ip adress (in script 01 and 02) of one of my domain controller
you might not have this problem, i have it on 64 bits windows xp computers
'---------------------------------------------------------
'=== This sample launches the application as interactive user.
On Error Resume Next
const TriggerTypeRegistration = 7 '=== registration trigger
const ActionTypeExecutable = 0 '=== executable action
const FlagTaskCreate = 2 '=== RegisterTaskDefinition
const LogonTypeInteractive = 3 '=== executable action
' If WScript.Arguments.Length <> 1 Then
'WScript.Echo "Usage: cscript launchapp.wsf <AppPath>"
' WScript.Quit
' End If
strAppPath = WScript.Arguments(0)
' strAppPath = "\\corp.stas.local\NETLOGON\users\_02_logon.vbs"
'=== Create the TaskService object.
Set service = CreateObject("Schedule.Service")
call service.Connect()
strTaskName = "Launch App As Interactive User"
'=== Get a folder to create a task definition in.
Dim rootFolder
Set rootFolder = service.GetFolder("\")
'=== Delete the task if already present
call rootFolder.DeleteTask(strTaskName, 0)
Err.Clear
'=== Create the new task
Dim taskDefinition
Set taskDefinition = service.NewTask(0)
'=== Create a registration trigger.
Dim triggers
Set triggers = taskDefinition.Triggers
Dim trigger
Set trigger = triggers.Create(TriggerTypeRegistration)
'=== Create the action for the task to execute.
'=== Add an action to the task. The action executes the app.
Dim Action
Set Action = taskDefinition.Actions.Create(ActionTypeExecutable)
Action.Path = strAppPath
'WScript.Echo "Task definition created. About to submit the task..."
'=== Register (create) the task.
'=== msgbox(" strTaskName: " & strTaskName & vbcrlf)
err.clear
call rootFolder.RegisterTaskDefinition(strTaskName, taskDefinition, FlagTaskCreate,,, LogonTypeInteractive)
if err<>0 then
end if
CORRECTION:
the second part 3 of 4 is actually part 4 of 4
the second part 3 of 4 is actually part 4 of 4
another problem my script have is vista seems to boot to fast to have the netbios or DFS ready to look for netbios or DFS names
i will have to loop in script to wait for vista to find a netbios/dfs name for the service on vista to start instead of using an ip adress
but if you change my ip adress for your domain controller it will be fine
BUT it is not the good way to do it, DFS way is better, since the script will not run if the dc with the ip adress is down
i will have to loop in script to wait for vista to find a netbios/dfs name for the service on vista to start instead of using an ip adress
but if you change my ip adress for your domain controller it will be fine
BUT it is not the good way to do it, DFS way is better, since the script will not run if the dc with the ip adress is down
ASKER
Thanks you are very helpful.
I am not in the office for the next two weeks so i will have a play once im back in
Thanks
I am not in the office for the next two weeks so i will have a play once im back in
Thanks
what policy did you use? the before user is logged as admin? or the after user log as user?