' W1VE Getscores.Org Script File ' Getscores.org and this associated program Copyright 2006-2008 by Gerry Hull, W1VE ' Feedback: gerry@w1ve.com or w1ve@getscores.org However, you debug your own scripts! ' ' This program understands the full Microsoft VBScript Language, plus has extensions to ' help you get your score posted to the Getscores.org site. If you cannot write a script, ' you WILL be able to post manually. ' ' How to do it: ' There is a built in object called GetScores. Configure when you want your score to be posted ' using the user interface. When that time period has elapsed, the method OnStartUpload() is ' called. In the code of this routine, you can parse files producted by a logging program. ' Here are the functions and properties supported by the GetScores object: ' ' GetScores.QSOCount(Band)= Property. Pass Band as "160","80","40","20","15","10" or "ALL". ' Example, to set the 160 QSO number to 100, do ' GetScores.QSOCount("160") = 100 Set these values from ' inside the OnStartupLoad method. ' ' GetScores.Mult1Count(Band)= Property Same as QSOs, except for main multipler. For single mult ' contests, this is obvious. For CQWW, this is Countries. ' ' GetScores.Mult2Count(Band)= Property Same as Mult1Count, except it's the second muliplier. For ' CQWW, this is Zones. ' GetScores.LogMessage "Text" Sends any text you desire to the logging window. Great ' for debugging. ' GetScores.SendKeysToWindow WindowTitle, Keys ' This method will send keystrokes to other windows within your system. ' You must have a top-level window name. You can send ANY key or combination ' such as SHIFT, ALT or CTRL or function keys. See ' http://msdn.microsoft.com/en-us/library/8c6yea83(VS.85).aspx for a complete ' listing of how to send specific keys. Sub OnStartUpload() Getscores.ClearLog GetScores.LogMessage "KK1L TRLOG File Reader Script" GetScores.LogMessage "Version to copy LOG to server and run RTScore locally" 'Change following to the folder (directory) containing LOG.DAT and LOGCFG.DAT 'If you are running from a networked computer you need to use "map network drive" to ' connect the drive TRLog is running from. Usually you will reference the folder (directory) ' that the contest is setup in. LOG.DAT and LOGCFG.DAT are copied from here to make summary ' Make sure the drive or folder on the TRLog side is being "shared" contestfolder = "S:\Log\SS\ph08\" '<=== change to be the contest directory on TRLog machine exefolder = "C:\Utilities\" '<=== RTScore.EXE, RTScore, CTY.DAT need to be in this local (server) directory waittime = 15 'seconds the script will wait for RTScore.EXE to complete 'You should not need to change anything past here 'This program (RTScore.EXE) is on the Get.Scores computer in the search path somewhere 'CTY.DAT needs to be in the same folder summaryexecutable = "RTScore.exe" 'should be in the executable path or in "contestdirectory" summaryfilename = "RTSCORE.TXT" 'will be created each time RTScore runs set fso=CreateObject("Scripting.FileSystemObject") 'get a connection to fileSystem object If (FSO.FileExists(contestfolder & "LOG.DAT") AND FSO.FileExists(contestfolder & "LOGCFG.DAT")) Then GetScores.LogMessage "Copying LOG.DAT from " & contestfolder & " to " & exefolder If (FSO.FileExists(exefolder & "LOG.DAT")) Then FSO.DeleteFile(exefolder & "LOG.DAT") 'delete old local LOG.DAT file End If FSO.CopyFile contestfolder & "LOG.DAT", exefolder & "LOG.DAT", TRUE GetScores.LogMessage "Copying LOGCFG.DAT from " & contestfolder & " to " & exefolder FSO.CopyFile contestfolder & "LOGCFG.DAT", exefolder & "LOGCFG.DAT", TRUE Else GetScores.LogMessage "No log data exists. Skipping copy. Exiting." Exit Sub End If If (FSO.FileExists(exefolder & summaryfilename)) Then FSO.DeleteFile(exefolder & summaryfilename) 'delete old summary file End If Do Until(FSO.FileExists(exefolder & "LOG.DAT") AND FSO.FileExists(exefolder & "LOGCFG.DAT")) Loop 'this has the possibility of infinite wait, but there is a script timeout pop for rescue if needed set SummaryGenerator = CreateObject("shell.application") 'connect SummaryGenerator to a shell SummaryGenerator.ShellExecute summaryexecutable, "", exefolder, "open", 0 'run the summary executable GetScores.Sleep 10000 if (FSO.FileExists(exefolder & summaryfilename)) Then 'read the new summary file GetScores.LogMessage "Summary file exists. Okay." set f = FSO.OpenTextFile(exefolder & summaryfilename) content = f.ReadAll f.close GetScores.LogMessage "Read summary File " & exefolder & summaryfilename Else GetScores.LogMessage "*** Summary file not ready. Consider lengthening the wait time. ***" GetScores.LogMessage "Skipping summary file parse and upload. Exiting." Exit Sub End If lines = split(content, CHR(10)) 'creates an array of lines from the text for count = lbound(lines) to ubound(lines) 'iterate through the lines thisLine = trim(lines(count)) 'get rid of extra characters thisLine = replace(thisLine, CHR(13),"") 'get rid of Carriage Return 'ok, let's parse the line. set regex = CreateObject("VBScript.RegExp") 'make multi spaces a single space regex.pattern = "(\x20)+" regex.ignorecase=true regex.global=true cols = split(regex.replace(thisLine," ")) 'gets an array of words on the line band = "" 'initialie band score = 0 'initialize score isscore=false for wordIndex = lbound(cols) to ubound(cols) word = trim(cols(wordIndex)) if len(word)> 0 then Select Case wordIndex case 0 'lst word in line -- the band if IsNumeric(word) then Select Case word case "1.8" band = "160" case "3.5" band="80" case "7" band="40" case "14" band="20" case "21" band="15" case "28" band="10" end select else if word = "Total" then band = "ALL" if word = "Score" then isscore=true end if case 1 'this is the mode, don't care 'doing nothing case 2 'QSOs if isscore then GetScores.score = Clng(word) else if Band<> "" then GetScores.QsoCount(Band) = Clng(word) end if end if case 3 'Pts dont care 'do nothing case 4 'Total Multiplers in this case if Band<>"" then GetScores.Mult1Count(Band) = Clng(word) end if case else 'dont care about rest end select end if Next Next GetScores.LogMessage "Completed parsing" GetScores.SendScore End Sub