Help!! Problem running vbs in Win XP

Help!! Problem running vbs in Win XP - 7/21/2003 7:12:52 AM
	rvbonzai   Posts: 1 Score: 0 Joined: 7/21/2003 From: Canada Status: offline	I am having problems running this script in Win XP. The computer runs out of virtual memory & then freezes. My hard drive is formated NTFS does it need to be FAT32 ? Also I have Office XP installed. Here is the code: dim playerstr(1500) dim NID(1500) dim playcount dim curPath dim EOLMarker EOLMarker = chr(10) function currentPath() Dim FileName FileName = WScript.ScriptFullName Do While Right (FileName, 1) <> "\" FileName = Left (FileName, Len(FileName) - 1) Loop currentPath = FileName end function function getPage(pageURL) Dim objXMLHTTP, xml Set xml = CreateObject("MSXML2.ServerXMLHTTP") xml.Open "GET", pageURL, false xml.Send getPage = xml.ResponseText Set xml = Nothing end function function parseString(InString) Dim EOLChar EOLChar = instr(InString, EOLMarker) parseString = mid (InString, 1, EOLChar) InString = mid (InString, EOLChar + 1) end function sub RemoveTags(InString) Do While InStr(InString, "<") InString = Left(InString, Instr(InString, "<") - 1) & Mid(InString, Instr(InString, ">") + 1) Loop Do While InStr(InString, "&") InString = Left(InString, Instr(InString, "&") - 1) & Mid(InString, Instr(InString, ";") + 1) Loop end sub sub readPlayers(TEAM, PlayerStart) Dim TeamPage, strTemp, DoIt, PlayerLine, StartMark, PName, PPos, DoAppend, NStart StartMark = " TeamPage = getPage ("http://sports.yahoo.com/nhl/teams/" & TEAM & "/stats") DoIt=false DoAppend = false NStart = CInt (PlayerStart) Do While instr (TeamPage, EOLMarker) strTemp = parseString (TeamPage) strTemp = Replace (strTemp, EOLMarker, "") if Instr(strTemp, StartMark) then DoIt = true end if if DoIt=true then if InStr(strTemp, StartMark) and (PlayerLine<>"") then if DoAppend=true then Do While Right (PlayerLine, 1) = "," PlayerLine = Left (PlayerLine, Len(PlayerLine) - 1) Loop PName = Left (PlayerLine, InStr(PlayerLine, ",") - 1) PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1) PPos = Left (PlayerLine, InStr(PlayerLine, ",") - 1) PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1) PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1) for i = NStart to playcount - 1 if InStr(playerStr(i), PName & "|" & PPos & "@") then playerStr(i)=playerStr(i) & ",.000," & PlayerLine end if next PlayerLine = "" else if InStr(strTemp, "

DoAppend = true
end if
PlayerLine = Replace (PlayerLine, "'", "`")
Do While Right (PlayerLine, 1) = ","
PlayerLine = Left (PlayerLine, Len(PlayerLine) - 1)
Loop
PName = Left (PlayerLine, InStr(PlayerLine, ",") - 1)
PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1)
PPos = Left (PlayerLine, InStr(PlayerLine, ",") - 1)
PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1)
playerStr(playcount)= PName & "|" & PPos & "@" & UCase(TEAM) & "#" & "'A'," & PlayerLine
playcount = playcount + 1
strTemp = Mid (strTemp, InStr(strTemp, StartMark))
NID(playcount)= Mid (strTemp, InStr(strTemp, StartMark) + 22)
NID(playcount)= Left (NID(playcount), InStr(NID(playcount), ">") - 2)
PlayerLine = ""
end if
elseif InStr(strTemp, StartMark) then
NID(playcount)= Mid (strTemp, InStr(strTemp, StartMark) + 22)
NID(playcount)= Left (NID(playcount), InStr(NID(playcount), ">") - 2)
strTemp = Mid (strTemp, InStr(strTemp, StartMark))
end if
if strTemp = "

" then
'Append to goalie.... append because it HAS to be a goalie (it's the end of the stats...)

Do While Right (PlayerLine, 1) = ","
PlayerLine = Left (PlayerLine, Len(PlayerLine) - 1)
Loop
PName = Left (PlayerLine, InStr(PlayerLine, ",") - 1)
PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1)
PPos = Left (PlayerLine, InStr(PlayerLine, ",") - 1)
PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1)
PlayerLine = Mid(PlayerLine, InStr(PlayerLine, ",") + 1)
for i = NStart to playcount - 1
if InStr(playerStr(i), PName & "|" & PPos & "@") then
playerStr(i)=playerStr(i) & ",.000," & PlayerLine
end if
next
DoIt=false
else
RemoveTags strTemp
PlayerLine = PlayerLine & strTemp & ","
end if
end if
Loop
end sub

sub processStrings(dbLoc)
Dim MyConn, RS, SQL_query, DoAdd, i, nName, nPos, nTeam, F_Name, L_Name, First_Space

