[SOS] Debug Logon Script: type mismatch

Question

Bonjour à tous,

J'ai récupéré un vieux logon script que j'avais fait il y a 13 ans , mais depuis j'ai totalement arrêté vsbcript pour powershell sans être devenu un expert non plus en powershell.
Vu qu'il me prendrait trop de temps de réécrire ce script en powershell, j'ai décidé de le reprendre et d'y ajouter une seule fonction dont j'ai besoin.
Seulement je rencontre un problème à l’exécution de mon script et je sollicite votre aide pour corriger ce problème.

Voici l'erreur 




Et voici le script:

'On Error Resume Next

' Script d'ouverture de session 
'

' D�claration des variables g�n�rales

Dim strComputer,OsInfo,IpInfoLocal,sProfil,userSid,LogDir,NetPath,LocalFile,OutFile,ProfilDir
Dim Current,ComputerName,sUsername,sDom,sDC,Hw,Cpu,Model,Marq,Tag,Mem
Dim objFSO,objTextFile,Env,IpForti

' constantes

Const ForWriting = 2
Const OverwriteExisting = True
Const ForAppend = 8

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' COLLECTE DES PARAMETRES GENERAUX
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
strComputer = "."

' date et heure
Current = TimeHHMMSS()

' Initialisation des variables d'enrionnement

Env = SetENV()

LogDir = Env(0)
ComputerName = Env(1)
sUsername = Env(2)
sDC = Env(3)
sDom = Env(4)
ProfilDir = Env(5)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' COLLECTE DES INFOS SYSTEMES / RESEAU / MACHINE / UTILISATEURS / SESSION-PROFIL
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

'User Sid
userSid = getSid()

'User DN
strDN = getDN()

' Password Last Set
strPasswdLastSet = pwdLastSet()

' Hardware Marque Model S/N
Hw = HWinfo()

Cpu = Hw(0)
Marq = Hw(1)
Model = Hw(2)
Tag = Hw(3)
Mem = Hw(4)

'Os info 
OSinfo = OSType ()

'configuration  IP du poste
IpInfoLocal = IPConfig()
IpForti = FortiIP()

' Profil Status
sProfil = ProfilState()

'Fichier de Log Local et R�seau

NetPath = "\my-srv\login$\"

' Si connexion VPN nommer le fichier avec l'IP de l'interface VPN SSL
If IsNull(IpForti) Then
OutFile = NetPath & ComputerName & "__" & sUsername & "__" & IpInfoLocal & "__" & Current & "_.log"
Else
WScript.Echo "IP Address: "  &  cstr(IpForti)
OutFile = NetPath & ComputerName & "__" & sUsername & "__" &   cstr(IpForti)  & "__" & Current & "_.log"
end If

Set WshShell = CreateObject("WScript.Shell")

UserPath = WshShell.ExpandEnvironmentStrings("%userprofile%") & "\session_log"
Set objFSO = CreateObject("scripting.filesystemobject")

If objFSO.FolderExists(UserPath) = False Then
         objFSO.CreateFolder(UserPath)
End If

LocalFile = LogDir & "\" & Current & "_.log"

Set objTextFile = objFSO.CreateTextFile(LocalFile, True)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' ECRITURE DES RESULTATS DE REQUETTE DANS LE FICHIER DE LOG
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

objTextFile.WriteLine Vbtab & "######################## INFOS ORDINATEUR ########################"
objTextFile.WriteBlankLines (2)
objTextFile.WriteLine "Computer      " & Vbtab & ": " & ComputerName
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Constructeur     " & Vbtab & ": " & Marq
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Model      " & Vbtab & ": " & Model
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "S/N       " & Vbtab & ": " & Tag
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "CPU       " & Vbtab & ": " & Cpu
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Physical Memory    " & Vbtab & ": " & Mem & " MB "
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "OS       " & Vbtab & ": " & OSinfo
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Adresse IP Locale   " & Vbtab & ": " & IpInfoLocal
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Adresse IP Forticlient  " & Vbtab & ": " & " A venir "
objTextFile.WriteBlankLines (2)
objTextFile.WriteLine Vbtab & "######################## INFOS UTILISATEUR ########################"
objTextFile.WriteBlankLines (2)
objTextFile.WriteLine "Domaine      " & Vbtab & ": " & sDom
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Logon Server     " & Vbtab & ": " & sDC
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Username      " & Vbtab & ": " & sUsername
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Status du profil    " & Vbtab & ": " & sProfil
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Chemin du profil    " & Vbtab & ": " & ProfilDir
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "SID du compte    " & Vbtab & ": " & userSid
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "DN du compte utilisateur  " & Vbtab & ": " & strDN
objTextFile.WriteBlankLines (1)
objTextFile.WriteLine "Password Last Set   " & Vbtab & ": " & strPasswdLastSet

