Weekly/Monthly Challenge?

Re: RE: Weekly/Monthly Challenge? (Netjunkie)

Wed, 20 Jan 2010 19:47:31 GMT

For a person starting out like me this is one of the best threads ever!

RE: Weekly/Monthly Challenge? (TNO)

Sat, 12 Apr 2008 07:48:42 GMT

Indeed, I noticed that as well. I believe this solution was written before GetRef() was implemented. (WSH 5?)

RE: Weekly/Monthly Challenge? (ehvbs)

Sat, 12 Apr 2008 05:27:04 GMT

Hi TNO,

nice solution! But as can be seen from this:

 Class acc
     Private n
     Public Default Function inc(i)
         n = n + i
         inc = n
     End Function
 End Class
 
 Function foo(n)
     Dim bar
     Set bar = New acc
     bar(n)
     Set foo = bar
 End Function
 
 Dim fncAcc : Set fncAcc = foo( 3 )
 
 WScript.Echo "type of GetRef( 'foo' ):", TypeName( GetRef( "foo" ) )
 WScript.Echo "type of fncAcc:", TypeName( fncAcc )
 WScript.Echo "3 calls of fncAcc( 4 )"
 
 Dim nCnt
 For nCnt = 1 To 3
     WScript.Echo fncAcc( 4 )
 Next
 
 Dim oAcc : Set oAcc = New acc
 WScript.Echo "type of oAcc:", TypeName( oAcc )
 WScript.Echo "3 calls of oAcc.inc( 4 )"
 
 For nCnt = 1 To 3
     WScript.Echo oAcc.inc( 4 )
 Next

output:

 type of GetRef( 'foo' ): Object
 type of fncAcc: acc
 3 calls of fncAcc( 4 )
 7
 11
 15
 type of oAcc: acc
 3 calls of oAcc.inc( 4 )
 4
 8
 12

(1) foo() doesn't return a function ('pointer'), but an object of class acc

(2) as you have to write a class (acc) anyway, the addtion of foo() is
extra work with no gain at all.

Regards

ehvbs

RE: Weekly/Monthly Challenge? (TNO)

Fri, 11 Apr 2008 14:31:12 GMT

Here's the solution to my original challenge:

Class acc
     Private n
     Public Default Function inc(i)
         n = n + i
         inc = n
     End Function
 End Class
 
 Function foo(n)
     Dim bar
     Set bar = New acc 
     bar(n)
     Set foo = bar
 End Function

The article I was reading when I came across this is here: http://www.paulgraham.com/icad.html

RE: Weekly/Monthly Challenge? (dm_4ever)

Thu, 10 Apr 2008 08:22:41 GMT

Thanks ehvbs for the simplified example of what's going on. This really helped in understanding the previous example...though I still havent' gone completely through it to determine why it doesn't work as you stated.

RE: Weekly/Monthly Challenge? (ehvbs)

Wed, 09 Apr 2008 15:55:40 GMT

Hi dm_4ever,

you must be joking! But have a look at this

 '' simpleiter.vbs - showing a simple VBScript iterator class
 
 '' cIncr - Incrementor
 '
 Class cIncr
 
 Private m_nCur ''< stores current counter value
 
 Private Sub Class_Initialize()  ''< constructor - alas, no parameters possible
   m_nCur = 0
 End Sub
 
 Private Sub Class_Terminate() ''< destructor - not really needed here
 End Sub
 
 Public Function init( nStart ) ''< nifty trick to get construction with parameter(s)
   m_nCur = nStart              ''< (c) Justin Piper
   Set init = Me ''< returns the object/instance (this,$self) to make Set oIncr = New cIncr.init( 5 ) possible
 End Function
 
 Public Function getNext() ''< returns m_Cur & increments [much more intuitive than the Javascript iterator]
   getNext = m_nCur
   m_nCur  = m_nCur + 1 ''< fixed Step
 End Function
 
 End Class
 
 '' main
 
 Dim oIncr1 : Set oIncr1 = New cIncr.init( 4711 )
 Dim oIncr2 : Set oIncr2 = New cIncr.init(    0 )
 Dim nIdx
 For nIdx = 1 To 5
     WScript.Echo nIdx, oIncr1.getNext, oIncr2.getNext()
 Next

to see the principle of an iterator in isolation.

Regards

ehvbs

RE: Weekly/Monthly Challenge? (dm_4ever)

Wed, 09 Apr 2008 14:35:11 GMT

If I knew what that JavaScript example does or how to use it I might give it a shot. Regardless, you guys are on a different level than me...just looking at ehvbs post damn nearly made my brain explode.

RE: Weekly/Monthly Challenge? (ehvbs)

Sat, 05 Apr 2008 01:29:18 GMT

Hi all challengees,

my challenges are:

