Solved

VB script classes - load array on initialize

Posted on 2013-06-28
1
240 Views
Last Modified: 2013-06-29
SAMPLE.sr is a text file of clear text XML documents delimited with >>>
How do I make sr.Runners populate during the initialization of the class?


<%
Class ScreenRunner

      Private m_runners

      Private Sub Class_Initialize
           m_runners =   GetScreenRunners()
      End Sub
      
      Public Property Get Runners()
            
      End Property
      
      Public Property Let Runners(m_runners)
      
           Runners = m_runners
      
      End Property
      
      
      

      Public Function GetScreenRunners()
      
            set oSR = Server.CreateObject("Scripting.FileSystemObject") :  Set oBlock = oSR.OpenTextFile(Server.MapPath("SAMPLE.sr"))

            Do While Not oBlock.AtEndOfStream
                  sBlock = sBlock & oBlock.ReadLine & vbcrlf
            Loop

      
            oBlock.close  : set oBlock = nothing :  set oSR = nothing


            if instr(sBlock, ">>>") > 0 then
                aBlocks = split(sBlock, ">>>")
            else
                dim aBlocks : ReDim aBlocks(1)  :  set aBlocks(0) = loadXStr(xStr)
            end if


            Dim xBlocks : ReDim xBlocks(ubound(aBlocks))

            for b = 0 to ubound(aBlocks)            
                  Set oXml = CreateObject("Microsoft.XMLDOM")
                  oXml.async = false
                  oXml.loadxml aBlocks(b)            
                  set xBlocks(b)  = oXml              
            next


      GetScreenRunners = xBlocks

      
      End Function


      
      
      Public Function sR(path)
      Set oSR = Server.CreateObject("Scripting.FileSystemObject") :  Set oBlock = oSR.OpenTextFile(Server.MapPath(path))
'



            Do While Not oBlock.AtEndOfStream
                  sBlock = sBlock & oBlock.ReadLine & vbcrlf
            Loop
            oBlock.close  : set oBlock = nothing :  set oSR = nothing



            if instr(sBlock, ">>>") > 0 then
                aBlocks = split(sBlock, ">>>")
            else
                dim aBlocks : ReDim aBlocks(1)  :  set aBlocks(0) = loadXStr(xStr)
            end if


      Dim xBlocks : ReDim xBlocks(ubound(aBlocks))

            for b = 0 to ubound(aBlocks)
            call loadXStr(aBlocks(b))
            set xBlocks(b)  = loadXStr(aBlocks(b))
               
            next
      sR = xBlocks
      End Function
      
      


End Class



      Dim sr
      Set sr = New ScreenRunner
         
      response.write sr.Runners(0)

%>
0
Comment
Question by:KeithMcElroy
1 Comment
 
LVL 35

Accepted Solution

by:
Robert Schutt earned 500 total points
ID: 39286850
I think there are 2 problems:
- you need to return the private property in the Public Property Get
- you can't access the indexed values directly from the property outside the class (but you could make an indexed property I think)

The Let property needs to be the other way around but I'm not sure you need that so I commented it out for the moment.

Anyway, this works:
<%
Class ScreenRunner

      Private m_runners

      Private Sub Class_Initialize
           m_runners =   GetScreenRunners()
      End Sub
      
      Public Property Get Runners()
            Runners = m_runners
      End Property
      
'      Public Property Let Runners(m_runners)
'           Runners = m_runners
'      End Property
      
      
      

      Public Function GetScreenRunners()
      
            set oSR = Server.CreateObject("Scripting.FileSystemObject") :  Set oBlock = oSR.OpenTextFile(Server.MapPath("SAMPLE.sr"))

            Do While Not oBlock.AtEndOfStream
                  sBlock = sBlock & oBlock.ReadLine & vbcrlf
            Loop

      
            oBlock.close  : set oBlock = nothing :  set oSR = nothing


            if instr(sBlock, ">>>") > 0 then
                aBlocks = split(sBlock, ">>>")
            else
                dim aBlocks : ReDim aBlocks(1)  :  set aBlocks(0) = loadXStr(xStr)
            end if


            Dim xBlocks() : ReDim xBlocks(ubound(aBlocks))

            for b = 0 to ubound(aBlocks)            
                  Set oXml = CreateObject("Microsoft.XMLDOM")
                  oXml.async = false
                  oXml.loadxml aBlocks(b)            
                  set xBlocks(b)  = oXml               
            Next


      GetScreenRunners = xBlocks

      
      End Function


      
      
      Public Function sR(path)
      Set oSR = Server.CreateObject("Scripting.FileSystemObject") :  Set oBlock = oSR.OpenTextFile(Server.MapPath(path))
'



            Do While Not oBlock.AtEndOfStream
                  sBlock = sBlock & oBlock.ReadLine & vbcrlf
            Loop
            oBlock.close  : set oBlock = nothing :  set oSR = nothing



            if instr(sBlock, ">>>") > 0 then
                aBlocks = split(sBlock, ">>>")
            else
                dim aBlocks : ReDim aBlocks(1)  :  set aBlocks(0) = loadXStr(xStr)
            end if


      Dim xBlocks : ReDim xBlocks(ubound(aBlocks))

            for b = 0 to ubound(aBlocks)
            call loadXStr(aBlocks(b))
            set xBlocks(b)  = loadXStr(aBlocks(b))
               
            next
      sR = xBlocks
      End Function
      
      


End Class



      Dim sr
      Set sr = New ScreenRunner

      Dim srr, i
      srr = sr.Runners
      For i=0 To UBound(srr)
        response.write "<hr>"
        response.write Replace(Replace(srr(i).xml, "<", "&lt;"), vbCrLf, "<br>")
      Next

%>

Open in new window

0

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I met Paul Devereux (@pdevereux) today when I responded to his tweet asking “Anybody know how to automate adding files from disk to a folder in #outlook  ?”.  I replied back and told Paul that using automation, in this case scripting, to add files t…
If you need to start windows update installation remotely or as a scheduled task you will find this very helpful.
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

821 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question