If Not (IsServer () = True) Then 
 objTextFile.WriteBlankLines (2)
 objTextFile.WriteLine "RSOP Information : " 
 getRSOP()
 objTextFile.WriteBlankLines (1)
End If

'/******************* REMONTE LES HOTFIX INSTALLES SUR LE POSTE **************************/
'objTextFile.WriteBlankLines (2)
'objTextFile.WriteLine "Hot Fix installed : "
'objTextFile.WriteLine "=============================="
'objTextFile.WriteBlankLines (1)

'Call GetHotFix()

objTextFile.Close

'Copie du fichier sur le share avec indication du nom d'ordinateur du login utilisateur et horodatage dans le nom du fichier
objFSO.CopyFile LocalFile , Outfile , OverwriteExisting

' Vide le contenu du session_log ant�rieur � 60 jours

Call cleanLog(LogDir,NetPath)

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''' BLOCS DE FONCTIONS '''''''''''''''''''''''''''''''''''''''''''''''''''
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

' Fonction heure

Function TimeHHMMSS()

Dim retv, d
    d = Now
    retv = Right("00" & Hour(d), 2) & "-" & Right("00" & Minute(d), 2) & "-" & Right("00" & Second(d), 2)
    TimeHHMMSS = Day(d) & "-" & Month(d) & "-" & Year(d) & "_" & retv
    
End Function

' Fonction RegValueExists

Function RegValueExists(sRegValue)
     ' Returns True or False based of the existence of a registry value.
     Dim objShell
     Dim  RegReadReturn 
     Set objShell = CreateObject("WScript.shell")
     RegValueExists = True  ' init value
     On Error Resume Next
     RegReadReturn = objShell.RegRead(sRegValue)
     If Err.Number <> 0 Then
       RegValueExists = False
     End if
     On Error Goto 0
     
     Set objShell = Nothing
     
End Function

' Function IPConfig

Function IPConfig () 
Dim  objWMIService,IPItems
Set objWMIService = GetObject("winmgmts:\.oot\CIMV2")
Set IPItems = objWMIService.ExecQuery("Select IPAddress from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")

For Each IPConfig In IPItems
   If Not IsNull(IPConfig.IPAddress) Then
    For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
     If varIP="" Then
      varIP=IPConfig.IPAddress(0)
     End If
    Next
   End If
  Next
  
IPConfig = varIP

End Function

' Function IP Forticlient