(1) Explain how and why this code (doesn't) work(s):

 <?xml version="1.0" encoding="iso-8859-1" standalone="yes" ?>
 <package>
  <job id = "iter">
   <script language = "Javascript">
    <![CDATA[
 // ###########################################################################
 
 function buildJsIter( nStart )
 { return function( nStep ) { return nStart += nStep; };
 }
 
 // ###########################################################################
    ]]>
   </script>
   <script language = "VBScript">
    <![CDATA[
 ' ############################################################################
 
 Option Explicit
 
 WScript.Quit doAllTest()
 WScript.Quit doVbsIterFuncTest()
 WScript.Quit doVbsIterTest()
 WScript.Quit doJsIterTest()
 
 Function doJsIterTest()
   Dim nStart    : nStart        = 5
   Dim fncJsIter : Set fncJsIter = buildJsIter( nStart )
   Dim nStep
   WScript.Echo "JsIter starts with", nStart
   For nStep = 1 To 4
       WScript.Echo nStep, fncJsIter( nStep )
   Next
   doJsIterTest = 0
 End Function
 
 Function doVbsIterTest()
   Dim nStart   : nStart       = 5
   Dim oVbsIter : Set oVbsIter = New cVbsIter.init( nStart )
   Dim nStep
   WScript.Echo "VbsIter starts with", nStart
   For nStep = 1 To 4
       WScript.Echo nStep, oVbsIter.getNext( nStep )
   Next
   doVbsIterTest = 0
 End Function
 
 Function doVbsIterFuncTest()
   Dim nStart      : nStart          = 5
   Dim fncVbsIterr : Set fncVbsIterr = buildVbsIterFunc( nStart )
   Dim nStep
   WScript.Echo "VbsIter starts with", nStart
   For nStep = 1 To 4
       WScript.Echo nStep, fncVbsIterr( nStep )
   Next
   doVbsIterFuncTest = 0
 End Function
 
 Function doAllTest()
   Dim nStart, nStep, nType, nIdx, nNext
   Dim aIters( 2, 1 )
   aIters( 0, 0 )     = "JS  "
   Set aIters( 0, 1 ) = CreateObject( "Scripting.Dictionary" )
   aIters( 1, 0 )     = "VBSC"
   Set aIters( 1, 1 ) = CreateObject( "Scripting.Dictionary" )
   aIters( 2, 0 )     = "VBSF"
   Set aIters( 2, 1 ) = CreateObject( "Scripting.Dictionary" )
 ' For nStart = 1 To 2
   For nStart = 1 To 10 Step 3
       WScript.Echo "Start is", nStart
       For nType = 0 To UBound( aIters, 1 )
           Select Case nType
             Case 0
               Set aIters( nType, 1 )( aIters( nType, 1 ).Count ) = buildJsIter( nStart )
             Case 1
               Set aIters( nType, 1 )( aIters( nType, 1 ).Count ) = New cVbsIter.init( nStart )
             Case 2
 '             WScript.Sleep 300
               Set aIters( nType, 1 )( aIters( nType, 1 ).Count ) = buildVbsIterFunc( nStart )
           End Select
       Next
 '     For nStep = 1 To 1
       For nStep = 1 To 10 Step 3
           WScript.Echo " Step is", nStep
           For nType = 0 To UBound( aIters, 1 )
               WScript.Echo "  Type is", aIters( nType, 0 )
               For Each nIdx In aIters( nType, 1 ).Keys
                   WScript.Echo "   Idx is", nIdx
                   Select Case nType
                     Case 0
                       nNext = aIters( nType, 1 )( nIdx )( nStep )
                     Case 1
                       nNext = aIters( nType, 1 )( nIdx ).getNext( nStep )
                     Case 2
                       nNext = aIters( nType, 1 )( nIdx )( nStep )
                   End Select
                   WScript.Echo "    Next is", nNext
               Next
           Next
       Next
   Next
   doAllTest = 0
 End Function
 
 Class cVbsIter
 
 Private m_nCur
 
 Public Function init( nStart )
   m_nCur = nStart
   Set init = Me
 End Function
 
 Public Function getNext( nStep )
   m_nCur  = m_nCur + nStep
   getNext = m_nCur
 End Function
 
 End Class
 
 Function buildVbsIterFunc( nStart )
   Dim sFuncName : sFuncName = getUnique()
   Dim sCode     : sCode     = Join( Array( _
                       "Dim gnStart_§FN§ : gnStart_§FN§ = " & nStart _
                     , "Function §FN§( nStep )" _
                     , "  gnStart_§FN§ = gnStart_§FN§ + nStep" _
                     , "  §FN§         = gnStart_§FN§" _
                     , "End Function" _
                                          ), vbCrLf )
   sCode = Replace( sCode, "§FN§", sFuncName )
 ' WScript.Echo sCode
   ExecuteGlobal sCode
   Set buildVbsIterFunc = GetRef( sFuncName )
 End Function
 
 Function getUnique_()
   Dim sTStamp : sTStamp = CStr( cDbl( Now ) ) & CStr( Timer() )
 ' WScript.Echo sTStamp
   Dim oRE     : Set oRE = New RegExp
   oRE.Global  = True
   oRE.Pattern = "[\D]"
   getUnique_  = "X" & oRE.Replace( sTStamp, "" )
 End Function
 
 Function getUnique()
   getUnique = Mid( CreateObject( "Scripting.FileSystemObject" ).GetTempName, 3, 6 )
 End Function
 
 ' ############################################################################
    ]]>
   </script>
  </job>
 </package>

output:

 Start is 1
  Step is 1
   Type is JS  
    Idx is 0
     Next is 2
   Type is VBSC
    Idx is 0
     Next is 2
   Type is VBSF
    Idx is 0
     Next is 2
  Step is 4
   Type is JS  
    Idx is 0
     Next is 6
   Type is VBSC
    Idx is 0
     Next is 6
   Type is VBSF
    Idx is 0
     Next is 6
  Step is 7
   Type is JS  
    Idx is 0
     Next is 13
   Type is VBSC
    Idx is 0
     Next is 13
   Type is VBSF
    Idx is 0
     Next is 13
  Step is 10
   Type is JS  
    Idx is 0
     Next is 23
   Type is VBSC
    Idx is 0
     Next is 23
   Type is VBSF
    Idx is 0
     Next is 23
 Start is 4
  Step is 1
   Type is JS  
    Idx is 0
     Next is 24
    Idx is 1
     Next is 5
   Type is VBSC
    Idx is 0
     Next is 24
    Idx is 1
     Next is 5
   Type is VBSF
    Idx is 0
     Next is 24
    Idx is 1
     Next is 5
  Step is 4
   Type is JS  
    Idx is 0
     Next is 28
    Idx is 1
     Next is 9
   Type is VBSC
    Idx is 0
     Next is 28
    Idx is 1
     Next is 9
   Type is VBSF
    Idx is 0
     Next is 28
    Idx is 1
     Next is 9
  Step is 7
   Type is JS  
    Idx is 0
     Next is 35
    Idx is 1
     Next is 16
   Type is VBSC
    Idx is 0
     Next is 35
    Idx is 1
     Next is 16
   Type is VBSF
    Idx is 0
     Next is 35
    Idx is 1
     Next is 16
  Step is 10
   Type is JS  
    Idx is 0
     Next is 45
    Idx is 1
     Next is 26
   Type is VBSC
    Idx is 0
     Next is 45
    Idx is 1
     Next is 26
   Type is VBSF
    Idx is 0
     Next is 45
    Idx is 1
     Next is 26
 Start is 7
  Step is 1
   Type is JS  
    Idx is 0
     Next is 46
    Idx is 1
     Next is 27
    Idx is 2
     Next is 8
   Type is VBSC
    Idx is 0
     Next is 46
    Idx is 1
     Next is 27
    Idx is 2
     Next is 8
   Type is VBSF
    Idx is 0
     Next is 46
    Idx is 1
     Next is 27
    Idx is 2
     Next is 8
  Step is 4
   Type is JS  
    Idx is 0
     Next is 50
    Idx is 1
     Next is 31
    Idx is 2
     Next is 12
   Type is VBSC
    Idx is 0
     Next is 50
    Idx is 1
     Next is 31
    Idx is 2
     Next is 12
   Type is VBSF
    Idx is 0
     Next is 50
    Idx is 1
     Next is 31
    Idx is 2
     Next is 12
  Step is 7
   Type is JS  
    Idx is 0
     Next is 57
    Idx is 1
     Next is 38
    Idx is 2
     Next is 19
   Type is VBSC
    Idx is 0
     Next is 57
    Idx is 1
     Next is 38
    Idx is 2
     Next is 19
   Type is VBSF
    Idx is 0
     Next is 57
    Idx is 1
     Next is 38
    Idx is 2
     Next is 19
  Step is 10
   Type is JS  
    Idx is 0
     Next is 67
    Idx is 1
     Next is 48
    Idx is 2
     Next is 29
   Type is VBSC
    Idx is 0
     Next is 67
    Idx is 1
     Next is 48
    Idx is 2
     Next is 29
   Type is VBSF
    Idx is 0
     Next is 67
    Idx is 1
     Next is 48
    Idx is 2
     Next is 29
 Start is 10
  Step is 1
   Type is JS  
    Idx is 0
     Next is 68
    Idx is 1
     Next is 49
    Idx is 2
     Next is 30
    Idx is 3
     Next is 11
   Type is VBSC
    Idx is 0
     Next is 68
    Idx is 1
     Next is 49
    Idx is 2
     Next is 30
    Idx is 3
     Next is 11
   Type is VBSF
    Idx is 0
     Next is 68
    Idx is 1
     Next is 49
    Idx is 2
     Next is 30
    Idx is 3
     Next is 11
  Step is 4
   Type is JS  
    Idx is 0
     Next is 72
    Idx is 1
     Next is 53
    Idx is 2
     Next is 34
    Idx is 3
     Next is 15
   Type is VBSC
    Idx is 0
     Next is 72
    Idx is 1
     Next is 53
    Idx is 2
     Next is 34
    Idx is 3
     Next is 15
   Type is VBSF
    Idx is 0
     Next is 72
    Idx is 1
     Next is 53
    Idx is 2
     Next is 34
    Idx is 3
     Next is 15
  Step is 7
   Type is JS  
    Idx is 0
     Next is 79
    Idx is 1
     Next is 60
    Idx is 2
     Next is 41
    Idx is 3
     Next is 22
   Type is VBSC
    Idx is 0
     Next is 79
    Idx is 1
     Next is 60
    Idx is 2
     Next is 41
    Idx is 3
     Next is 22
   Type is VBSF
    Idx is 0
     Next is 79
    Idx is 1
     Next is 60
    Idx is 2
     Next is 41
    Idx is 3
     Next is 22
  Step is 10
   Type is JS  
    Idx is 0
     Next is 89
    Idx is 1
     Next is 70
    Idx is 2
     Next is 51
    Idx is 3
     Next is 32
   Type is VBSC
    Idx is 0
     Next is 89
    Idx is 1
     Next is 70
    Idx is 2
     Next is 51
    Idx is 3
     Next is 32
   Type is VBSF
    Idx is 0
     Next is 89
    Idx is 1
     Next is 70
    Idx is 2
     Next is 51
    Idx is 3
     Next is 32

(2) Come up with a way to prove/verify the (enhanced?) code.

Regards

ehvbs

RE: Weekly/Monthly Challenge? (TNO)

Thu, 03 Apr 2008 22:46:44 GMT

Its too bad this topic fell off the face of the map, but I found an interesting article(anonymous for now) that posed a challenge I would like to reproduce here to hopefully renew interest.

The challenge:

...write a function that generates accumulators-- a function that takes a number n, and returns a function that takes another number i and returns n incremented by i.

(That's incremented by, not plus. An accumulator has to accumulate.)

Hint: An example in JavaScript that does this:

function foo (n) { return function (i) { return n += i } }

P.S. The vbscript solution I have does this in 14 lines of code. Can yours do better?

I can't wait to see the magic people come up with on this one.

RE: Weekly/Monthly Challenge? (ehvbs)

Thu, 29 Nov 2007 01:31:15 GMT

Hi all challengees,

I should have posted some more challenges, but I got the impression that the interest
in this topic kind of declined. Perhaps having just one sort of challenge (mine) and the
size of the thread are to blame. If you think that doing it in a separate forum would
improve traffic/quality/fun, please say so at

http://www.visualbasicscript.com/fb.aspx?m=53664

If you think it worthwhile to continue here:

Rework DiGiTAL.SkReAM's script to find the two last modified files

http://www.visualbasicscript.com/fb.aspx?m=53877

so that

(1) find is not needed

(2) the 'trimming' of the array is not needed

(3) it can be used to search a subdirectory tree

Good luck!

ehvbs

RE: Weekly/Monthly Challenge? (ehvbs)

Sun, 07 Oct 2007 05:57:56 GMT

Hi dm_4ever and all other people willing to accept a challenge,

as to be expected one of the most stalwart contributors to this topic posted
code well worth studying. It won't be a surprise that after seeing the good points
of his approach, I feel inclined to switch to nit picking mode:

(1) My aim for challenge (a) was to have a single point/ad hoc way of using
    RegExps in VBScript. In dm_4ever's code you have to look at 2-3 parts of
    the code (definition of pattern, setting of vbTextCompare/IgnoreCase, and
    execution) to understand what's going on. I had in mind something like this:

       ... code with no reference to the RegExp ...
       If reTest( sTest, <suitable params 01> ) Then
          sRes = reReplace( sTest, <suitable params 02> )
       Else
          sRes = reReplace( sTest, <suitable params 03> )
       End If

    I admit that using reTest() etc. in a loop - like dm_4ever's test code - isn't
    the best context to see/demonstrate the usefulness of such functions, because
    the RegExp would be created for each round. Obviously the object should be
    created before entering such a loop. That's why I came up with challenge (c).
    Given such a wrapper class, the instantiation/initialization could occur before
    the loop and using the object within would be trivial

      Dim oRE : Set oRE = New cRE.Init( <suitable params> ) ' all interesting facts
                                                             ' about the RegExp visible
                                                             ' here (perhaps including
                                                             ' the replacement)
      ....
      Do
         sSrc = <whatever>
         sRes = oRE.Replace( sSrc, sRpl )
Or even
         sRes = oRE.Replace( sSrc )
      Loop

(2) I don't think that the params to GetRegEx() are 'suitable'. It should be possible
    to specify all properties of the resulting RegExp:

      Global - IgnoreCase - Multiline - Pattern

    Forcing Global to be True (just to be able to pull the (ingenious) trick of
    applying the RegExp to its own pattern in CleanRegPattern()) won't do. I'm wondering,
    whether looking at Perl's specifying such properties by letters/string - gimsx -
    could be a way.

(3) For the 'cleaning' of the RegExp's pattern I'm experimenting with:

      Set s_reFmtX       = New RegExp
      s_reFmtX.Pattern   = "(?:\s)|#(?:[\D\d]+?)$"
      s_reFmtX.Global    = True
      s_reFmtX.Multiline = True
      ...
      m_oRE.Pattern = goReLib.s_reFmtX.Replace( sPattern, "" )
      ...

    That presupposes using \x20 for space and \23 for # in the readable definition.
    An example for a complex pattern used to cut text blocks from a longer string/
    file like

        ...
            BEGIN_CodeBlock VBSSimpleClass
        ''= §ClassName§ - §ClassPurpose§
        ' ============================================================================
        Class §ClassName§
        ...
        End Class ' §ClassName§
        END_CodeBlock VBSSimpleClass
        ...
        BEGIN_CodeBlock VBSXplFunc
        ' ============================================================================
        goXPLLib.Add _
          "§XplFuncName§", "§XplFuncPurpose§"
        ' ============================================================================
        Function §XplFuncName§()
          Dim nRVal : nRVal = 0
          §XplFuncName§ = nRVal
        End Function

        'NextXplFunc
        END_CodeBlock VBSXplFunc
        ...

      Set s_reBlocks = New cRE.initPF( Join( Array( _
           "^              # am Anfang der Zeile" _
         , "BEGIN_         # konstanter erster Teil des Tag" _
         , "(\w+)          # \1: variabler zweiter Teil des Tag " _
         , "\s+            # whitespace bis zum" _
         , "(\w+)          # \2: Namen des Blocks" _
         , "\r\n           # neue Zeile vor Block" _
         , "([\D\d]+?)     # $3: Block=WirklichAlles (aber nicht gierig)" _
         , "\r\n           # neue Zeile vor Block" _
         , "^              # am Anfang der Zeile" _
         , "END_           # konstanter erster Teil des Close Tag" _
         , "\1             # \1: zweiter Teils des Close Tag wie oben" _
         , "\s+            # whitespace bis zum" _
         , "\2             # \2: Namen des Blocks" _
                                                  ), vbLf ), "GiMX" )

Eagerly awaiting further solutions ...

ehvbs

RE: Weekly/Monthly Challenge? (dm_4ever)

Fri, 05 Oct 2007 07:18:35 GMT

Still work in progress...

 Option Explicit
 
 RegExTest()
 
 Sub RegExTest()
     Dim strRegPattern : strRegPattern = Join(Array("^  # start of string", _
                                         "[a-zA-Z]      # any letter", _
                                         "[\w\.\-]*     # any letter/number/underscore, period, hyphen; occuring 0x or more", _
                                         "\d{2}           # 2 numbers", _
                                         "@             # literal @ character", _
                                         "\w+           # any letter/number/underscore; occuring 1x or more", _
                                         "\.            # period", _
                                         "[a-zA-Z]+     # any letter; occuring 1x or more", _
                                         "$             # end of String"), VbCrLf)
                                         
     Dim RegEx : Set RegEx = GetRegEx(strRegPattern, vbTextCompare)
     Dim arrTemp : arrTemp = Array("asndaisdnas@as-d.com", "asndaisdnas@asd.com", _
                                  "asndaisdnas123@asd.com", "as.nda_isdnas@asd.com", _
                                  "asn90d.aisd_nas12@as-d.com", "asnd.aisd_nas12@asd.com", _
                                  "asn3d.a8isd_nas12@asd.com")
    Dim strTemp
    For Each strTemp In arrTemp 
        WScript.Echo strTemp & Space(30 - Len(strTemp)) & CStr(RegEx.Test(strTemp))
    Next
 End Sub
 
 Function GetRegEx(strPattern, vbCompare)
     Dim RegEx : Set RegEx = New RegExp
     RegEx.Global = True
     RegEx.Pattern = CleanRegPattern(RegEx, strPattern)
     RegEx.IgnoreCase = (vbTextCompare = vbCompare)
     Set GetRegEx = RegEx
 End Function
 
 Function CleanRegPattern(RegEx, strPattern)
     RegEx.Pattern = "\s+#\s*.*\n?|\s*\n?"
     CleanRegPattern = RegEx.Replace(strPattern, "")
 End Function

RE: Weekly/Monthly Challenge? (TNO)

Sun, 30 Sep 2007 13:00:55 GMT

I've been away from the vbs language a bit (lots of JavaScript development), so I'm playing catch up yet again. The XML concept I'm still considering. I'm curious if it its plausible to create a vbscript equivalent of E4X.
http://www.w3schools.com/e4x/default.asp

The only thing thats looking difficult is inline XML in the code. But even if we treated the XML in a separate String/file. I think creating a parsed String object of sorts could work. Efficiency wise this will be questionable to say the least when you get to even larger XML docs. (unless we resort to some sort of SAX to save memory)

RE: Weekly/Monthly Challenge? (ehvbs)

Thu, 27 Sep 2007 11:43:19 GMT

Hi dm_4ever,

your explanation/specification is a very good example:

Dim oRE : Set oRE = New RegExp
oRE.Pattern = rePattern( Array( _
        "^             # start of string" _
      , "[a-zA-Z]      # any letter" _
      , "[\w\.\-]*     # any letter/number/underscore, period, hyphen; occuring 0x or more" _
      , "\d{2}         # 2 numbers" _
      , "@             # literal @ character" _
      , "\w+           # any letter/number/underscore; occuring 1x or more" _
      , "\.            # period" _
      , "[a-zA-Z]+     # any letter; occuring 1x or more" _
      , "$             # end of string" _
                                ), vbLf )

I just changed - to # to make it more compatible to Perl:

Long regexps like this may impress your friends, but can be hard to
decipher. In complex situations like this, the //x modifier for a
match is invaluable. It allows one to put nearly arbitrary whitespace
and comments into a regexp without affecting their meaning. Using it,
we can rewrite our 'extended' regexp in the more pleasing form

   /^
      [+-]?         # first, match an optional sign
      (             # then match integers or f.p. mantissas:
          \d+\.\d+ # mantissa of the form a.b
         |\d+\.     # mantissa of the form a.
         |\.\d+     # mantissa of the form .b
         |\d+       # integer of the form a
      )
      ([eE][+-]?\d+)? # finally, optionally match an exponent
   $/x;

(cited from perlretut)

RE: Weekly/Monthly Challenge? (dm_4ever)

Thu, 27 Sep 2007 10:47:30 GMT

I wonder if anyone is biting and working on this on? I had a question about (b) "pattern specs in a nice format"...can you show an example of how that would look? Is it patterns listed or plain language or patterns with comments?

RE: Weekly/Monthly Challenge? (ehvbs)

Mon, 24 Sep 2007 08:14:42 GMT

Hi all who would like another challenge!

Once again, I failed to choose a problem/topic that caught your interest. I
hope, this time I will be more lucky.

RegExps are much easier to use/maintain in other programming languages. You
need about five lines to setup a RegExp for use in VBScript:

   Dim RegEx : Set RegEx = New RegExp
   RegEx.Pattern = "^[a-zA-Z][\w\.\-]*\d{2}@\w+\.[a-zA-Z]+$"
   RegEx.IgnoreCase = True
   RegEx.Global = True
   RegEx.Multiline = False
   Dim sRpl : sRpl = "replacement"

In Perl this could be done 'on the fly' in a one line expression. The .NET
RegExps can be specified in an easy to read format (Option: IgnorePatternWhitespace).
See

http://www.visualbasicscript.com/fb.aspx?m=52097

where dm_4ever had to provide the specification/definition

    ^             - start of string
    [a-zA-Z]      - any letter
    [\w\.\-]*     - any letter/number/underscore, period, hyphen; occuring 0x or more
    \d{2}         - 2 numbers
    @             - literal @ character
    \w+           - any letter/number/underscore; occuring 1x or more
    \.            - period
    [a-zA-Z]+     - any letter; occuring 1x or more
    $             - end of string

for the pattern

    "^[a-zA-Z][\w\.\-]*\d{2}@\w+\.[a-zA-Z]+$"

as an 'extra'. Wouldn't it be nice to assign the .Pattern from such a definiton?
No more worries about discrepancies between code and comment/specs!

The standard level challenge:

(a) Write a set of functions that can be used like this:

          Dim sSrc : sSrc = "some string to work with"
          ...
          If reTest( sSrc, <list of suitable params> ) Then
          ...
          Dim oMTS : Set oMTS = reExecute( sSrc, <list of suitable params> )
          ...
          Dim sTgt : sTgt = reReplace( sSrc, "replacement", <list of suitable params> )

(b) Write a function that takes an easy to read pattern and transforms it into
      the condensed format the RegExp can work with:

      oRE.Pattern = rePattern( <pattern specs in a nice format akin to dm_4ever's sample> )

The advanced level challenge:

(c) Write a (wrapper) class that provides at least the functionality of (a)
      and (b)

By the way: If you are interested in RegExps you surely know about mikeock's
RegexTester

   http://www.visualbasicscript.com/fb.aspx?m=42269

In addition you may want to look at

http://erik.eae.net/playground/regexp/regexp.html

for a very nice presentation of the results.

ehvbs

RE: Weekly/Monthly Challenge? (dm_4ever)

Tue, 28 Aug 2007 17:59:16 GMT

Thanks for the compliments ehvbs. I have taken many of the slight changes/suggestions you made and incorporated into mine.

RE: Weekly/Monthly Challenge? (ehvbs)

Tue, 28 Aug 2007 15:01:51 GMT

Hi all who can be lured into feeling challenged!

After having my nit picking way with dm_4ever's code:

 ' Sorry, try as I might, I can't find anything wrong this:
 Option Explicit
 
 ' I prefer returning an errorlevel explicitly; hence the function
 WScript.Quit Main()
 
 ' note the parameter list () in dm_4ever's original code: Sub Main()
 Function Main()
    Dim nRVal : nRVal = 0  ' not really used here
    ' I'd like to allow for the -e mode/version too
    Dim sArgs : sArgs = collectArgs()
    If InStr( 1, WScript.FullName, "wscript", vbTextCompare ) Then
       Dim sCmd : sCmd = "%comspec% /c cscript.exe " + WScript.ScriptFullName
       If "" <> sArgs Then
          ' to keep the dos box open for -e mode
          sCmd = Replace( sCmd, "/c", "/k" ) + " """ + sArgs + """"
          MsgBox sCmd
       End If
       ' No need for the just once used variable objShell
       CreateObject( "WScript.Shell" ).Run sCmd, 1, False
       WScript.Quit
    End If
    If "" <> sArgs Then
       ' Restricting the ' for " trick for the -e version
       sArgs = Replace( sArgs, "'", """" )
       handleCode sArgs
    Else
       ' keeping different levels apart
       DisplayHeader
       StartShell
       DisplayFooter
    End If
    Main = nRVal
 End Function
 
 ' I prefer to follow the VBScript Docs:
 '    If a Sub procedure has no arguments, its Sub statement must
 '    include an empty set of parentheses ().
 ' It's more compatible with other programming languages I use and
 ' I don't think there is anything to gain from economizing here.
 Sub StartShell()
    ' moved one level up: DisplayHeader
    ' Nothing to count, just interested in boolean continue or not
    ' Dim intLCount : intLCount = 0
    Dim bContinue : bContinue = True
    Dim strInputCode, strCode
    Do
 '      Do Until intLCount = 1
        Do While bContinue
           ' prompting here makes a nicer lineup
           WScript.StdOut.Write ">> "
           ' not needed here, no command line around that could steal "
           ' strInputCode = Replace(WScript.StdIn.ReadLine, "'", """")
           strInputCode = WScript.StdIn.ReadLine
           Select Case UCase(strInputCode)
              ' avoid multiple exits/ bypassing main: instead of WScript.Quit
              Case "EXIT", "QUIT"        Exit Sub
           End Select
 
           If strInputCode = "" Then
              bContinue = False
           End If
           strCode = strCode & strInputCode & ":"
        Loop
        handleCode strCode
 
        bContinue = True
        strCode   = ""
    Loop
 End Sub
 
 Sub DisplayHeader()
    Dim intSpacers : intSpacers = 50
    WScript.StdOut.WriteLine String(intSpacers, "#")
    Dim strMsg : strMsg = "VBScript Shell v1.0"
    WScript.StdOut.WriteLine Space((intSpacers - Len(strMsg)) / 2) & strMsg
    strMsg = "Type 'Exit' or 'Quit' to exit"
    '
    ' WScript.StdOut.WriteLine Space((intSpacers - Len(strMsg)) / 2) & "Type 'Exit' or 'Quit' to exit"
    WScript.StdOut.WriteLine Space((intSpacers - Len(strMsg)) / 2) & strMsg
    WScript.StdOut.WriteLine String(intSpacers, "#")
 End Sub
 
 Sub DisplayFooter()
    Dim intSpacers : intSpacers = 50
    WScript.StdOut.WriteLine String(intSpacers, "#")
    Dim strMsg : strMsg = "Done"
    WScript.StdOut.WriteLine Space((intSpacers - Len(strMsg)) / 2) & strMsg
    strMsg = "!! Thanks dm_4ever !!"
    WScript.StdOut.WriteLine Space((intSpacers - Len(strMsg)) / 2) & strMsg
    WScript.StdOut.WriteLine String(intSpacers, "#")
 End Sub
 
 '' collect WScript.Arguments into a string
 '============================================================================
 Function collectArgs()
   Dim sRVal : sRVal = ""
   Dim sArg
   For Each sArg In WScript.Arguments
       ' Against the VBScript rules, I use + to concatenate strings;
       ' reserving & for concatenating other=automatically converted
       ' values into a string
       sRVal = sRVal + " " + sArg
   Next
   collectArgs = Trim( sRVal )
 End Function
 
 '' execute strCode
 '============================================================================
 Sub handleCode( strCode )
 On Error Resume Next
    Execute strCode
    If Err.Number <> 0 Then
       WScript.StdOut.WriteLine "Error Number:       " & Err.Number
       WScript.StdOut.WriteLine "Error Description:  " & Err.Description
    End If
  On Error GoTo 0
 End Sub

Sample output:

 cscript dm401.vbs
 ##################################################
                 VBScript Shell v1.0
           Type 'Exit' or 'Quit' to exit
 ##################################################
 >> For i = o To 2
 >>   WScript.Echo i, "didn't replace ' with """
 >> Next
 >>
 0 didn't replace ' with "
 1 didn't replace ' with "
 2 didn't replace ' with "
 >> exit
 ##################################################
                        Done
               !! Thanks dm_4ever !!
 ##################################################
 
 cscript dm401.vbs "WScript.Echo 'Hello ' & Now"
 Hello 28.08.2007 23:19:26

I have some sub challenges for you:

(1) By changing intLCount to bContinue I could simplify the
    logic in the nested "collect lines" loop. Can you eliminate
    bContinue?

(2) dm_4ever took pains to avoid global variables by structuring
    his script in a way I consider exemplary: He put all his code
    in Subs. By adding the Sub DisplayFooter() - just to emphasize
    that displaying a header, handling the interactive input, and
    displaying a footer are three sub problems/tasks of the
    embracing problem/task of the script as a whole - I caused a
    mess: a typical result of 'programming by copy, paste & edit'.
    The fact that the length (intSpacers) and the form (#) of the
    rulers must be the same in both Subs is ensured by accident only.
    Yes, I consider the programmer's memory, dilligence, and prudence
    as random factors (memory isn't called RAM for nothing). Can you
    come up with a nice way to carve those invariants in stone/code?

(3) For the .HTA aficionados: While asking for a .HTA implementation
    of "Interactive VBScript" may be a bit brazen, but just thinking
    about it will make a problem obvious that was often discussed
    on this forum: How do you handle code that (would like to) use
    WScript in an .HTA/.HTML script? Can you come up with an .HTA
    that contains something like the Sub handleCode()?

(4) Last but not least: Something for VBScript learners to sharpen
    their teeth on. How about a version of Sub DisplayHeader()
    and/or DisplayFooter() that outputs additional information
    about the language's/Host's/Operating System's version or a
    copyright in a pleasant layout? Something that could be reused
    in other command line (cscript) scripts?

Thanks for your interest & extra "Hut ab" (kudos) to dm_4ever!

ehvbs

RE: Weekly/Monthly Challenge? (dm_4ever)

Mon, 27 Aug 2007 17:45:52 GMT

Put this in bits and pieces while at work...works with multi-lines...you'll need to press "Enter" twice for your code to be evaluated. Used ehvbs method of handeling Chr(39) 'single quote'

 Option Explicit
 
 Main
 
 Sub Main()
     If InStr(1, WScript.FullName, "wscript", vbTextCompare) Then
         Dim objShell : Set objShell = CreateObject("WScript.Shell")
         objShell.Run "%comspec% /c cscript.exe " & WScript.ScriptFullName, 1, False
         WScript.Quit
     End If
     StartShell
 End Sub
 
 Sub StartShell
     DisplayHeader    
     Dim intLCount : intLCount = 0
     Dim strInputCode, strCode
     Do
         WScript.StdOut.Write ">>"
         Do Until intLCount = 1
             strInputCode = Replace(WScript.StdIn.ReadLine, "'", """")
             Select Case UCase(strInputCode)
                 Case "EXIT", "QUIT"        WScript.Quit
             End Select
             
             If strInputCode = "" Then
                 intLCount = intLCount + 1
             Else
                 intLCount = 0
             End If
             strCode = strCode & strInputCode & ":"
         Loop
         
         On Error Resume Next
         Execute strCode
         If Err.Number <> 0 Then
             WScript.StdOut.WriteLine "Error Number:       " & Err.Number
             WScript.StdOut.WriteLine "Error Description:  " & Err.Description
         End If
         On Error GoTo 0
         
         intLCount = 0
         strCode = ""
     Loop
 End Sub
 
 Sub DisplayHeader
     Dim intSpacers : intSpacers = 50
     WScript.StdOut.WriteLine String(intSpacers, "#")
     Dim strMsg : strMsg = "VBScript Shell v1.0"
     WScript.StdOut.WriteLine Space((intSpacers - Len(strMsg)) / 2) & strMsg
     strMsg = "Type 'Exit' or 'Quit' to exit"
     WScript.StdOut.WriteLine Space((intSpacers - Len(strMsg)) / 2) & "Type 'Exit' or 'Quit' to exit"
     WScript.StdOut.WriteLine String(intSpacers, "#")
 End Sub

Example output:

 C:\>cscript.exe C:\scripts\VBScript_CmdShell.vbs
 ##################################################
                 VBScript Shell v1.0
           Type 'Exit' or 'Quit' to exit
 ##################################################
 >>For i = 0 to 10
 wscript.echo i
 next
 
 0
 1
 2
 3
 4
 5
 6
 7
 8
 9
 10
 >>

RE: Weekly/Monthly Challenge? (ehvbs)

Mon, 27 Aug 2007 13:36:59 GMT

Hi DiGiTAL.SkReAM,

thanks for the quick way to skin the cat without WMI; now your script runs on my W2K
computer.

I think your argument "... you might as well open notepad and write a script. It'd be easier
and faster. " is valid. But I meant these challenges not so much as rivals to the "Post your
Script" forum, but as opportunities to ty out/discuss techniques and concepts. The first
versions of VBScript/WSH didn't give access to StdIn/StdOut, so there isn't much code
around that uses the command line interactively (.HTAs are more convient too). But if
you look at tools like mysql.exe, o/isql.exe, ... you might agree that a script that can
work on StdIn either interactively or via pipe/redirection could be attractive.

Regards

ehvbs