Solved

Problems with login script

Posted on 2008-06-15
30
5,248 Views
Last Modified: 2012-06-21
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
0
Comment
Question by:donhodge
  • 16
  • 10
  • 3
  • +1
30 Comments
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21790569
is your script in the right directory "netlogon" on your dc?

what policy did you use? the before user is logged as admin? or the after user log as user?


0
 
LVL 5

Expert Comment

by:GrimReeper
ID: 21790589
Have you tested that the scripts work before using them in a GPO?
0
 

Author Comment

by:donhodge
ID: 21790604
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
0
 
LVL 77

Expert Comment

by:Rob Williams
ID: 21790643
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
0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21790686
on our server the policy is based on the computer, not the user

mainly because all user need the logon script

0
 

Author Comment

by:donhodge
ID: 21790712
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
0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21790725
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)


'=== 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 functions

Open in new window

0
 

Author Comment

by:donhodge
ID: 21798538
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
0
 

Author Comment

by:donhodge
ID: 21798813
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
0
 
LVL 77

Expert Comment

by:Rob Williams
ID: 21798919
-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
0
 

Author Comment

by:donhodge
ID: 21800302
I will run net diag, file and print sharing is set through GPO and client for microsoft networks is enabled.

Thanks
0
 

Author Comment

by:donhodge
ID: 21808754
Hey can any one paste me a simple VB script for connecting printers and net drives.

You guys are life savers

Thanks
0
 
LVL 77

Expert Comment

by:Rob Williams
ID: 21809039
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\YourDomainName\scripts
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\YourDomainName\Scripts

::  If at some point you wish to delete all printers enable the following line by removing the Rem
Rem  \\SrvrName\Netlogon\con2prt.exe  /f

::  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\con2prt.exe  /cd  \\WkstName\Printer1

::  Install other printers -You can add as many as you like
\\SrvrName\Netlogon\con2prt.exe  /c  \\WkstName\Printer2
\\SrvrName\Netlogon\con2prt.exe  /c  \\WkstName\Printer3

-------------------------------------------------------------------------------------
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
0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21810098
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




'------------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

Open in new window

0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21810156
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 ;)

'------------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

Open in new window

0
Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

 

Author Comment

by:donhodge
ID: 21853482
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
0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21856719
multiple printer servers:
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 done

Open in new window

0
 
LVL 11

Accepted Solution

by:
Serge Fournier earned 500 total points
ID: 21856783
and here is the code to disconnect a drive:

objNet.RemoveNetworkDrive "j:", True, True

in my main script i enumerate all network drives in a loop
you can use the loop and put the disconnect in the loop

this is the drive letter:
oDrives.Item(i)
this is the network path:
oDrives.Item(i+1)

i dont remember if the drive letter have ":" in it
so you can put a:
msgbox(oDrives.Item(i))
to find out with an onscreen box



   Set oDrives = objnet.EnumNetworkDrives

   alldri = ""

   allsha = ""

   'objFil01.WriteLine date & " " & time & " drives get old letters "

   For i = 0 to oDrives.Count - 1 Step 2

'=== add disconnect command here

     

'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

Open in new window

0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21912784
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 ;)
0
 

Author Closing Comment

by:donhodge
ID: 31467452
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.
0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21941795
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
0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21941800
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
0
 

Author Comment

by:donhodge
ID: 21942199
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
0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21950406
vista logon script

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 

Open in new window

0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21950414
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)

'=== 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

Open in new window

0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21950421
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

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

Open in new window

0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21950443
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



   '---------------------------------------------------------

   '=== 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

Open in new window

0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21950454
CORRECTION:

the second part 3 of 4 is actually part 4 of 4

0
 
LVL 11

Expert Comment

by:Serge Fournier
ID: 21950479
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
0
 

Author Comment

by:donhodge
ID: 21962350
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
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

When it comes to writing scripts for a Client/Server computing environment it is essential to consider some way of enabling the authentication functionality within a script. This sort of consideration mainly comes into the picture when we are dealin…
This article is the result of a quest to better understand Task Scheduler 2.0 and all the newer objects available in vbscript in this version over  the limited options we had scripting in Task Scheduler 1.0.  As I started my journey of knowledge I f…
Learn how to match and substitute tagged data using PHP regular expressions. Demonstrated on Windows 7, but also applies to other operating systems. Demonstrated technique applies to PHP (all versions) and Firefox, but very similar techniques will w…
This tutorial will teach you the core code needed to finalize the addition of a watermark to your image. The viewer will use a small PHP class to learn and create a watermark.

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now