 Loading |
|
Loading |
| VBScript |
| JavaScript |
| Powershell |
Search Options: 2008 Scripting Games Advanced VBScript Event 8
|
||
|
' This is my Solution for the Scripting Games 2008
' For more Information look at ' http://www.microsoft.com/technet/scriptcenter/funzone/games/games08.mspx Option Explicit Dim ofso : Set ofso = Createobject("Scripting.FileSystemObject") Const ForReading = 1 Const ForWriting = 2 Const ForAppending = 8 Call Main() ' --------------------------------------- Sub Main() Dim dMax Dim dMin dMin = DateAdd("n", 0, "01:15:00") dMax = DateAdd("n", 0, "01:20:00") Dim arrSongsFile, arrTmpSongs, iCount, iCount2 Dim arrSongs() Dim arrSongsCD() Dim iSongsCD : iSongsCD = -1 Dim dSec Dim iRet Dim dTmpMinutes Dim dMinutes arrSongsFile = ReadFileToArray("C:\Scripts\songlist.csv") If IsArray(arrSongsFile) then ReDim arrSongs(UBound(arrSongsFile), 2) For iCount = 0 to UBound(arrSongsFile) If IsArray(arrTmpSongs) then Erase arrTmpSongs arrTmpSongs = Split(arrSongsFile(iCount), ",", -1, 1) For iCount2 = 0 to UBound(arrTmpSongs) arrSongs(iCount,iCount2) = arrTmpSongs(iCount2) Next Next End if Call SortArrayDim(arrSongs, "ASC", 2) ReDim Preserve arrSongsCD(2,0) Do while dMinutes < dMin For iCount = 0 To Ubound(arrSongs) if CheckTrible(arrSongsCD, arrSongs(iCount,0)) = false then iSongsCD = iSongsCD +1 ReDim Preserve arrSongsCD(2,iSongsCD) dTmpMinutes = DateAdd("n", 0, "00:0" & arrSongs(iCount,2)) dMinutes = dMinutes + dTmpMinutes arrSongsCD(0,iSongsCD) = arrSongs(iCount,0) arrSongsCD(1,iSongsCD) = arrSongs(iCount,1) arrSongsCD(2,iSongsCD) = arrSongs(iCount,2) End if If dMinutes > dMin then exit for End if Next loop Call SortArrayDim2(arrSongsCD, "ASC", 0) For iCount = 0 to Ubound(arrSongsCD,2) iRet = iRet & arrSongsCD(0, iCount) & String(7," ") & _ arrSongsCD(1, iCount) & String(7," ") & arrSongsCD(2, iCount) & vbcrlf Next dSec = Second(dMinutes) if Len(dSec) = 1 then dSec = "0" & Second(dMinutes) iRet = iRet & vbcrlf & "Total music time: " & _ Hour(dMinutes)*60+Minute(dMinutes) & ":" & dSec wscript.echo iRet End Sub ' --------------------------------------- Private Function CheckTrible(arrSource, strSearch) Dim iCount Dim xCount : xCount = 0 For iCount = 0 to Ubound(arrSource,2) If arrSource(0, iCount) = strSearch then xCount = xCount +1 End if Next If xCount >= 2 then CheckTrible = true Else CheckTrible = false End if End Function ' --------------------------------------- Private Function ReadFileToArray(strFile) Dim strNextLine, arrstrList Dim arrLines() Dim iCount : iCount = 0 If ofso.FileExists(strFile) then Dim oFile : Set oFile = ofso.OpenTextFile(strFile, ForReading) Do Until oFile.AtEndOfStream Redim Preserve arrLines(iCount) arrLines(iCount) = oFile.ReadLine iCount = iCount + 1 Loop oFile.Close End if Set oFile = nothing If IsArray(arrLines) then ReadFileToArray = arrLines End Function '--------------------------- Private Function SortArrayDim(SourceArray, strSortTyp, iDimension) Dim Sorted, iCount, Temp, Temp2, Temp3 Sorted = False Do While Not Sorted Sorted = True For iCount = 0 To UBound(SourceArray) - 1 Select Case UCase(strSortTyp) Case "ASC" If UCase(SourceArray(iCount, iDimension)) > _ UCase(SourceArray(iCount + 1, iDimension)) Then Temp = SourceArray(iCount + 1, 0) Temp2 = SourceArray(iCount + 1, 1) Temp3 = SourceArray(iCount + 1, 2) SourceArray(iCount + 1, 0) = SourceArray(iCount, 0) SourceArray(iCount + 1, 1) = SourceArray(iCount, 1) SourceArray(iCount + 1, 2) = SourceArray(iCount, 2) SourceArray(iCount, 0) = Temp SourceArray(iCount, 1) = Temp2 SourceArray(iCount, 2) = Temp3 Sorted = False End If Case "DESC" If UCase(SourceArray(iCount, iDimension)) < _ UCase(SourceArray(iCount + 1, iDimension)) Then Temp = SourceArray(iCount + 1, 0) Temp2 = SourceArray(iCount + 1, 1) Temp3 = SourceArray(iCount + 1, 2) SourceArray(iCount + 1, 0) = SourceArray(iCount, 0) SourceArray(iCount + 1, 1) = SourceArray(iCount, 1) SourceArray(iCount + 1, 2) = SourceArray(iCount, 2) SourceArray(iCount, 0) = Temp SourceArray(iCount, 1) = Temp2 SourceArray(iCount, 2) = Temp3 Sorted = False End If End Select Next Loop End Function '--------------------------- Private Function SortArrayDim2(SourceArray, strSortTyp, iDimension) Dim Sorted, iCount, Temp, Temp2, Temp3 Sorted = False Do While Not Sorted Sorted = True For iCount = 0 To UBound(SourceArray, 2) - 1 Select Case UCase(strSortTyp) Case "ASC" If UCase(SourceArray(iDimension, iCount)) > _ UCase(SourceArray(iDimension, iCount +1)) Then Temp = SourceArray(0, iCount + 1) Temp2 = SourceArray(1, iCount + 1) Temp3 = SourceArray(2, iCount + 1) SourceArray(0, iCount + 1) = SourceArray(0, iCount) SourceArray(1, iCount + 1) = SourceArray(1, iCount) SourceArray(2, iCount + 1) = SourceArray(2, iCount) SourceArray(0, iCount) = Temp SourceArray(1, iCount) = Temp2 SourceArray(2, iCount) = Temp3 Sorted = False End If Case "DESC" If UCase(SourceArray(iDimension, iCount)) < _ UCase(SourceArray(iDimension, iCount +1)) Then Temp = SourceArray(0, iCount + 1) Temp2 = SourceArray(1, iCount + 1) Temp3 = SourceArray(2, iCount + 1) SourceArray(0, iCount + 1) = SourceArray(0, iCount) SourceArray(1, iCount + 1) = SourceArray(1, iCount) SourceArray(2, iCount + 1) = SourceArray(2, iCount) SourceArray(0, iCount) = Temp SourceArray(1, iCount) = Temp2 SourceArray(2, iCount) = Temp3 Sorted = False End If End Select Next Loop End Function | ||
© 2008 - 2013 Boris Toll :: Scripts available: 6.481 :: :: scriptbox.toll.at :: :: powered by www.toll.at :: | ||