Set MyConn = CreateObject("ADODB.Connection")
MyConn.Open ("Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & dbloc & "hockey.mdb;")

for i=0 to playcount - 1
DoAdd = false
nName = Left (playerStr(i), InStr(playerStr(i), "|") - 1)
playerStr(i) = Mid(playerStr(i), InStr(playerStr(i), "|") + 1)
nPos = Left (playerStr(i), InStr(playerStr(i), "@") - 1)
playerStr(i) = Mid(playerStr(i), InStr(playerStr(i), "@") + 1)
nTeam = Left (playerStr(i), InStr(playerStr(i), "#") - 1)
playerStr(i) = Mid(playerStr(i), InStr(playerStr(i), "#") + 1)

SQL_query = "SELECT Count([ID]) AS NumMatch FROM [hcompare] WHERE Full_Name='" & nName & "';"
Set RS = MyConn.Execute(SQL_query)
If RS("NumMatch") = 1 then
SQL_query = "SELECT * FROM [hcompare] WHERE [Full_Name]='" & nName & "';"
else
DoAdd = true
end if
RS.Close

if DoAdd then
DoAdd = false
SQL_query = "SELECT Count([ID]) AS NumMatch FROM [hcompare] WHERE Full_Name='" & nName & "' AND Team='" & nTeam & "';"
Set RS = MyConn.Execute(SQL_query)
If RS("NumMatch") = 1 then
SQL_Query = "SELECT * FROM [hcompare] WHERE [Full_Name]='" & nName & "' AND Team='" & nTeam & "';"
else
DoAdd = true
end if
RS.Close
end if

if DoAdd then
First_Space = instr(nName, " ")
F_Name = Left(nName, First_Space - 1)
L_Name = Mid(nName, First_Space + 1)

SQL_query = "SELECT Max([ID]) as TopNum FROM [hcompare];"
Set RS = MyConn.Execute(SQL_query)
SQL_query = "INSERT INTO [hcompare] ([ID], [Full_Name], [Pos], [Team], [First_Name], [Last_Name]) VALUES (" & RS("TopNum") + 1 & ",'" & nName & "','" & nPos & "','" & nTeam & "','" & F_Name & "','" & L_Name & "')"
RS.Close
MyConn.Execute(SQL_query)
SQL_Query = "SELECT * FROM [hcompare] WHERE [Full_Name]='" & nName & "';"
end if

Set RS = MyConn.Execute (SQL_query)
if RS("Pos")<>"G" then
playerStr(i) = playerStr(i) & ",0,0,0,0,0,0,0,0.00,0,0,.000,0"
end if

playerStr(i) = RS("ID") & "," & NID(i) & "," & RS("Team") & "," & RS("Last_Name") & "," & RS("First_Name") & "," & RS("Pos") & "," & playerStr(i)
RS.Close
Set RS = nothing
next

MyConn.Close
Set MyConn = nothing

end sub

sub createfile(fileName)
Dim objFile, objTStream, i
Set objFile = CreateObject("Scripting.FileSystemObject")
Set objTStream = objFile.OpenTextFile(fileName, 2, True, 0)
objTStream.Write("timestamp:" & Time & " " & Date & vbnewline)
objTStream.Write("Generated from Yahoo Stats pages: " & playcount & " players read." & vbnewline)
objTStream.Write("IDNum,Team,LastName,FirstName,Position,Status,Games,Goal,Assists,Points,PlusMinus,PIMs,PPGoals,PPAssists,SHGoals,SHAssists,GWGoals,GWAssists,Shots,SPct,GoalieStarts,GoalieTime,GoalieWins,GoalieLosses,GoalieTies,GoalsAllowed,EGA,GAA,ShotsAgainst,Saves,SvPct,Shutout" & vbnewline)
for i=0 to playcount - 1
objTStream.Write(Replace (playerStr(i), "'", "") & vbnewline)
next
Set objTStream = Nothing
Set objFile = Nothing
end sub

sub readTeam (TeamName)
readPlayers UCase(TeamName), playcount
end sub

playcount = 0
curPath = currentPath

readTeam "ana"
readTeam "atl"
readTeam "bos"
readTeam "buf"
readTeam "car"
readTeam "cgy"
readTeam "chi"
readTeam "cob"
readTeam "col"
readTeam "dal"
readTeam "det"
readTeam "edm"
readTeam "fla"
readTeam "los"
readTeam "min"
readTeam "mon"
readTeam "nas"
readTeam "njd"
readTeam "nyi"
readTeam "nyr"
readTeam "ott"
readTeam "phi"
readTeam "pho"
readTeam "pit"
readTeam "san"
readTeam "stl"
readTeam "tam"
readTeam "tor"
readTeam "van"
readTeam "was"

processStrings curPath

createfile curPath & "NHL_Player_Stats.txt"

WScript.Echo playcount & " players read." & vbnewline & "Stats output to " & curPath & "NHL_Player_Stats.txt"