1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111
| Option Explicit
Dim sFileName,Result1,Result2,I,objDialog,OpenFile,Tb(41),fso,f
tb(0) ="Nom"
tb(1) ="Taille"
tb(2) ="Type"
tb(3) ="Date de modification"
tb(4) ="Date de création"
tb(5) ="Date d'accès"
tb(6) ="Attributs"
tb(7) ="État"
tb(8) ="Propriétaire"
tb(9) ="Auteur"
tb(10)="Titre"
tb(11)="Objet"
tb(12)="Catégorie"
tb(13)="Pages"
tb(14)="Commentaires"
tb(15)="Copyright"
tb(16)="Artiste" '20
tb(17)="Titre de l'album"
tb(18)="Année"
tb(19)="Numéro de piste"
tb(20)="Genre"
tb(21)="Durée"
tb(22)="Débit"
tb(23)="Protégée"
tb(24)="Modèle d'appareil photo"
tb(25)="Date du cliché"
tb(26)="Dimensions"
tb(27)=""
tb(25)=""
tb(29)="Nom de l'épisode"
tb(30)="Description du programme"
tb(31)=""
tb(32)="Taille de l'échantillon audio"
tb(33)="Taux d'échantillonnage audio"
tb(34)="Chaînes"
tb(35)="Entreprise"
tb(36)="Description" 'Ligne 40
tb(37)="Version du fichier"
tb(38)="Nom du produit"
tb(39)="Version du produit"
tb(40)="Keywords"
Set objDialog=CreateObject("SAFRCFileDlg.FileOpen")
ObjDialog.OpenFileOpenDlg
OpenFile=objDialog.FileName
sFileName=objDialog.FileName
if sFileName="" then Wscript.Quit
Result1=Mid(sFileName,1,InstrRev(sFileName,"\"))
Result2=Right(sFileName,Len(sFileName)-InstrRev(sFileName,"\"))
EcrireInfos ' Ecriture des infos dans C:\Détails.txt
msgbox DetailsFichierVBS + VbNewLine + SrvcPack 'A mettre en commentaire si on veut pas de message
'==================================
Function DetailsFichierVBS()
dim objShell 'Ligne 59
dim objFolder
set objShell = CreateObject("shell.Application")
set objFolder = objShell.NameSpace(Result1)
if (not objFolder is nothing) then
dim objFolderItem
set objFolderItem = objFolder.ParseName(Result2)
if (not objFolderItem Is Nothing) then 'Ligne 70
dim objInfo
For i=0 to 41
If objFolder.GetDetailsOf(objFolderItem, I) <> "" then
objInfo = objInfo & FormaterTexte(tb(I)) & ": " & objFolder.GetDetailsOf(objFolderItem, I) & VbNewLine
End If
Next
end if
set objFolderItem = nothing
end if
DetailsFichierVBS=objInfo 'Ligne 80
set objFolder = nothing
set objShell = nothing
End function
'==============================
Function FormaterTexte(sText)
If len(stext)<=31 then
stext=stext & String(31-Len(stext)," ") & VbTab
End If
FormaterTexte=sText
End Function
'==============================
Sub EcrireInfos()
Const ForWriting=2
set fso=CreateObject("Scripting.FileSystemObject")
set f=fso.OpenTextFile("C:\Détails.txt",ForWriting,True)
F.Write (DetailsFichierVBS + VbNewLine + SrvcPack)
F.Close
End Sub
'===============================
Function SrvcPack()
Dim strComputer,objWMIService,Ret,colOperatingSystems,objOperatingSystem
strComputer = "."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\" _
& strComputer & "\root\cimv2")
Set colOperatingSystems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem")
For Each objOperatingSystem in colOperatingSystems
Ret=Ret & "Service Pack : " & objOperatingSystem.ServicePackMajorVersion _
& "." & objOperatingSystem.ServicePackMinorVersion
Next
SrvcPack=Ret
End Function |
Partager