Function FortiIP()
strComputer = "."
Set objWMIService = GetObject("winmgmts:\" & strComputer & "oot\CIMV2")

Set colItems = objWMIService.ExecQuery("Select * from Win32_NetworkAdapterConfiguration")

For Each objItem in colItems

If  objItem.Description = "Fortinet SSL VPN Virtual Ethernet Adapter"  Or  objItem.Description = "Fortinet Virtual Ethernet Adapter (NDIS 6.30)" Then
 If Not IsNull(objItem.IPAddress(0)) then
  FortiIP = objItem.IPAddress(0)
 End if
End if

' Fonction getSID

Function getSid()

Dim sUsername,sDomain,oWMI,objAccount

Set WshShell = CreateObject("WScript.Shell")
sUsername = wshShell.ExpandEnvironmentStrings("%USERNAME%")
sDomain = wshShell.ExpandEnvironmentStrings("%USERDOMAIN%")

Set oWMI = GetObject("winmgmts:\.oot\cimv2")

Set objAccount = oWMI.Get("Win32_UserAccount.Name='" & sUsername & "',Domain='" & sDomain & "'")

getSID = objAccount.SID

Set oWMI = Nothing
Set WshShell = Nothing

End Function

'Fonction GetDN()  // DistinguishedName

Function getDN()

Set oTranslate = CreateObject("NameTranslate")
Set oNetwork = CreateObject("WScript.Network")
oTranslate.Init 3,""
oTranslate.Set 3, oNetwork.UserDomain & "\" & oNetwork.UserName
getDN = oTranslate.Get(1)

Set oTranslate = Nothing
Set oNetwork = Nothing

End Function

Function pwdLastSet()
Set objUser = GetObject _
    ("LDAP://" & strDN)

pwdLastSet = objUser.PasswordLastChanged

End Function

' Fonction OSType

Function OSType ()

Dim  Reg_OS_1, Reg_OS_2, Reg_OS_3,Reg_OS_4, Reg_Bool
Dim  WshShell

Reg_OS_1 = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\" & "ProductName"
Reg_OS_2 = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\" & "CSDVersion"
Reg_OS_3 = "HKLM\Software\Microsoft\Windows NT\CurrentVersion\" & "CurrentVersion"
Reg_OS_4 = "HKLM\SOFTWARE\Wow6432Node\"
Reg_OS_5 = "No Service Pack"

Set WshShell = CreateObject("WScript.shell")

If RegValueExists(Reg_OS_2) then

If RegValueExists(Reg_OS_4) then
 
 Reg_Bool = "x64"
 OsType = WshShell.RegRead (Reg_OS_1) & "  " & WshShell.RegRead (Reg_OS_2) & "  " & WshShell.RegRead (Reg_OS_3) & "  " & Reg_Bool
 
 Else
 
 Reg_Bool = "x86"
 OsType = WshShell.RegRead (Reg_OS_1) & "  " & WshShell.RegRead (Reg_OS_2) & "  " & WshShell.RegRead (Reg_OS_3) & "  " & Reg_Bool
 
 End If

Else

If RegValueExists(Reg_OS_4) then
 
 Reg_Bool = "x64"
 OsType = WshShell.RegRead (Reg_OS_1) & "  " & Reg_OS_5 & "  " & WshShell.RegRead (Reg_OS_3) & "  " & Reg_Bool
 
 Else
 
 Reg_Bool = "x86"
 OsType = WshShell.RegRead (Reg_OS_1) & "  " & Reg_OS_5 & "  " & WshShell.RegRead (Reg_OS_3) & "  " & Reg_Bool
 
 End If

End if

Set WshShell = Nothing

End Function

' Fonction profil status

Function ProfilState()

Dim WshShell
Dim KeyProfileStatus,Etat

Set WshShell = CreateObject("WScript.shell")

KeyProfileStatus = WshShell.RegRead("HKLM\Software\Microsoft\Windows NT\CurrentVersion\ProfileList\" & userSid & "\State")

Select case KeyProfileStatus
   Case 0
    Etat = "Normal"
   Case 16
    Etat = "Itin�rant"
   Case 20 
    Etat = "Itin�rant" & Vbtab & "1er ouverture de Session - Profil local supprim�"
   Case 24 
    Etat = "Itin�rant" & Vbtab & "Profil serveur supprim�"
   Case 262149 
    Etat = "Mandatory" & Vbtab & "1er ouverture de Session"
   Case 393217 
    Etat = "Mandatory"
   Case 516 
    Etat = "Normal" & Vbtab & "1er ouverture de Session" 
   Case 540 
    Etat = "Itin�rant" & Vbtab & "1er ouverture de Session"     
   Case 2564 
    Etat = "Temporaire"    
   Case Else 
    Etat ="Inconnu"
        
  End Select
  
  ProfilState =  Etat

Set WshShell = Nothing 
       
End Function

' Function IsServer

Function IsServer()

Dim ColSys,OSVersion
Dim result

Set oReg = GetObject("winmgmts:{impersonationLevel=impersonate}!\.oot\default:StdRegProv")

Set objWMIService = GetObject("winmgmts:\" & strcomputer & "oot\CIMV2") 
Set ColSys = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")

For Each OS In ColSys

OSVersion = Left(OS.Version,3)
 
   If InStr(OS.Caption, "Server") Or InStr(OS.Caption, "Serveur") Then
    
    result = True
 
   Else
    
    result = False
    
   End If
   
Next

IsServer = result

End Function

' Proc�dure getRSOP

Sub getRSOP()

Dim oReg,strKeyPath
Const HKEY_LOCAL_MACHINE = &H80000002

Set oReg=GetObject("winmgmts:{impersonationLevel=impersonate}!\" & _ 
    strComputer & "oot\default:StdRegProv")
 
strKeyPath = "SOFTWARE\Microsoft\Windows\CurrentVersion\Group Policy\State\" & userSid & "\GPO-List"
oReg.EnumKey HKEY_LOCAL_MACHINE, strKeyPath, arrSubKeys
 
For Each subkey In arrSubKeys
    
    strData = WshShell.RegRead("HKLM" & "\" & strKeyPath & "\" & subkey & "\DisplayName")
    objTextFile.WriteLine "GPO " & subkey & " :"  & strData
    
Next

Set oReg = Nothing

End Sub

'Proc�dure GetHotFix

Sub GetHotFix ()

strComputer = "."

Set objWMIService = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\" & strComputer & "oot\cimv2")
Set colQuickFixes = objWMIService.ExecQuery _
    ("Select * from Win32_QuickFixEngineering")
For Each objQuickFix in colQuickFixes
    objTextFile.WriteLine "KB ID: " & objQuickFix.HotFixID
Next

Set objWMIService = Nothing
Set colQuickFixes = Nothing

Set objSession = CreateObject("Microsoft.Update.Session")
Set objSearcher = objSession.CreateUpdateSearcher
intHistoryCount = objSearcher.GetTotalHistoryCount

'// Get WU history data:
Set colHistory = objSearcher.QueryHistory(1, intHistoryCount)

'// Loop through and print to screen:
For Each objEntry in colHistory
    objTextFile.WriteLine objEntry.Title
    objTextFile.WriteLine "Installed On: " & objEntry.Date
 objTextFile.WriteBlankLines (2)
Next

End sub

' Function HWinfo

Function HWinfo ()

Dim WshShell,oWMI,colParams,colTag,colMem
Dim sCPU,Reg_CPU,sMarq,sModel,sTag,sMem

Reg_CPU = "HKLM\Hardware\Description\System\CentralProcessor\0\" & "ProcessorNameString"
 
Set WshShell = CreateObject("WScript.Shell")
sCPU = WshShell.RegRead (Reg_CPU)

Set oWMI = GetObject("winmgmts:" _
    & "{impersonationLevel=impersonate}!\.oot\cimv2")

Set colParams = oWMI.ExecQuery _
    ("Select * from Win32_ComputerSystem")
For Each objParam in colParams 
 sModel = objParam.Model
    sMarq = objParam.Manufacturer
    sMem = objParam.TotalPhysicalMemory/(1024*1024)
Next

Set colTag = oWMI.ExecQuery( _
    "SELECT * FROM Win32_ComputerSystemProduct") 
For Each objTag in colTag 
    sTag = objTag.IdentifyingNumber
Next

Set oWMI = Nothing
Set WshShell = Nothing

HWinfo = Array (sCPU,sMarq,sModel,sTag,sMem)

End Function

'Function setEnv()

Function SetENV ()

Dim WshShell
Dim UserPath,strUsername,sDomain,sComputer,sServer

Set WshShell = CreateObject("WScript.Shell")
Profil = WshShell.ExpandEnvironmentStrings("%userprofile%")
UserPath = WshShell.ExpandEnvironmentStrings("%userprofile%") & "\session_log"
sComputer = WshShell.ExpandEnvironmentStrings("%computername%")
strUsername = WshShell.ExpandEnvironmentStrings("%username%")
sServer = WshShell.ExpandEnvironmentStrings("%logonserver%")
sDomain = WshShell.ExpandEnvironmentStrings("%USERDNSDOMAIN%")

Set WshShell = Nothing

SetENV = Array (UserPath,sComputer,strUsername,sServer,sDomain,Profil)
 
End Function

'Proc�dure vidage dossier de log

Sub cleanLog(LocalPath,NetworkPath)

Dim FSO,objLocalFolder,objFile,objSubfolder,objNetFolder
Dim DayToKeep

Set FSO = CreateObject("scripting.filesystemobject")

DayToKeep = 60 
Set objLocalFolder = FSO.GetFolder(LocalPath)

For Each objFile In objLocalFolder.files
    If DateDiff("d", objFile.DateCreated,Now) > DayToKeep Then
        objFile.Delete True
    End If
Next

For Each objSubfolder In objLocalFolder.Subfolders
    If DateDiff("d", objSubfolder.DateCreated,Now) > DayToKeep Then
            objSubfolder.Delete True     
    End If
Next

Set objNetFolder = FSO.GetFolder(NetworkPath)

For Each objFile In objNetFolder.files
    If DateDiff("d", objFile.DateCreated,Now) > DayToKeep Then
        objFile.Delete True
    End If
Next

For Each objSubfolder In objNetFolder.Subfolders
    If DateDiff("d", objSubfolder.DateCreated,Now) > DayToKeep Then
            objSubfolder.Delete True     
    End If
Next

End sub


Merci de votre aide

vb95 · Answer

Bonjour 
Quelques conseils
1) Utilisez les balises de code : https://codes-sources.commentcamarche.net/faq/11288-les-balises-de-code
2) Typer vos variables pour vous y retrouver : https://web.maths.unsw.edu.au/~lafaye/CCM/vbscript/vbstype.htm .
Toutes vos variables sont du type par défaut Variant .

[SOS] Debug Logon Script: type mismatch

1 réponse

Votre réponse

Discussions similaires