mbt masai
 
Welcome !
         

                                
After experiencing a lot of down time, We decided to move this site to CrystalTech.com. CrystalTech.com is powered by only the finest Windows servers providing the best performance, reliability, and value anywhere.

 Weekly/Monthly Challenge?

Change Page: < 1234 > | Showing page 2 of 4, messages 21 to 40 of 61
Author Message
ginolard

  • Total Posts : 1347
  • Scores: 23
  • Reward points : 0
  • Joined: 8/11/2005
  • Status: offline
RE: Weekly/Monthly Challenge? Tuesday, June 26, 2007 7:51 PM (permalink)
0
I deny everything. [sm=innocent.gif]
Author of ManagePC - http://managepc.net

#21
    DiGiTAL.SkReAM

    • Total Posts : 1259
    • Scores: 7
    • Reward points : 0
    • Joined: 9/7/2005
    • Location: Clearwater, FL, USA
    • Status: offline
    RE: Weekly/Monthly Challenge? Wednesday, June 27, 2007 1:16 AM (permalink)
    0
    You're just in denial.
    "Would you like to touch my monkey?" - Dieter (Mike Meyers)

    "It is better to die like a tiger, than to live like a pussy."
    -Master Wong, from Balls of Fury
    #22
      mcds99

      • Total Posts : 515
      • Scores: 4
      • Reward points : 0
      • Joined: 2/28/2006
      • Status: offline
      RE: Weekly/Monthly Challenge? Thursday, July 12, 2007 4:04 AM (permalink)
      0
      LOLROF! You went so far beyond me I just have to smile or cry, haven't figured out which ;-D


      ORIGINAL: ehvbs

      [shameless attempt to get some attention for this topic]

      This looks like becoming a yearly challenge!

      [no offense meant]
      Sam

      Keep it Simple Make it Fun KiSMiF
      #23
        ginolard

        • Total Posts : 1347
        • Scores: 23
        • Reward points : 0
        • Joined: 8/11/2005
        • Status: offline
        RE: Weekly/Monthly Challenge? Thursday, July 12, 2007 9:27 PM (permalink)
        0
        Hey, Digital Skream.  I've only noticed the irony of your sig.  Did you write it like that on purpose?
        Author of ManagePC - http://managepc.net

        #24
          TNO

          • Total Posts : 2091
          • Scores: 34
          • Reward points : 0
          • Joined: 12/18/2004
          • Location: Earth
          • Status: offline
          RE: Weekly/Monthly Challenge? Friday, July 13, 2007 11:01 PM (permalink)
          0
          I'm out of practice horribly (bad excuse), but here's my attempt, don't beat me too hard:
           
            
           Dim myArray
           myArray = Array( Array( 1, 2 ), Array( 3, 4 ) , New RegExp , "myString", True, 777, Now())
            
           'ewww.....Global Variable, please help
           Dim Array2
           Array2 = Array()
            
           Function JoinX(ByRef Array1,Sep)
            Dim JS
            Set JS = CreateObject("JS.Array")
            
            Dim i
            Dim j
            For Each i In Array1
            
             If IsArray(i) Then
              JoinX i,Sep
             Else 
              Select Case VarType(i)
               Case 0 JS.Push Array2,"[vbEmpty]"
               Case 1 JS.Push Array2, "[vbNull]"
               Case 2 JS.Push Array2, CStr(i)
               Case 3 JS.Push Array2, CStr(i)
               Case 4 JS.Push Array2, CStr(i)
               Case 5 JS.Push Array2, CStr(i)
               Case 6 JS.Push Array2, CStr(i)
               Case 7 JS.Push Array2, CStr(i)
               Case 8 JS.Push Array2, i
               Case 9 JS.Push Array2, "[vbObject]"
               Case 10 JS.Push Array2, "["&CStr(i)&"]"
               Case 11 JS.Push Array2, CStr(i)
               Case 12 JS.Push Array2, "[vbVariant]"
               Case 13 JS.Push Array2, "[vbDataObject]"
               Case 17 JS.Push Array2, CStr(i)
              End Select
             End If
            Next
            
            JoinX = Join(Array2,Sep)
           End Function
            
           MsgBox JoinX(myArray,",")
           

           
          Using JS.Array Component: http://thenewobjective.com/website/development/VBScript/Components/vbsArrays
          To iterate is human, to recurse divine. -- L. Peter Deutsch
          #25
            DiGiTAL.SkReAM

            • Total Posts : 1259
            • Scores: 7
            • Reward points : 0
            • Joined: 9/7/2005
            • Location: Clearwater, FL, USA
            • Status: offline
            RE: Weekly/Monthly Challenge? Monday, July 16, 2007 12:38 AM (permalink)
            0

            ORIGINAL: ginolard

            Hey, Digital Skream.  I've only noticed the irony of your sig.  Did you write it like that on purpose?

            Yes, I did.
            "Would you like to touch my monkey?" - Dieter (Mike Meyers)

            "It is better to die like a tiger, than to live like a pussy."
            -Master Wong, from Balls of Fury
            #26
              ehvbs

              • Total Posts : 3312
              • Scores: 110
              • Reward points : 0
              • Joined: 6/22/2005
              • Location: Germany
              • Status: offline
              RE: Weekly/Monthly Challenge? Thursday, July 19, 2007 12:05 PM (permalink)
              0
              Hi all virtual and real participants,

              to give TNO's contribution its due and (perhaps) to lure some other people to
              this topic, I want to show you the script I currently use to tinker with the
              problem.

              To explain the structure of my test scripts and the reasons for it, I'd like
              to point you to the very simple program I posted for the second challenge.
              Comparing this to the more elaborate version may help you to make sense of
              my remarks.

              As I very/too often said, I start all my scripts with

                  Option Explicit

              to avoid problems due to misspelled variable names; furthermore Dimming
              my variables forces me to think about them very carefully. Do I really need
              it? Could I avoid a variable by using an expression or a function? In which
              scope the variable must be known? Some people like to Dim all their variables
              at once and initialize them later/as needed:

                  Dim oFSO, i, iIterations, x, t1, t2, t3, e1, e2, e3, iNumItems
                  Set oFSO = CreateObject("Scripting.FileSystemObject")
                  ...
                  iIterations = 3

              I prefer to keep Dimming (=Declaring) and intializing close together, because
              this may serve as a kind of documentation for the variable(s):

                  Dim oFSO : Set oFSO = CreateObject("Scripting.FileSystemObject")
                  ...
                  Dim iIterations : iIterations = 3

              As close as possible to its first use I associate the variable name with its
              data type and its (first/start) value, hoping to make it easy for my feeble
              memory. Do you want to comment on

                  Dim i, j

              , TNO?

              While I'm aware of the problems caused by global variables, I will use
              them, if I think it advantageous. To make them stand out, I use a "g"
              prefix in their names:

                  Dim goTNOArray2 ' needed for TNOJoin()

              For two reasons, I restrict my main/top level code to the Dimming of global
              variables and the returning of an error/success code to the operating system:

                  WScript.Quit doMain()

              The first reason: That way I can easily run different portions of code - tackling
              various sub problems or trying out different soultions - from the same .vbs file
              by writing more than one 'main' function and using reordering or commenting to
              switch between them:

                  WScript.Quit doThis()  | WScript.Quit doThat() | ' WScript.Quit doThis()
                  WScript.Quit doThat()  | WScript.Quit doThis() |   WScript.Quit doThat()

              The second reason: That way I can't introduce global variables 'by accident'.
              If I had Dimmed sSep at the top level, then using it in the toDispString( vX )
              function would be very tempting

                  Case 8204           '      Array of Variants
                    sRVal = "[" + OURJoin( vX, "," ) + "]"
                ==>
                    sRVal = "[" + OURJoin( vX, sSep ) + "]"

              As it is, I can't use this easy way out, but have to acknowledge the pending
              problem: Is it ok to hard code the inner separator or must I feed it to the
              function via parameter? Do I really want to implement a toDispString( vX, sSep )
              or even a toDispString( vX, aSeps ) function to handle (deeply) nested arrays?

              So a typical main function looks like this:

                  Function doMain()
                    Dim nRval  : nRVal = 0
                    ...
                    WScript.Echo "##### VBScript Forum Challenge 001: JoinX"
                    ...
                    doMain = nRVal
                  End Function

              The return/error code feature isn't used in most of my test scripts, but it
              proved valuable for 'real world' scripts that are scheduled or used from other
              programs.

              Testing/trying out means testing/trying more than one thing. So most test
              scripts use a simple

                    ' the strings we want to test
                    Dim aTStrs : aTStrs = Array( _
                        "" _
                      , "a b c" _
                                               )

              or a more complicated/structured array of data

                    ' the arrays we want to test (each one named for easy reference)
                    Dim aTArrs : aTArrs = Array( _
                        "empty"       , Array() _
                      , "one string"  , Array( "a" ) _
                     ...
                      , "objects"     , Array( New RegExp, CreateObject( "ADODB.Connection" ), oObj, Err ) _
                                               )

              to be fed to the code/functions. This setup and the effort put into the formatting
              makes it easy to add interesting/critical test cases. Of course the structure of
              the data is reflected in the code to loop over them. For simple arrays simple loops:

                    ' loop over all strings to test
                    For Each sTest In aTStrs
                        ...
                    Next

              for implicitly structured arrays, the Step feature of the For loop comes handy:

                    ' loop over all arrays to test
                    For nTArr = 0 To UBound( aTArrs ) Step 2
                        ...
                        WScript.Echo "=====", nTArr / 2, "Array:", aTArrs( nTArr ) ' <-- the name
                        ...
                            sRes     = fncJ( aTArrs( nTArr + 1 ), sSep ) ' <-- the array to feed to the function
                        ...
                    Next

              Explicitly structured arrays

                    ' the different versions of JoinX( aX, sSep )
                    Dim aFuncs : aFuncs = Array( _
                        Array( "VBS Join", GetRef( "VBSJoin" ), "|" ) _
                      , Array( "TNO Join", GetRef( "TNOJoin" ), "|" ) _
                      , Array( "Our Join", GetRef( "OurJoin" ), "|" ) _
                                               )

              can be looped over by For (+ index):

                    ' loop over all functions to use
                    For nFunc = 0 To UBound( aFuncs )
                        WScript.Echo "-----", nFunc, "Function:", aFuncs( nFunc )( 0 )
                        Set fncJ = aFuncs( nFunc )( 1 ) ' the function used
                        sSep     = aFuncs( nFunc )( 2 ) ' the separator used for display
                        sRes     = fncJ( aTArrs( nTArr + 1 ), sSep ) ' call the function
                        WScript.Echo ">|" + sRes + "|<"
                    Next

              or by For Each:

                    Dim aFunc
                    For Each aFunc In aFuncs
                        WScript.Echo "----- Function:", aFunc( 0 )
                        Set fncJ = aFunc( 1 ) ' the function used
                        sSep     = aFunc( 2 ) ' the separator used for display
                        sRes     = fncJ( aTArrs( nTArr + 1 ), sSep ) ' call the function
                        WScript.Echo ">|" + sRes + "|<"
                    Next

              If you don't need a numeric index variable, For Each is more convenient; but
              changing elements needs For, because the For Each variable is a copy. Run

                      Function ForForEach()
                        Dim aTest : aTest = Array( "zero", "one", "two" )
                        Dim nIdx  : nIdx  = 0
                        Dim sTest
                        For Each sTest In aTest
                            sTest = CStr( nIdx )
                            nIdx  = nIdx + 1
                        Next
                        WScript.Echo "For Each", Join( aTest )
                        For nIdx = 0 To UBound( aTest )
                            aTest( nIdx ) = CStr( nIdx )
                        Next
                        WScript.Echo "For     ", Join( aTest )
                        ForForEach = 0
                      End Function

              to see the difference.

                      For Each zero one two
                      For      0 1 2

              The script demonstrates 3 Join functions: The VBScript Join() that fails
              even for simple cases:

                      ===== 2 Array: the empties
                      ----- Function: VBS Join
                      >|Typen unverträglich|<    i.e. Type mismatched caused by Null
                      ----- Function: TNO Join
                      >|[vbEmpty]|[vbNull]|[vbObject]|<
                      ----- Function: Our Join
                      >|<Empty>|<Null>|<Nothing>|<

              I don't want to spend further words on this miserable thing. The second
              functions is (my revision of) TNO's Join() function, that really is an
              significant improvement. The nits I feel the need to pick don't lower
              its value - that goes without saying.

              No surprise, that I don't like the use of the global variable (though - as
              I said before - I use them myself if they are proved necessary). How could
              goTNOArray2 be avoided? By passing the second array as an parameter:

                (1) add an element to aFuncs

                    Dim aFuncs : aFuncs = Array( _
                        Array( "VBS Join", GetRef( "VBSJoin" )    , "|" ) _
                      , Array( "TNO Join", GetRef( "TNOJoin" )    , "|" ) _
                      , Array( "TNO NOGV", GetRef( "TNOJoinNOGV" ), "|" ) _
                      , Array( "Our Join", GetRef( "OurJoin" )    , "|" ) _

                (2) add a nonrecursive 'entry' function:

                      ''# TNOJoinNOGV - calls TNO's Join (no global variable)
                      ' ############################################################################
                      Function TNOJoinNOGV( ByRef Array1, Sep )
                        TNOJoinNOGV = TNOJoinNOGV_( Array1, Array(), Sep )
                      End Function

                (3) that passes the second array to the recursive work function:

                      Function TNOJoinNOGV_( Array1, Array2, Sep )
                        Dim JS : Set JS = CreateObject( "JS.Array" )
                        Dim i, j

                        For Each i In Array1
                            If IsArray(i) Then
                               TNOJoinNOGV_ i, Array2, Sep
                            Else
                               Select Case VarType(i)
                                 Case  0 JS.Push Array2, "[vbEmpty]"
                                 Case  1 JS.Push Array2, "[vbNull]"
                                 ...
                                 Case 13 JS.Push Array2, "[vbDataObject]"
                                 Case 17 JS.Push Array2, CStr(i)
                               End Select
                            End If
                        Next

                        TNOJoinNOGV_ = Join( Array2, Sep )
                      End Function

              Compare this to OURJoin

                  ''# OURJoin - crossbred of contributions
                  ' ############################################################################
                  Function OURJoin( aX, sSep )
                    ReDim aClone( UBound( aX ) )
                    Dim   nIdx : nIdx = 0
                    Dim   vElm
                    For Each vElm In aX
                        aClone( nIdx ) = toDispString( vElm )
                        nIdx           = nIdx + 1
                    Next
                    OURJoin = Join( aClone, sSep )
                  End Function

              that uses a second array too - but one that is dimensioned suitably right from
              the start (no need for growing/push) and keeps it local (no parameter passing
              to the recursive work function toDispString()).

              My verdict on the reliance on the JS.Array component is the same as what I said
              about ginolard's use of the .NET System.Collections.ArrayList. Non native VBScript
              means are ok if unavoidable, but I'd prefer a 'pure' solution. In TNO's case
              the foreign component is used only to make the dynamic growing of the second array
              more efficient. But that isn't necessary: We know the UBound of the second array
              beforehand - we nead exactly as many elements as the first one contains:

                  ''# TNOJoinNOJS - calls TNO's Join (no JS.Array)
                  ' ############################################################################
                  Function TNOJoinNOJS( ByRef Array1, Sep )
                    ReDim Array2( UBound( Array1 ) )
                    TNOJoinNOJS = TNOJoinNOJS_( Array1, Array2, Sep )
                  End Function

                  Function TNOJoinNOJS_( Array1, Array2, Sep )
                    Dim JS   : Set JS = CreateObject( "JS.Array" )
                    Dim nIdx : nIdx   = 0
                    Dim vElm

                    For Each vElm In Array1
                        If IsArray( vElm ) Then
                           Array2( nIdx ) = TNOJoinNOJS( vElm, Sep )
                        Else
                           Select Case VarType( vElm )
                             Case  0 Array2( nIdx ) = "[vbEmpty]"
                             Case  1 Array2( nIdx ) = "[vbNull]"
                             Case  2 Array2( nIdx ) = CStr( vElm )
                             Case  3 Array2( nIdx ) = CStr( vElm )
                             Case  4 Array2( nIdx ) = CStr( vElm )
                             Case  5 Array2( nIdx ) = CStr( vElm )
                             Case  6 Array2( nIdx ) = CStr( vElm )
                             Case  7 Array2( nIdx ) = CStr( vElm )
                             Case  8 Array2( nIdx ) = vElm
                             Case  9 Array2( nIdx ) = "[vbObject]"
                             Case 10 Array2( nIdx ) = "["&CStr( vElm )&"]"
                             Case 11 Array2( nIdx ) = CStr( vElm )
                             Case 12 Array2( nIdx ) = "[vbVariant]"
                             Case 13 Array2( nIdx ) = "[vbDataObject]"
                             Case 17 Array2( nIdx ) = CStr( vElm )
                           End Select
                        End If
                        nIdx = nIdx + 1
                    Next

                    TNOJoinNOJS_ = Join( Array2, Sep )
                  End Function

              I'm not happy with the use of magic numbers instead of the predefined VBScript
              constants:

                  Case vbEmpty        '    0 Uninitialized (default)
                    sRVal = "<Empty>"

              may be more characters to enter than

                  Case  0 Array2( nIdx ) = "[vbEmpty]"

              but you write a script once (or - if you are like me - about 12 times),
              but you resp. your clients read it 4711 times. Think of all the time wasted
              to remember/check that VarType 0 means Empty (and not Null).

              As most of the solutions presented here, TNO's function flattens arrays of
              arrays:

                  "nested arrs" , Array( Array( 1, 2, 3 ), Array( "one", "two", "three" ) ) _

                  ===== 3 Array: nested arrs
                  ----- Function: VBS Join
                  >|Typen unverträglich|<
                  ----- Function: TNO Join
                  >|1|2|3|one|two|three|<
                  ----- Function: TNO NOGV
                  >|1|2|3|one|two|three|<
                  ----- Function: TNO NOJS
                  >|1|2|3|one|two|three|<
                  ----- Function: Our Join
                  >|[1,2,3]|["one","two","three"]|<

              So perhaps this should be considered a feature.

              All my usual carping must not hide the fact that the third function -
              OURJoin() - wouldn't exist without all your contributions to this topic.
              It's much easier to program on the base of concrete working code than
              doing it from scratch. All fame and glory is due to the participants;
              extra thanks to TNO for his code (and the JS.Array which downloaded,
              installed and worked flawlessly for me). I just crossbred all the
              suggestions with some of my own thoughts. For example my very first
              version of the JoinX() function used string concatenation, DiGiTAL.SkReAM's
              dictionary approach and dm_4ever's use of Split and ReDim made me realize
              the (irony of the) possibility to let VBScript's Join() do the concatenation.
              Likewise there would be no dictionary joining without ebgreen. And I'm still
              waiting for ginolard to come up with some String.Join( ArrayList, "," ) magic
              to make OURJoined effort obsolete.

              I think that splitting the joining into a 'put together' loop (see above)
              and a 'handle each element according to its data type' part (see below)
              makes the code easy to understand. mcds99, don't cry! You would make me
              happy/smile, if you could post some questions as to the what, how, and why
              of the code that forces me to make the code better (to comprehend). There
              are some points worth discussing in the monster Select Case. Should the
              (german) "," really replaced with "." in real numbers? Would it be
              necessary to check the locale? Should dates be delimited? Should strings be
              not delimited? How to discriminate between a plain date and the datetime
              midnight?

              Ok, it's after midnight in Germany - here is all the code:

               ''# xjoinx.vbs : VBScript Forum Challenge 001: A better Join()
               ''# usage: cscript xjoinx.vbs
               ' ############################################################################
               
               Option Explicit
               
               ''# global vars
               ' ############################################################################
               
               Dim goTNOArray2 ' needed for TNOJoin()
               
               ''# main -
               ' ############################################################################
               
               WScript.Quit doMain()
               
               Function doMain()
                 Dim nRval  : nRVal = 0
               
                 WScript.Echo "##### VBScript Forum Challenge 001: JoinX"
               
                 Dim oObj : Set oObj = CreateObject( "Scripting.FileSystemObject" )
               
                 ' the arrays we want to test (each one named for easy reference)
                 Dim aTArrs : aTArrs = Array( _
                     "empty"       , Array() _
                   , "one string"  , Array( "a" ) _
                   , "the empties" , Array( Empty, Null, Nothing ) _
                   , "nested arrs" , Array( Array( 1, 2, 3 ), Array( "one", "two", "three" ) ) _
                   , "booleans"    , Array( True, False ) _
                   , "numbers"     , Array( 0, 0.0, -1, 4711, 123.456 ) _
                   , "date/time"   , Array( Now, CDate( "20.07.2007 00:00:00" ), Date ) _
                   , "dictionary"  , Array( getSomeDictionary(), getSomeDictionary().Keys ) _
                   , "objects"     , Array( New RegExp, CreateObject( "ADODB.Connection" ), oObj, Err ) _
                                            )
                 ' the different versions of JoinX( aX, sSep )
                 Dim aFuncs : aFuncs = Array( _
                     Array( "VBS Join", GetRef( "VBSJoin" )    , "|" ) _
                   , Array( "TNO Join", GetRef( "TNOJoin" )    , "|" ) _
                   , Array( "TNO NOGV", GetRef( "TNOJoinNOGV" ), "|" ) _
                   , Array( "TNO NOJS", GetRef( "TNOJoinNOJS" ), "|" ) _
                   , Array( "Our Join", GetRef( "OurJoin" )    , "|" ) _
                                            )
                 Dim nTArr, fncJ, sSep, nFunc, sRes
               
                 ' loop over all arrays to test
                 For nTArr = 0 To UBound( aTArrs ) Step 2
                     WScript.Echo
                     WScript.Echo "=====", nTArr / 2, "Array:", aTArrs( nTArr )
               
                     ' loop over all functions to use
               If False Then
                     For nFunc = 0 To UBound( aFuncs )
                         WScript.Echo "-----", nFunc, "Function:", aFuncs( nFunc )( 0 )
                         Set fncJ = aFuncs( nFunc )( 1 ) ' the function used
                         sSep     = aFuncs( nFunc )( 2 ) ' the separator used for display
                         sRes     = fncJ( aTArrs( nTArr + 1 ), sSep ) ' call the function
                         WScript.Echo ">|" + sRes + "|<"
                     Next
               Else
                     Dim aFunc
                     For Each aFunc In aFuncs
                         WScript.Echo "----- Function:", aFunc( 0 )
                         Set fncJ = aFunc( 1 ) ' the function used
                         sSep     = aFunc( 2 ) ' the separator used for display
                         sRes     = fncJ( aTArrs( nTArr + 1 ), sSep ) ' call the function
                         WScript.Echo ">|" + sRes + "|<"
                     Next
               End If
                 Next
                 WScript.Echo
                 WScript.Echo "##### Done."
                 doMain = nRVal
               End Function
               
               ''# getSomeDictionary - convenience function to get a dictionary
               ' ############################################################################
               Function getSomeDictionary()
                Dim dicRVal : Set dicRVal = CreateObject( "Scripting.Dictionary" )
                dicRVal( "one" ) = 1
                dicRVal( "two" ) = Array( "zwei", "dos" )
                Set getSomeDictionary = dicRVal
               End Function
               
               
               ''# VBSJoin - calls VBScript's Join (needed for GetRef())
               ' ############################################################################
               Function VBSJoin( aX, sSep )
                 Dim sRVal
               On Error Resume Next
                 sRVal = Join( aX, sSep )
                 If 0 <> Err.Number Then sRVal = Err.Description
               On Error GoTo 0
                 VBSJoin = sRVal
               End Function
               
               ''# TNOJoin - calls TNO's Join (needed because of global variable)
               ' ############################################################################
               Function TNOJoin( ByRef Array1, Sep )
                 goTNOArray2 = Array() ' needed for TNOJoin
                 TNOJoin = TNOJoin_( Array1, Sep )
               End Function
               
               Function TNOJoin_( ByRef Array1, Sep )
                 Dim JS : Set JS = CreateObject( "JS.Array" )
                 Dim i, j
               
                 For Each i In Array1
                     If IsArray(i) Then
                        TNOJoin_ i, Sep
                     Else
                        Select Case VarType(i)
                          Case  0 JS.Push goTNOArray2, "[vbEmpty]"
                          Case  1 JS.Push goTNOArray2, "[vbNull]"
                          Case  2 JS.Push goTNOArray2, CStr(i)
                          Case  3 JS.Push goTNOArray2, CStr(i)
                          Case  4 JS.Push goTNOArray2, CStr(i)
                          Case  5 JS.Push goTNOArray2, CStr(i)
                          Case  6 JS.Push goTNOArray2, CStr(i)
                          Case  7 JS.Push goTNOArray2, CStr(i)
                          Case  8 JS.Push goTNOArray2, i
                          Case  9 JS.Push goTNOArray2, "[vbObject]"
                          Case 10 JS.Push goTNOArray2, "["&CStr(i)&"]"
                          Case 11 JS.Push goTNOArray2, CStr(i)
                          Case 12 JS.Push goTNOArray2, "[vbVariant]"
                          Case 13 JS.Push goTNOArray2, "[vbDataObject]"
                          Case 17 JS.Push goTNOArray2, CStr(i)
                        End Select
                     End If
                 Next
               
                 TNOJoin_ = Join( goTNOArray2, Sep )
               End Function
               
               ''# OURJoin - crossbred of contributions
               ' ############################################################################
               Function OURJoin( aX, sSep )
                 ReDim aClone( UBound( aX ) )
                 Dim   nIdx : nIdx = 0
                 Dim   vElm
                 For Each vElm In aX
                     aClone( nIdx ) = toDispString( vElm )
                     nIdx           = nIdx + 1
                 Next
                 OURJoin = Join( aClone, sSep )
               End Function
               
               ''# toDispString - what CStr() should do
               ' ############################################################################
               Function toDispString( vX )
                 Dim sRVal : sRVal = "*** toDispString() failed miserably ***"
                 Select Case VarType( vX )
                   Case vbEmpty        '    0 Uninitialized (default)
                     sRVal = "<Empty>"
                   Case vbNull         '    1 Contains no valid data
                     sRVal = "<Null>"
                   Case vbInteger      '    2 Integer subtype
                     sRVal = CStr( vX )
                   Case vbLong         '    3 Long subtype
                     sRVal = CStr( vX )
                   Case vbSingle       '    4 Single subtype
                     sRVal = CStr( vX )
                     sRVal = Replace( sRVal, ",", "." ) ' germanism
                   Case vbDouble       '    5 Double subtype
                     sRVal = CStr( vX )
                     sRVal = Replace( sRVal, ",", "." ) ' germanism
                   Case vbCurrency     '    6 Currency subtype
                     sRVal = CStr( vX )
                     sRVal = Replace( sRVal, ",", "." ) ' germanism
                   Case vbDate         '    7 Date subtype
                     sRVal = CStr( vX )
                   Case vbString       '    8 String subtype
                     sRVal = """" + vX + """"
                   Case vbObject       '    9 Object
                     If vX Is Nothing Then
                        sRVal = "<Nothing>"
                     Else
                        sRVal = TypeName( vX )
                        Select Case sRVal
                          Case "Dictionary"
                            Dim vKey
                            sRVal = ""
                            For Each vKey In vX.Keys
                                sRVal = sRVal + "," + toDispString( vKey ) + "=>" + toDispString( vX( vKey ) )
                            Next
                            sRVal = "{" + Mid( sRVal, 2 ) + "}"
                          Case Else
                            sRVal = sRVal + "-Obj"
                        End Select
                     End If
                   Case vbError        '   10 Error subtype
                   Case vbBoolean      '   11 Boolean subtype
                     sRVal = CStr( vX )
                   Case vbVariant      '   12 Variant (used only for arrays of variants)
                   Case vbDataObject   '   13 Data access object
                   Case vbDecimal      '   14 Decimal subtype
                   Case vbByte         '   17 Byte subtype
                   Case vbArray        ' 8192 Array
                   Case 8204           '      Array of Variants
                     sRVal = "[" + OURJoin( vX, "," ) + "]"
                 End Select
                 toDispString = sRVal
               End Function
               
               ''# TNOJoinNOGV - calls TNO's Join (no global variable)
               ' ############################################################################
               Function TNOJoinNOGV( ByRef Array1, Sep )
                 TNOJoinNOGV = TNOJoinNOGV_( Array1, Array(), Sep )
               End Function
               
               Function TNOJoinNOGV_( Array1, Array2, Sep )
                 Dim JS : Set JS = CreateObject( "JS.Array" )
                 Dim i, j
               
                 For Each i In Array1
                     If IsArray(i) Then
                        TNOJoinNOGV_ i, Array2, Sep
                     Else
                        Select Case VarType(i)
                          Case  0 JS.Push Array2, "[vbEmpty]"
                          Case  1 JS.Push Array2, "[vbNull]"
                          Case  2 JS.Push Array2, CStr(i)
                          Case  3 JS.Push Array2, CStr(i)
                          Case  4 JS.Push Array2, CStr(i)
                          Case  5 JS.Push Array2, CStr(i)
                          Case  6 JS.Push Array2, CStr(i)
                          Case  7 JS.Push Array2, CStr(i)
                          Case  8 JS.Push Array2, i
                          Case  9 JS.Push Array2, "[vbObject]"
                          Case 10 JS.Push Array2, "["&CStr(i)&"]"
                          Case 11 JS.Push Array2, CStr(i)
                          Case 12 JS.Push Array2, "[vbVariant]"
                          Case 13 JS.Push Array2, "[vbDataObject]"
                          Case 17 JS.Push Array2, CStr(i)
                        End Select
                     End If
                 Next
               
                 TNOJoinNOGV_ = Join( Array2, Sep )
               End Function
               
               ''# TNOJoinNOJS - calls TNO's Join (no JS.Array)
               ' ############################################################################
               Function TNOJoinNOJS( ByRef Array1, Sep )
                 ReDim Array2( UBound( Array1 ) )
                 TNOJoinNOJS = TNOJoinNOJS_( Array1, Array2, Sep )
               End Function
               
               Function TNOJoinNOJS_( Array1, Array2, Sep )
                 Dim JS   : Set JS = CreateObject( "JS.Array" )
                 Dim nIdx : nIdx   = 0
                 Dim vElm
               
                 For Each vElm In Array1
                     If IsArray( vElm ) Then
                        Array2( nIdx ) = TNOJoinNOJS( vElm, Sep )
                     Else
                        Select Case VarType( vElm )
                          Case  0 Array2( nIdx ) = "[vbEmpty]"
                          Case  1 Array2( nIdx ) = "[vbNull]"
                          Case  2 Array2( nIdx ) = CStr( vElm )
                          Case  3 Array2( nIdx ) = CStr( vElm )
                          Case  4 Array2( nIdx ) = CStr( vElm )
                          Case  5 Array2( nIdx ) = CStr( vElm )
                          Case  6 Array2( nIdx ) = CStr( vElm )
                          Case  7 Array2( nIdx ) = CStr( vElm )
                          Case  8 Array2( nIdx ) = vElm
                          Case  9 Array2( nIdx ) = "[vbObject]"
                          Case 10 Array2( nIdx ) = "["&CStr( vElm )&"]"
                          Case 11 Array2( nIdx ) = CStr( vElm )
                          Case 12 Array2( nIdx ) = "[vbVariant]"
                          Case 13 Array2( nIdx ) = "[vbDataObject]"
                          Case 17 Array2( nIdx ) = CStr( vElm )
                        End Select
                     End If
                     nIdx = nIdx + 1
                 Next
               
                 TNOJoinNOJS_ = Join( Array2, Sep )
               End Function
               


              And the output

               cscript xjoinx.vbs
               ##### VBScript Forum Challenge 001: JoinX
               
               ===== 0 Array: empty
               ----- Function: VBS Join
               >||<
               ----- Function: TNO Join
               >||<
               ----- Function: TNO NOGV
               >||<
               ----- Function: TNO NOJS
               >||<
               ----- Function: Our Join
               >||<
               
               ===== 1 Array: one string
               ----- Function: VBS Join
               >|a|<
               ----- Function: TNO Join
               >|a|<
               ----- Function: TNO NOGV
               >|a|<
               ----- Function: TNO NOJS
               >|a|<
               ----- Function: Our Join
               >|"a"|<
               
               ===== 2 Array: the empties
               ----- Function: VBS Join
               >|Typen unverträglich|<
               ----- Function: TNO Join
               >|[vbEmpty]|[vbNull]|[vbObject]|<
               ----- Function: TNO NOGV
               >|[vbEmpty]|[vbNull]|[vbObject]|<
               ----- Function: TNO NOJS
               >|[vbEmpty]|[vbNull]|[vbObject]|<
               ----- Function: Our Join
               >|<Empty>|<Null>|<Nothing>|<
               
               ===== 3 Array: nested arrs
               ----- Function: VBS Join
               >|Typen unverträglich|<
               ----- Function: TNO Join
               >|1|2|3|one|two|three|<
               ----- Function: TNO NOGV
               >|1|2|3|one|two|three|<
               ----- Function: TNO NOJS
               >|1|2|3|one|two|three|<
               ----- Function: Our Join
               >|[1,2,3]|["one","two","three"]|<
               
               ===== 4 Array: booleans
               ----- Function: VBS Join
               >|Wahr|Falsch|<
               ----- Function: TNO Join
               >|Wahr|Falsch|<
               ----- Function: TNO NOGV
               >|Wahr|Falsch|<
               ----- Function: TNO NOJS
               >|Wahr|Falsch|<
               ----- Function: Our Join
               >|Wahr|Falsch|<
               
               ===== 5 Array: numbers
               ----- Function: VBS Join
               >|0|0|-1|4711|123,456|<
               ----- Function: TNO Join
               >|0|0|-1|4711|123,456|<
               ----- Function: TNO NOGV
               >|0|0|-1|4711|123,456|<
               ----- Function: TNO NOJS
               >|0|0|-1|4711|123,456|<
               ----- Function: Our Join
               >|0|0|-1|4711|123.456|<
               
               ===== 6 Array: date/time
               ----- Function: VBS Join
               >|20.07.2007 01:59:19|20.07.2007|20.07.2007|<
               ----- Function: TNO Join
               >|20.07.2007 01:59:19|20.07.2007|20.07.2007|<
               ----- Function: TNO NOGV
               >|20.07.2007 01:59:19|20.07.2007|20.07.2007|<
               ----- Function: TNO NOJS
               >|20.07.2007 01:59:19|20.07.2007|20.07.2007|<
               ----- Function: Our Join
               >|20.07.2007 01:59:19|20.07.2007|20.07.2007|<
               
               ===== 7 Array: dictionary
               ----- Function: VBS Join
               >|Falsche Anzahl an Argumenten oder ungültige Eigenschaftszuweisung|<
               ----- Function: TNO Join
               >|[vbObject]|one|two|<
               ----- Function: TNO NOGV
               >|[vbObject]|one|two|<
               ----- Function: TNO NOJS
               >|[vbObject]|one|two|<
               ----- Function: Our Join
               >|{"one"=>1,"two"=>["zwei","dos"]}|["one","two"]|<
               
               ===== 8 Array: objects
               ----- Function: VBS Join
               >|Das Objekt unterstützt diese Eigenschaft oder Methode nicht.|<
               ----- Function: TNO Join
               >|[vbObject]||[vbObject]|0|<
               ----- Function: TNO NOGV
               >|[vbObject]||[vbObject]|0|<
               ----- Function: TNO NOJS
               >|[vbObject]||[vbObject]|0|<
               ----- Function: Our Join
               >|RegExp-Obj|""|FileSystemObject-Obj|0|<
               
               ##### Done.
               


              What still needs to be done:

              (1) All Join functions strive to display the elements of the array; I would
                  like to have a second version (JoinY (?)) that returns a string that
                  could be fed to Eval() - as a kind of (simple) persistency feature.
                  [I was not amused when ebgreen hijacked the persistency problem in
                      http://www.visualbasicscript.com/fb.aspx?m=49431
                   and even mentioned XML - I had to revise my second challenge (see
                   below)]

              (2) Some objects - with default properties - are difficult/impossible
                  to display:

                      "objects"     , Array( New RegExp, CreateObject( "ADODB.Connection" ), oObj, Err )

                      ===== 7 Array: objects
                      ----- 0 Function: VBS Join
                      >|Das Objekt unterstützt diese Eigenschaft oder Methode nicht.|<
                      ----- 1 Function: TNO Join
                      >|[vbObject]||[vbObject]|0|<
                      ----- 2 Function: Our Join
                      >|RegExp-Obj|""|FileSystemObject-Obj|0|<

                  Just now I can't even think of a way to identify these nasty cases.

              (3) How about arrays of more than one dimension?

              But perhaps you feel bored by this challenge or think the problem isn't worth
              further discussion. In that case look at my next posting!

              Thanks again for all the input - and my apologies for the number of lines!

              ehvbs

              #27
                ehvbs

                • Total Posts : 3312
                • Scores: 110
                • Reward points : 0
                • Joined: 6/22/2005
                • Location: Germany
                • Status: offline
                RE: Weekly/Monthly Challenge? Thursday, July 19, 2007 12:06 PM (permalink)
                0
                Hi all who would like another challenge!

                The VBScript Split() function is nice. Lots of sample of its creative
                use in this forum. But other languages - notably Perl - provide an even
                nicer split(): one that allows a regular expression to be used instead of
                a mere string.

                The easy version of the challenge: Write a

                  Split( expression, regexp|regexp.pattern )

                function that uses a regexp(.pattern) - e.g. "[,;:]" - to split a
                string - e.g "a,b;c:d" - into an array ["a","b","c","d"]. To motivate
                you: Think of something like:

                   aParts = SplitRE( "19.07.2007 22:01:03", "[. :]" )

                The more complex task: Write a

                  Split(expression[, regexp|regexp.pattern[, count[, compare]]])

                function that mimics the VBScript Split() regarding the fancy options.

                For even more ambitious persons: try to implement some of the Perl
                features like splitting a string into an array of its characters or
                the option to return the separators as well.

                Not to predetermine your approach, but simply to give you an idea
                of how to start: this is my test script that eagerly waits for your
                ideas/code/input:

                 ''# splitre00.vbs : VBScript Forum Challenge 002: A better Split()
                 ''# usage: cscript splitre00.vbs
                 ' ############################################################################
                 
                 Option Explicit
                 
                 ''# global vars
                 ' ############################################################################
                 
                 ''# main -
                 ' ############################################################################
                 
                 WScript.Quit doMain()
                 
                 Function doMain()
                   Dim nRval  : nRVal = 0
                 
                   WScript.Echo "##### VBScript Forum Challenge 002: SplitRE"
                 
                   ' the strings we want to test
                   Dim aTStrs : aTStrs = Array( _
                       "" _
                     , "a b c" _
                                              )
                   Dim sTest, aRes
                 
                   ' loop over all strings to test
                   For Each sTest In aTStrs
                       WScript.Echo
                       WScript.Echo "=====|" + sTest + "|"
                 
                 '     WScript.Echo "Split:   [" + OURJoin( Split(   sTest, " " ), "|" ) + "]"
                       WScript.Echo "Split:   [" +    Join( Split(   sTest, " " ), "|" ) + "]"
                       WScript.Echo "SplitRE: [" +    Join( SplitRE( sTest, " " ), "|" ) + "]"
                 
                   Next
                   WScript.Echo
                   WScript.Echo "##### Done."
                   doMain = nRVal
                 End Function
                 
                 ''# SplitRE - splits sStr using ...
                 ' ############################################################################
                 Function SplitRE( sStr, vX )
                   SplitRE = Array( "still a pipe dream" )
                 End Function
                 


                As you can see, I included (commented out) a call to OURJoin() as an advertisement
                for the first challenge.

                ehvbs

                #28
                  dm_4ever

                  • Total Posts : 3673
                  • Scores: 82
                  • Reward points : 0
                  • Joined: 6/29/2006
                  • Location: Orange County, California
                  • Status: offline
                  RE: Weekly/Monthly Challenge? Thursday, July 19, 2007 1:39 PM (permalink)
                  0
                  I'll take a shot when I get the chance...man...your thought process...it is something else.
                  dm_4ever

                  My philosophy: K.I.S.S - Keep It Simple Stupid
                  Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
                  Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
                  #29
                    ginolard

                    • Total Posts : 1347
                    • Scores: 23
                    • Reward points : 0
                    • Joined: 8/11/2005
                    • Status: offline
                    RE: Weekly/Monthly Challenge? Thursday, July 19, 2007 8:13 PM (permalink)
                    0
                    Ooh, this one is more interesting.  Primarily because it helps me learn more about RegEx

                    Anyway, here's a first crack at the simple one.  

                     Option Explicit
                     
                     Dim TestString : TestString = "aaaaa,bvvv,c231,d;e;f;g,h,i"
                     Wscript.echo TestString & " has been split and rejoined to " &  RegExSplit(TestString,"[,;]",":")
                     
                     Function RegExSplit(StringToSearch,pattern,RejoinChar)
                         
                         Dim objRegExp,expressionmatch,expressionmatched
                         Dim objDict : Set objDict=CreateObject("Scripting.Dictionary")
                     
                         Set objRegExp = New RegExp
                         With objRegExp
                             .Pattern=pattern
                             .IgnoreCase=True
                             .Global=True
                         End With
                         Set expressionmatch = objRegExp.Execute(StringToSearch)
                         Dim FirstStringFound : FirstStringFound = False
                         Dim PreviousExpressionIndex 
                         
                         If expressionmatch.Count > 0 Then
                             For Each expressionmatched in expressionmatch
                                 If not FirstStringFound Then
                                     objDict.Add Left(StringToSearch,expressionmatched.FirstIndex),"foo"
                                     FirstStringFound = True
                                 Else
                                     objDict.Add Mid(StringToSearch,PreviousExpressionIndex + 2,(expressionmatched.FirstIndex - PreviousExpressionIndex)-1),"foo"
                                 End If
                                 PreviousExpressionIndex = expressionmatched.FirstIndex
                             Next
                             objDict.Add Mid(StringToSearch,PreviousExpressionIndex + 2),"foo"
                         End If
                         
                         RegExSplit = Join(objDict.Keys,RejoinChar)
                     
                     End Function
                     
                     

                    <message edited by ginolard on Thursday, July 19, 2007 8:50 PM>
                    Author of ManagePC - http://managepc.net

                    #30
                      ehvbs

                      • Total Posts : 3312
                      • Scores: 110
                      • Reward points : 0
                      • Joined: 6/22/2005
                      • Location: Germany
                      • Status: offline
                      RE: Weekly/Monthly Challenge? Thursday, July 19, 2007 10:11 PM (permalink)
                      0
                      Hi ginolard,

                      thanks a lot! Very promising approach and nice implementation! I incorporated your
                      function into my test script (I removed the joining part to keep the function compatible
                      to VBScript's Split()). Doing this, I had to realize that my simple plain array setup
                      for the test cases doesn't scale: the split pattern has to be specified too. My quick
                      and dirty revison

                       ''# splitre00.vbs : VBScript Forum Challenge 002: A better Split()
                       ''# usage: cscript splitre00.vbs
                       ' ############################################################################
                       
                       Option Explicit
                       
                       ''# global vars
                       ' ############################################################################
                       
                       ''# main -
                       ' ############################################################################
                       
                       WScript.Quit doMain()
                       
                       Function doMain()
                         Dim nRval  : nRVal = 0
                       
                         WScript.Echo "##### VBScript Forum Challenge 002: SplitRE"
                       
                         ' the strings we want to test
                         Dim aTStrs : aTStrs = Array( _
                             Array( "x"   , "" ) _
                           , Array( " "   , "a b c" ) _
                           , Array( "[,;]", "aaaaa,bvvv,c231,d;e;f;g,h,i" ) _
                           , Array( "::"  , "aaaaa::bvvv" ) _
                                                    )
                         Dim aTest, aRes
                       
                         ' loop over all strings to test
                         For Each aTest In aTStrs
                             WScript.Echo
                             WScript.Echo "=====|" + aTest( 1 ) + "|"
                       
                       '     WScript.Echo "Split:   [" + OURJoin( Split(     aTest( 1 ), aTest( 0 ) ), "|" ) + "]"
                             WScript.Echo "Split:   [" +    Join( Split(     aTest( 1 ), aTest( 0 ) ), "|" ) + "]"
                             WScript.Echo "SplitRE: [" +    Join( SplitRE(   aTest( 1 ), aTest( 0 ) ), "|" ) + "]"
                             WScript.Echo "gn00:    [" +    Join( SplitGN00( aTest( 1 ), aTest( 0 ) ), "|" ) + "]"
                       
                         Next
                         WScript.Echo
                         WScript.Echo "##### Done."
                         doMain = nRVal
                       End Function
                       
                       ''# SplitRE - splits sStr using ...
                       ' ############################################################################
                       Function SplitRE( sStr, vX )
                         SplitRE = Array( "still a pipe dream" )
                       End Function
                       
                       ''# SplitGN00 - http://www.visualbasicscript.com/fb.aspx?m=49723
                       ''#             ehvbs took out the rejoining part of ginolard's original function
                       ' ############################################################################
                       Function SplitGN00( StringToSearch, pattern )
                       
                          Dim objRegExp,expressionmatch,expressionmatched
                          Dim objDict : Set objDict=CreateObject("Scripting.Dictionary")
                       
                          Set objRegExp = New RegExp
                          With objRegExp
                              .Pattern=pattern
                              .IgnoreCase=True  ' should this passed as 3rd parameter? see VBScript' Split( .. compare )
                              .Global=True
                          End With
                          Set expressionmatch = objRegExp.Execute(StringToSearch)
                          Dim FirstStringFound : FirstStringFound = False
                          Dim PreviousExpressionIndex
                       
                          If expressionmatch.Count > 0 Then
                              For Each expressionmatched in expressionmatch
                                  If not FirstStringFound Then
                                      objDict.Add Left(StringToSearch,expressionmatched.FirstIndex),"foo"
                                      FirstStringFound = True
                                  Else
                                      objDict.Add Mid(StringToSearch,PreviousExpressionIndex + 2,(expressionmatched.FirstIndex - PreviousExpressionIndex)-1),"foo"
                                  End If
                                  PreviousExpressionIndex = expressionmatched.FirstIndex
                              Next
                              objDict.Add Mid(StringToSearch,PreviousExpressionIndex + 2),"foo"
                          End If
                       
                          SplitGN00 = objDict.Keys
                       End Function
                       


                      isn't really satisfactory, but its output

                       cscript splitre00.vbs
                       ##### VBScript Forum Challenge 002: SplitRE
                       
                       =====||
                       Split:   []
                       SplitRE: [still a pipe dream]
                       gn00:    []
                       
                       =====|a b c|
                       Split:   [a|b|c]
                       SplitRE: [still a pipe dream]
                       gn00:    [a|b|c]
                       
                       =====|aaaaa,bvvv,c231,d;e;f;g,h,i|
                       Split:   [aaaaa,bvvv,c231,d;e;f;g,h,i]
                       SplitRE: [still a pipe dream]
                       gn00:    [aaaaa|bvvv|c231|d|e|f|g|h|i]
                       
                       =====|aaaaa::bvvv|
                       Split:   [aaaaa|bvvv]
                       SplitRE: [still a pipe dream]
                       gn00:    [aaaaa|:bvvv]
                       
                       ##### Done.
                       


                      shows that

                           objDict.Add Mid(StringToSearch,PreviousExpressionIndex + 2,(expressionmatched.FirstIndex - PreviousExpressionIndex)-1),"foo"
                           ...
                           objDict.Add Mid(StringToSearch,PreviousExpressionIndex + 2),"foo"

                      needs reconsidering. As you want to learn about RegExps - have a look at the properties of the Match object:
                      isn't there a .Length?

                      Thanks again for your quick and definitely not dirty solution!

                      ehvbs

                         
                      #31
                        ginolard

                        • Total Posts : 1347
                        • Scores: 23
                        • Reward points : 0
                        • Joined: 8/11/2005
                        • Status: offline
                        RE: Weekly/Monthly Challenge? Thursday, July 19, 2007 10:18 PM (permalink)
                        0
                        I'll have to check it out.  I'm sure there is a better way of doing it.  That code was more a "proof of concept" ;)
                        Author of ManagePC - http://managepc.net

                        #32
                          ginolard

                          • Total Posts : 1347
                          • Scores: 23
                          • Reward points : 0
                          • Joined: 8/11/2005
                          • Status: offline
                          RE: Weekly/Monthly Challenge? Thursday, July 19, 2007 10:31 PM (permalink)
                          0
                          Try this.  I also changed it to use the Items Array of the Dictionary instead of the Keys.  JUST in case it encounters duplicate entries ever.

                           Option Explicit
                           
                           Dim TestString : TestString = "aaaaa,,bvvv,c231,d;e;f;g,h,i,eeeeeeeeeeeeeeeee;123123123:a:a:a:a%a"
                           Wscript.echo TestString & " has been split and rejoined to " &  RegExSplit(TestString,"[,;]",":")
                           
                           Function RegExSplit(StringToSearch,pattern,RejoinChar)
                               
                               Dim objRegExp,expressionmatch,expressionmatched
                               Dim objDict : Set objDict=CreateObject("Scripting.Dictionary")
                           
                               Set objRegExp = New RegExp
                               With objRegExp
                                   .Pattern=pattern
                                   .IgnoreCase=True
                                   .Global=True
                               End With
                               Set expressionmatch = objRegExp.Execute(StringToSearch)
                               Dim FirstStringFound : FirstStringFound = False
                               Dim PreviousExpressionIndex
                               Dim KeyCount : KeyCount = 1 
                               Dim PatternLength
                               
                               If expressionmatch.Count > 0 Then
                                   For Each expressionmatched in expressionmatch
                                       PatternLength=expressionmatched.Length + 1 
                                       If not FirstStringFound Then
                                           objDict.Add KeyCount,Left(StringToSearch,expressionmatched.FirstIndex)
                                           FirstStringFound = True
                                       Else
                                           objDict.Add KeyCount, Mid(StringToSearch,PreviousExpressionIndex + PatternLength,(expressionmatched.FirstIndex - PreviousExpressionIndex)-1)
                                       End If
                                       PreviousExpressionIndex = expressionmatched.FirstIndex
                                       KeyCount = KeyCount + 1
                                   Next
                                   objDict.Add KeyCount, Mid(StringToSearch,PreviousExpressionIndex + PatternLength)
                               End If
                               
                               RegExSplit = Join(objDict.Items,RejoinChar)
                           
                           End Function
                           
                           
                          Author of ManagePC - http://managepc.net

                          #33
                            dm_4ever

                            • Total Posts : 3673
                            • Scores: 82
                            • Reward points : 0
                            • Joined: 6/29/2006
                            • Location: Orange County, California
                            • Status: offline
                            RE: Weekly/Monthly Challenge? Saturday, July 21, 2007 11:39 AM (permalink)
                            0
                            Here's my attemp using RegEx replace in conjunction with VBScripts Split function.

                             Option Explicit
                             
                             SplitTest()
                             
                             Sub SplitTest
                                 Dim strTemp : strTemp = "aaaaa,,bvvv,c231,d;e;;f;g,h,i,eeeeeeeeeeeeeeeee;123123123:a:a:a:a%a"
                                 Dim arrTemp : arrTemp = RegExSplit(strTemp, "[;,]", True)
                                 Dim intElemCount
                                 For intElemCount = 0 To UBound(arrTemp)
                                     WScript.Echo arrTemp(intElemCount)
                                 Next
                             End Sub
                             
                             Function RegExSplit(strInput, strPattern, strCompare)
                                 Dim RegEx : Set RegEx = New RegExp
                                 RegEx.Pattern = strPattern
                                 RegEx.IgnoreCase = strCompare
                                 RegEx.Global = True
                                 
                                 If strPattern = "" Then 
                                     Dim strTemp : strTemp = RegEx.Replace(strInput, Chr(7))
                                     strTemp = Mid(strTemp, 2, Len(strTemp) - 2)
                                     RegExSplit = Split(strTemp, Chr(7))
                                 Else
                                     RegExSplit = Split(RegEx.Replace(strInput, Chr(7)), Chr(7))
                                 End If
                             End Function
                             

                            dm_4ever

                            My philosophy: K.I.S.S - Keep It Simple Stupid
                            Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
                            Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
                            #34
                              ehvbs

                              • Total Posts : 3312
                              • Scores: 110
                              • Reward points : 0
                              • Joined: 6/22/2005
                              • Location: Germany
                              • Status: offline
                              RE: Weekly/Monthly Challenge? Sunday, July 29, 2007 7:23 AM (permalink)
                              0
                              Hi dm_4ever,

                              letting VBScript's Split() do the dirty work is really an ingenious solution;
                              especially if you don't need/care for the Count feature of Split() or the
                              possibility of returning the separators too (cf. Perl's split). Then the more
                              complicated approach ginolard has taken would be more promising.

                              Three nit picking remarks:

                              (1) I don't like your strCompare at all: RegEx.IgnoreCase should be assigned
                                  a boolean Value and strCompare is a very bad/treacherous variable name.
                                  To increase the compatibility with VBScript's Split() I would pass
                                  vbBinaryCompare or vbTextCompare and do:

                                    Function RegExSplit( strInput, strPattern, vbComp )
                                      ...
                                      RegEx.IgnoreCase = (vbTextCompare = vbComp)

                              (2) It was me who linked the function "split into characters" with the
                                  SplitRE() function. On second thought I would prefer to have two
                                  separate functions. My version of SplitChrs()
                               ''# SplitChrs - splits sTxt into an array of all its characters; if "" = sTxt
                               ''#             an array containing the empty string is returned
                               ' ############################################################################
                               Function SplitChrs( sTxt )
                                  If "" = sTxt Then
                                     SplitChrs = Array( "" )
                                  Else
                                     Dim sSaveSep  : sSaveSep  = getSaveSep( sTxt )
                                     Dim RegEx     : Set RegEx = New RegExp
                                     RegEx.Pattern = ""
                                     RegEx.Global  = True
                                     Dim strTemp   : strTemp   = RegEx.Replace( sTxt, sSaveSep )
                                     SplitChrs = Split( Mid( strTemp, 2, Len( strTemp ) - 2 ), sSaveSep )
                                  End If
                               End Function
                               


                                  is based on your code; I just provided for the empty string as input
                                  and added a bit of flexibility to the determining of the standardized
                                  separator:
                               ''# getSaveSep - returns the first control character not contained in sTxt
                               ''#              or throws an error if all control characters are found in sTxt
                               ' ############################################################################
                               Function getSaveSep( sTxt )
                                 Dim nChr, sChr
                                 For nChr = 0 To 31 ' check all control chars
                                     sChr = Chr( nChr )
                                     If 0 = InStr( sTxt, sChr ) Then
                                        getSaveSep = sChr
                                        Exit Function
                                     End If
                                 Next
                                 Err.Raise 4711, "getSaveSep( sTxt )", "no save sep (0..31) for sTxt possible"
                               End Function
                               


                              (3) I would use getSaveSep() in my - now specialized - version of your
                                  RegExSplit:
                               ''# SplitDM402 -
                               ' ############################################################################
                               Function SplitDM402( sTxt, sPat, vbComp )
                                  Dim sSep  : sSep      = getSaveSep( sTxt )
                                  Dim RegEx : Set RegEx = New RegExp
                                  RegEx.Pattern    = sPat
                                  RegEx.IgnoreCase = (vbTextCompare = vbComp)
                                  RegEx.Global     = True
                                  SplitDM402 = Split( RegEx.Replace( sTxt, sSep ), sSep )
                               End Function
                               

                                  Your choice of hard coding Chr( 7 ) is good, but I believe in defensive
                                  programming in this case.

                              Thank you for your impressive/beautiful solution!

                              Hi all people who like a challenge,

                              I do think that splitting deserves further efforts. To give you a (hopefully)
                              motivating example: Have a look at

                                 http://en.wikipedia.org/wiki/Electronic_Data_Interchange

                              and

                                 http://en.wikipedia.org/wiki/EDIFACT

                              to get a first impression of the EDI(FACT) data exchange format. The
                              sample:

                               UNB+IATB:1+6XPPC+LHPPC+940101:0950+1’
                               UNH+1+PAORES:93:1:IA’
                               MSG+1:45’
                               IFT+3+XYZCOMPANY AVAILABILITY’
                               ERC+A7V:1:AMD’
                               IFT+3+NO MORE FLIGHTS’
                               ODI’
                               TVL+240493:1000::1220+FRA+JFK+DL+400+C’
                               PDI++C:3+Y::3+F::1’
                               APD+74C:0:::6++++++6X’
                               TVL+240493:1740::2030+JFK+MIA+DL+081+C'
                               PDI++C:4’
                               APD+EM2:0:1630::6+++++++DA’
                               UNT+13+1’
                               UNZ+1+1’
                               


                              (the line breaks are optional/just added for clarity). Given a Split()
                              function that returns the separators also it would be easy to come up
                              with a list like

                                   0 ' UNB
                                   1 + IATB
                                   2 : 1
                                   3 + 6XPPC
                                   4 + LHPPC
                                   5 + 940101
                                   6 : 0950
                                   7 + 1
                                   8 ' UNH
                                   9 + 1
                                  10 + PAORES
                                  11 : 93
                               ...
                                  87 ' UNT
                                  88 + 13
                                  89 + 1
                                  90 ' UNZ
                                  91 + 1
                                  92 + 1
                               


                              [I could cite 2 pages of professional Java code from "Applied XML
                              Solution" by B. Marchal to prove that such a split function does the
                              work of a full fleged tokenizer.
                                 http://www.marchal.com/en/
                              ]

                              Such a list can be structured by a very quick an dirty VBScript function

                               '' structEDI - structures flat array (Sep, Val, Sep, Val, ...) to a 3 level
                               ''             EDI structure (segment, field/element, composite)
                               '  ---------------------------------------------------------------------------
                               Function structEDI( aFlat )
                                 Dim aRVal : aRVal = Array()
                                 Dim aFld  : aFld  = Array()
                                 Dim aComp : aComp = Array()
                                 Dim nIdx
                                 For nIdx = 0 To UBound( aFlat ) Step 2
                                     Select Case aFlat( nIdx )
                                       Case "'"
                                         If -1 < UBound( aComp ) Then
                                            appendArr aFld, aComp
                                            aComp = Array()
                                         End If
                                         If -1 < UBound( aFld  ) Then
                                            appendArr aRVal, aFld
                                            aFld = Array()
                                         End If
                                         appendArr aRVal, aFlat( nIdx + 1 )
                                       Case "+"
                                         If -1 < UBound( aComp ) Then
                                            appendArr aFld, aComp
                                            aComp = Array()
                                         End If
                                         appendArr aFld, aFlat( nIdx + 1 )
                                       Case ":"
                                         appendArr aComp, aFlat( nIdx + 1 )
                                     End Select
                                 Next
                                 If -1 < UBound( aComp ) Then appendArr aFld, aComp
                                 If -1 < UBound( aFld  ) Then appendArr aRVal, aFld
                                 structEDI = aRVal
                               End Function
                               
                               '' appendArr - adds an element to a (growing) array
                               '  ---------------------------------------------------------------------------
                               Sub appendArr( aX, vX )
                                 ReDim Preserve aX( UBound( aX ) + 1 )
                                 aX( UBound( aX ) ) = vX
                               End Sub
                               


                              to a three level array reflecting the sgement-field/element-composite
                              layout/assembly of an EDI message:

                               UNB
                                IATB
                                 1
                                6XPPC
                                LHPPC
                                940101
                                 0950
                                1
                               UNH
                                1
                                PAORES
                                 93
                                 1
                                 IA
                               ... 
                               UNT
                                13
                                1
                               UNZ
                                1
                                1 
                               


                              The clumsiness of the code is due to my attempt to use the VBScript array
                              to store hierarchically structured data/information. I would be much better
                              to use XML (DOM, in memory) for this purpose. That way it would be easy
                              to store necessary meta-information (XML attributes) too.

                              So my next challenge for all of you who don't want to spend time on Join()
                              or Split():

                                Write a demo script that shows how hierarchically structured data
                                can be stored in an XML DOM Document
                               
                              I hope this challenge will link/connect to ebgreen's/TNO's project of using
                              XML for persistence.

                              ehvbs

                              #35
                                dm_4ever

                                • Total Posts : 3673
                                • Scores: 82
                                • Reward points : 0
                                • Joined: 6/29/2006
                                • Location: Orange County, California
                                • Status: offline
                                RE: Weekly/Monthly Challenge? Sunday, July 29, 2007 7:58 AM (permalink)
                                0
                                Hi ehvbs,

                                1.  I see what you mean and thanks for pointing that out.
                                2.  getSaveSep to get an available seperator is awesome.

                                Thank you for your comments and additional info.

                                This may be a way to return the seperator as well...though I haven't played with it enough to know for sure.

                                 Function RegExSplit2( sTxt, sPat, vbComp )
                                  Dim sSep  : sSep      = getSaveSep( sTxt )
                                  Dim RegEx : Set RegEx = New RegExp
                                  RegEx.Pattern    = "(" & sPat & ")"
                                  RegEx.IgnoreCase = (vbTextCompare = vbComp)
                                  RegEx.Global     = True
                                  RegExSplit2 = Split( RegEx.Replace( sTxt, sSep & "$1" ), sSep )
                                 End Function
                                 


                                EDIT://

                                Since we are using the Split function we can try using it's "Count".

                                 Function RegExSplit2( sTxt, sPat, iCount, vbComp )
                                    Dim sSep  : sSep      = getSaveSep( sTxt )
                                    Dim RegEx : Set RegEx = New RegExp
                                    RegEx.Pattern    = sPat
                                    RegEx.IgnoreCase = (vbTextCompare = vbComp)
                                    RegEx.Global     = True
                                    RegExSplit2= Split( RegEx.Replace( sTxt, sSep ), sSep, iCount )
                                 End Function
                                <message edited by dm_4ever on Sunday, July 29, 2007 12:51 PM>
                                dm_4ever

                                My philosophy: K.I.S.S - Keep It Simple Stupid
                                Read Me: http://www.visualbasicscript.com/m_24727/tm.htm
                                Frequently Asked Stuff: http://www.visualbasicscript.com/m_47117/tm.htm
                                #36
                                  ehvbs

                                  • Total Posts : 3312
                                  • Scores: 110
                                  • Reward points : 0
                                  • Joined: 6/22/2005
                                  • Location: Germany
                                  • Status: offline
                                  RE: Weekly/Monthly Challenge? Monday, July 30, 2007 12:11 AM (permalink)
                                  0
                                  Hi dm_4ever,

                                  regarding your 'keep the separators' function: I would prefer to keep the
                                  separators and the values separated; of course you could postprocess the
                                  array returned by your function, but then you'll have to code a loop/
                                  split/fill an array functionality that could be incorporated in the split()
                                  function. Some code to illustrate:

                                   Function test02()
                                     Dim nRVal  : nRVal  = 0
                                     Dim aTests : aTests = Array( _
                                        "'UNH+24345+ORDERS:D:96A:UN:EAN008'BGM+220+4500355075'DTM+137:20070522:102" _
                                      , "nothing to split in this silly example" _
                                                                )
                                     Dim sTest, aRes
                                     For Each sTest In aTests
                                         WScript.Echo sTest
                                         aRes = RegExSplit2(   sTest, "['+:]"  , vbBinaryCompare )
                                         WScript.Echo Join( aRes, "|" )
                                         aRes = RegExSplitEDI( sTest, "(['+:])", vbBinaryCompare )
                                         WScript.Echo Join( aRes, "|" )
                                         WScript.Echo
                                     Next
                                   
                                     test02 = nRVal
                                   End Function
                                   
                                   '' RegExSplit2 - splits sTxt into an array; each element contains separator
                                   ''               + value ((c) dm_4ever)
                                   '  ---------------------------------------------------------------------------
                                   Function RegExSplit2( sTxt, sPat, vbComp )
                                    Dim sSep  : sSep      = getSaveSep( sTxt )
                                    Dim RegEx : Set RegEx = New RegExp
                                    RegEx.Pattern    = "(" & sPat & ")"
                                    RegEx.IgnoreCase = (vbTextCompare = vbComp)
                                    RegEx.Global     = True
                                    RegExSplit2 = Split( RegEx.Replace( sTxt, sSep & "$1" ), sSep )
                                   End Function
                                   
                                   '' RegExSplitEDI - splits sTxt into an array; separator and value are distinct
                                   ''                 elements ((c) ginolard/ehvbs; needs further work)
                                   '  ---------------------------------------------------------------------------
                                   Function RegExSplitEDI( sTxt, sPat, vbComp )
                                     Dim aRVal : aRVal     = Array()
                                     Dim RegEx : Set RegEx = New RegExp
                                     RegEx.Pattern    = sPat
                                     RegEx.IgnoreCase = (vbTextCompare = vbComp)
                                     RegEx.Global     = True
                                     Dim oMTS  : Set oMTS = RegEx.Execute( sTxt )
                                   
                                     If 0 = oMTS.Count Then
                                        aRVal = Array( sTxt )
                                     Else
                                        Dim nIdx : nIdx = -1
                                        Dim nPos : nPos = 1
                                        Dim oMT
                                        For Each oMT In oMTS
                                            nIdx = nIdx + 1
                                            ReDim Preserve aRVal( nIdx + 1 )
                                            aRVal( nIdx ) = Mid( sTxt, nPos, oMT.FirstIndex + 1 - nPos )
                                            nPos = oMT.FirstIndex + 1 + oMT.Length
                                            nIdx = nIdx + 1
                                            aRVal( nIdx ) = oMT.SubMatches( 0 )
                                        Next
                                        nIdx = nIdx + 1
                                        ReDim Preserve aRVal( nIdx )
                                        aRVal( nIdx ) = Mid( sTxt, nPos )
                                     End If
                                   
                                     RegExSplitEDI = aRVal
                                   End Function
                                   
                                   ------ output -----------
                                   'UNH+24345+ORDERS:D:96A:UN:EAN008'BGM+220+4500355075'DTM+137:20070522:102
                                   |'UNH|+24345|+ORDERS|:D|:96A|:UN|:EAN008|'BGM|+220|+4500355075|'DTM|+137|:20070522|:102
                                   |'|UNH|+|24345|+|ORDERS|:|D|:|96A|:|UN|:|EAN008|'|BGM|+|220|+|4500355075|'|DTM|+|137|:|20070522|:|102
                                   
                                   nothing to split in this silly example
                                   nothing to split in this silly example
                                   nothing to split in this silly example
                                   


                                  regarding your 'limit the split according to iCount' function: VBScript's
                                  Split() function returns the not processed tail of the input string unchanged,
                                  your function has replaced the separators in the tail with the standardized
                                  separator. Code to illustrate:

                                   Function testSplitCount()
                                     Dim nRVal  : nRVal  = 0
                                     Dim aTests : aTests = Array( _
                                        "abc1def1ghi1jkl" _
                                                                )
                                     Dim sTest, iCount, aRes
                                     For Each sTest In aTests
                                         WScript.Echo sTest
                                         For Each iCount In Array( -1, 0, 1, 2 )
                                             aRes = Split(       sTest, "1", iCount, vbBinaryCompare )
                                             WScript.Echo iCount, ">" & Join( aRes, "|" ) & "<"
                                             aRes = RegExSplit3( sTest, "1", iCount, vbBinaryCompare )
                                             WScript.Echo iCount, ">" & Join( aRes, "|" ) & "<"
                                             WScript.Echo
                                         Next
                                     Next
                                   
                                     testSplitCount = nRVal
                                   End Function
                                   
                                   Function RegExSplit3( sTxt, sPat, iCount, vbComp )
                                     Dim sSep  : sSep      = getSaveSep( sTxt )
                                     Dim RegEx : Set RegEx = New RegExp
                                     RegEx.Pattern    = sPat
                                     RegEx.IgnoreCase = (vbTextCompare = vbComp)
                                     RegEx.Global     = True
                                     RegExSplit3      = Split( RegEx.Replace( sTxt, sSep ), sSep, iCount )
                                   End Function
                                   
                                   ''# getSaveSep - returns the first control character not contained in sTxt
                                   ''#              or throws an error if all control characters are found in sTxt
                                   ' ############################################################################
                                   Function getSaveSep( sTxt )
                                     Dim nChr, sChr
                                     For nChr = 1 To 31 ' check all control chars
                                         sChr = Chr( nChr )
                                         If 0 = InStr( sTxt, sChr ) Then
                                            getSaveSep = sChr
                                            Exit Function
                                         End If
                                     Next
                                     Err.Raise 4711, "getSaveSep( sTxt )", "no save sep (0..31) for sTxt possible"
                                   End Function
                                   
                                   -------------- output ---------------
                                   abc1def1ghi1jkl
                                   -1 >abc|def|ghi|jkl<
                                   -1 >abc|def|ghi|jkl<
                                   
                                   0 ><
                                   0 ><
                                   
                                   1 >abc1def1ghi1jkl<
                                   1 >abc?def?ghi?jkl<
                                   
                                   2 >abc|def1ghi1jkl<
                                   2 >abc|def?ghi?jkl<
                                   
                                   [The "?" are Chr( 1 ) transformed by copy/paste]
                                   


                                  As you can see, I changed getSaveSep()

                                    For nChr = 0 To 31  
                                  ==>
                                    For nChr = 1 To 31  

                                  to avoid Chr( 0 ) as standardized separator, because some internal VBScript
                                  functions treat this character in a special way.

                                  Thanks for your inspiring efforts!

                                  ehvbs

                                  #37
                                    ehvbs

                                    • Total Posts : 3312
                                    • Scores: 110
                                    • Reward points : 0
                                    • Joined: 6/22/2005
                                    • Location: Germany
                                    • Status: offline
                                    RE: Weekly/Monthly Challenge? Thursday, August 23, 2007 7:50 PM (permalink)
                                    0
                                    Hi all who would like another challenge!

                                    Looks like XML isn't a hit. So now something entirety different. Other scripting
                                    languages have an interactive shell and/or command line switches that allow to
                                    evaluate/execute small pieces of code in an easy/ad hoc way. E.g.

                                        perl -e"print 'hello';"
                                        hello
                                        
                                    or

                                        C:\Python24\python.exe
                                        Python 2.4.1 (#65, Mar 30 2005, 09:13:57) [MSC v.1310 32 bit (Intel)] on win32
                                        Type "help", "copyright", "credits" or "license" for more information.
                                        >>> print "hello"
                                        hello
                                        >>> ^Z

                                    Wouldn't it be nice to be able to do:

                                        cscript cvbs.vbs "= DateAdd( 'd', 2, Now() )"
                                        #### cvbs: perl -e für VBScript (doMain) ######################################
                                        ================================== VBScript 5.6 CSCRIPT 5.6 24.08.2007 09:45:32
                                        Ergebnis: 26.08.2007 09:45:32
                                        #### cvbs: Erfolgreich beendet (0) ######################## 24.08.2007 09:45:32

                                    Or

                                        cscript ivbs.vbs
                                        #### ivbs: interaktive VBScript-Shell #########################################
                                        ================================== VBScript 5.6 CSCRIPT 5.6 24.08.2007 09:43:45
                                        < ? "hello"
                                        hello
                                        < quit
                                        #### ivbs: Erfolgreich beendet (0) ######################## 24.08.2007 09:44:05

                                    So be challenged!

                                    ehvbs
                                     
                                    #38
                                      DiGiTAL.SkReAM

                                      • Total Posts : 1259
                                      • Scores: 7
                                      • Reward points : 0
                                      • Joined: 9/7/2005
                                      • Location: Clearwater, FL, USA
                                      • Status: offline
                                      RE: Weekly/Monthly Challenge? Friday, August 24, 2007 5:58 PM (permalink)
                                      0
                                      This one looked easy, but to get it done, i had to wrap it in a batch file.
                                       
                                      CS.BAT
                                       @echo off
                                       if X%1==X goto shellme
                                       goto runme
                                       :shellme
                                       cscript c:\scripts\vbshell.vbs //nologo
                                       goto end
                                       :runme
                                       cscript c:\scripts\vbshell.vbs //nologo %*
                                       :end
                                       

                                       
                                      and the script:
                                      VBSHELL.VBS

                                       Option Explicit 
                                       Dim sResult, iErr, sErr 
                                        If WScript.Arguments.Count = 0 Then 
                                         WScript.StdOut.Write "VBScript Interactive Shell" & VbCrLf 
                                         WScript.StdOut.Write "Type 'exit' to quit." & VbCrLf 
                                          Do 
                                           WScript.StdOut.Write ">"
                                           sResult = WScript.StdIn.ReadLine
                                           If LCase(sResult) = "exit" Then 
                                            WScript.StdOut.Write "Exiting..." & VbCrLf 
                                            WScript.Quit
                                           Else
                                            On Error Resume Next
                                             Execute sResult
                                             iErr = Err.Number
                                             sErr = Err.Description
                                            On Error GoTo 0 
                                             If iErr <> 0 Then WScript.StdOut.Write "VBScript Error #: " & iErr & String(3," ") & "Error Description: " & sErr & VbCrLf 
                                           End If
                                          Loop
                                        Else
                                         Dim oProcess, sCommand
                                          For Each oProcess In GetObject("winmgmts:\\.\root\cimv2").ExecQuery("Select * From Win32_Process Where Name='cscript.exe'")
                                              sCommand = Trim(Split(oProcess.CommandLine,"//nologo")(1))
                                          Next
                                         On Error Resume Next
                                          Execute sCommand
                                          iErr = Err.Number
                                          sErr = Err.Description
                                         On Error GoTo 0 
                                          If iErr <> 0 Then WScript.StdOut.Write "VBScript Error #: " & iErr & String(3," ") & "Error Description: " & sErr & VbCrLf 
                                        End If
                                       


                                      This allows you to do the following:
                                       C:\scripts>cs
                                       VBScript Interactive Shell
                                       Type 'exit' to quit.
                                       >wscript.echo "Hello World"
                                       Hello World
                                       >exit
                                       Exiting...
                                       C:\scripts>cs wscript.echo "Hello World"
                                       Hello World
                                       C:\scripts>
                                       

                                       
                                       
                                      <message edited by DiGiTAL.SkReAM on Saturday, August 25, 2007 7:37 AM>
                                      "Would you like to touch my monkey?" - Dieter (Mike Meyers)

                                      "It is better to die like a tiger, than to live like a pussy."
                                      -Master Wong, from Balls of Fury
                                      #39
                                        ehvbs

                                        • Total Posts : 3312
                                        • Scores: 110
                                        • Reward points : 0
                                        • Joined: 6/22/2005
                                        • Location: Germany
                                        • Status: offline
                                        RE: Weekly/Monthly Challenge? Monday, August 27, 2007 7:08 AM (permalink)
                                        0
                                        Hi all who can be lured into feeling challenged!

                                        Trust DiGiTAL.SkReAM to come up with a solution quickly! I hope his contribution
                                        won't discourage anybody from posting her/his own variation of the theme. I
                                        tried to choose a problem that can be tackled by beginning VBScripters, especially
                                        because the "-e" version (handle just one line from the command prompt) avoids
                                        the problem of reading from WScript.StdIn.

                                        I assume, DiGiTAL.SkReAM's nastiest problem was the DOS shell stealing the "
                                        from the command line. Of course he solved it; but he used a rather large hammer
                                        (WMI) which isn't available in/under W2K:

                                          http://www.microsoft.com/technet/scriptcenter/resources/qanda/jan05/hey0120.mspx
                                         
                                        When I started to tinker with the problem, I used a replacement of ' by " - cf:
                                         
                                          cscript cvbs.vbs "= DateAdd( 'd', 2, Now() )"
                                         
                                        This approach has its own cons - no easy way to distinguish between real ' and
                                        ' that should be replaced - but as you can see from this code

                                         Option Explicit
                                         
                                         Dim sCode
                                         If WScript.Arguments.Count = 0 Then
                                            WScript.StdOut.WriteLine "VBScript Interactive Shell"
                                            WScript.StdOut.WriteLine "Type 'exit' to quit."
                                            Do
                                               WScript.StdOut.Write "> "
                                               sCode = WScript.StdIn.ReadLine
                                               Select Case LCase( sCode )
                                                  Case "exit"
                                                    Exit Do
                                                  Case Else
                                                    handleCode sCode
                                               End Select
                                            Loop
                                            WScript.StdOut.WriteLine "Exiting..."
                                         Else
                                            Dim sPart
                                            For Each sPart In WScript.Arguments
                                                sCode = sCode & " " & sPart
                                            Next
                                            sCode = Replace( sCode, "'", """" )
                                            handleCode sCode
                                         End If
                                         WScript.Quit 0
                                         
                                         Sub handleCode( sCode )
                                           Dim nErr, sErr
                                         On Error Resume Next
                                           Execute sCode
                                           nErr = Err.Number
                                           sErr = Err.Description
                                         On Error GoTo 0
                                           If 0 <> nErr Then
                                              WScript.StdOut.WriteLine "Code: " & sCode
                                              WScript.StdOut.WriteLine "VBScript Error #: " & nErr
                                              WScript.StdOut.WriteLine sErr
                                           End If
                                         End Sub
                                         


                                        this way you can do it without WMI.

                                        Looking forwards to other nifty contributions
                                        (how about multiline input, for example?)

                                        ehvbs
                                         
                                        #40

                                          Online Bookmarks Sharing: Share/Bookmark
                                          Change Page: < 1234 > | Showing page 2 of 4, messages 21 to 40 of 61

                                          Jump to:

                                          Current active users

                                          There are 0 members and 1 guests.

                                          Icon Legend and Permission

                                          • New Messages
                                          • No New Messages
                                          • Hot Topic w/ New Messages
                                          • Hot Topic w/o New Messages
                                          • Locked w/ New Messages
                                          • Locked w/o New Messages
                                          • Read Message
                                          • Post New Thread
                                          • Reply to message
                                          • Post New Poll
                                          • Submit Vote
                                          • Post reward post
                                          • Delete my own posts
                                          • Delete my own threads
                                          • Rate post

                                          2000-2012 ASPPlayground.NET Forum Version 3.8
                                          mbt shoes www.wileywilson.com