Liste/Catalogue automatique des jeux Wii- Forum

Const BIF_EDITBOX = &H10
Const BIF_NONEWFOLDER = &H0200
Const BIF_RETURNONLYFSDIRS = &H1
Const BIF_NEWDIALOGSTYLE = &H40
Const ForReading = 1
Const TristateFalse = 0
StrRelativeTempPath="MyUnrar"
StrTempPath=""

Set objShell = CreateObject("Shell.Application")
Set wshShell = CreateObject("WScript.Shell")
Set objFSO = CreateObject("Scripting.FileSystemObject")

'**Browse For Folder To Be Processed
strPrompt = "Please select the folder to process."
intOptions = BIF_NEWDIALOGSTYLE + BIF_RETURNONLYFSDIRS + BIF_NONEWFOLDER + BIF_EDITBOX
strTargetPath = wshShell.SpecialFolders("MyComputer")
'strTargetPath = "C:\Mes fichiers\IDM\Wii\_new"
strFolderPath = Browse4Folder(strPrompt, intOptions, strTargetPath)
if right(strTargetPath,1)="" then
StrTempPath=StrTargetPath & StrRelativeTempPath
else
strTempPath=strFolderPath & "" & StrRelativeTempPath
end if

Set objNewFile = objFSO.CreateTextFile(strFolderPath & "\Wiilist.csv", True)
Set objMyFolder = objFSO.GetFolder(strFolderPath)
Set objColFiles = objMyFolder.Files

objNewFile.WriteLine("File Name;Extension;File Size;Code")
For Each file In objColFiles
CurrentName=objFSO.getbasename(file.Name)
CurrentExtension=ucase(objFSO.getextensionname(file.Name))
If CurrentExtension = "ISO" Or CurrentExtension = "RAR" Then
ThisCode=CodeName(strFolderPath & "" & file.Name,CurrentExtension)
objNewFile.WriteLine(CurrentName & ";" & CurrentExtension & ";" & file.Size & ";" & ThisCode)
End If
Next
objNewFile.Close

wscript.quit

Function Browse4Folder(strPrompt, intOptions, strRoot)
Dim objFolder, objFolderItem

On Error Resume Next

Set objFolder = objShell.BrowseForFolder(0, strPrompt, intOptions, strRoot)
If (objFolder Is Nothing) Then
Wscript.Quit
End If
Set objFolderItem = objFolder.Self
Browse4Folder = objFolderItem.Path
Set objFolderItem = Nothing
Set objFolder = Nothing
End Function

Function CodeName(CurrentGame,FileType)

Select Case FileType
Case "ISO" :
CodeName=ReadCodeISO(CurrentGame)
Case "RAR" :
CodeName=ReadCodeRAR(CurrentGame)
End Select

End Function

Function KillMyUnrar

strComputer="."
Set objWMIService = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\" & strComputer & "\root\cimv2")
Set colProcessList = objWMIService.ExecQuery ("SELECT * FROM Win32_Process WHERE Name = 'MyUnrar.exe'")
For Each objProcess in colProcessList
objProcess.Terminate()
Next

End Function

Function ReadCodeISO(CurrentGame)

Dim objFS, objFile, objTS

Set objFS = wscript.CreateObject("Scripting.FileSystemObject")
Set objFile = objFS.GetFile(CurrentGame)
Set objTS = objFile.OpenAsTextStream(ForReading, TristateFalse)
ReadCodeISO = objTS.Read(6)

End Function

Function ReadCodeRAR(CurrentGame)

Dim objLastEvent
Set fso = CreateObject("Scripting.FileSystemObject")

If fso.FolderExists(strTempPath) Then
fso.DeleteFolder strTempPath,0
End If
Set f = fso.CreateFolder(strTempPath)
NewTempPath = f.Path
if ucase(NewTempPath)<>ucase(strTempPath) then
Wscript.echo("Error Temp Path :" & NewTempPath & "-" & strTempPath)
Wscript.quit
end if

set WshShell = CreateObject("WScript.Shell")'
IntReturn=WshShell.Run("MyUnrar.EXE e -ai -kb -sm4600000000 " & Chr(34) & CurrentGame & Chr(34) & " " & Chr(34) & strTempPath & Chr(34),0,False)

ISOFileFound=0
NewCurrentGame=""
do
wscript.sleep 300

Set objFolder = fso.GetFolder(strTempPath)
Set objFiles = objFolder.Files

For Each ISOFile in objFiles
NewCurrentGame=strTempPath & "" & ISOFile.Name
If UCase(Right(NewCurrentGame,4))=".ISO" Then
KillMyUnrar
ISOFileFound=1
Exit For
End If
Next
loop until ISOFileFound

MyCode=ReadCodeISO(NewCurrentGame)
If UCase(Left(MyCode,6))= LCase(Left(MyCode,6)) Then
wscript.echo "*" & MyCode & "*"
If fso.FolderExists(strTempPath) Then
fso.DeleteFolder strTempPath,0
wscript.echo "exist2" & strTempPath
End If
wscript.sleep 300
MyCode=ReadCodeRAR(CurrentGame)
End if
' wscript.echo "*" & MyCode & "*"
wscript.sleep 200
fso.DeleteFolder strTempPath,0
ReadCodeRAR=MyCode

End Function