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 1 of 4, messages 1 to 20 of 61
Author Message
mcds99

  • Total Posts : 515
  • Scores: 4
  • Reward points : 0
  • Joined: 2/28/2006
  • Status: offline
Weekly/Monthly Challenge? Friday, May 25, 2007 2:08 AM (permalink)
0
With the mass of talent (not me) in this forum I was thinking it might be fun to have a contest of sorts.
I come up with these ideas (stupid at times) and have no idea how to go about doing anything about them.

There would have to be 3 or 4 skill levels because for me to compete against ehvbs, dm_4ever, or DiGITAL.SkReAM would be funny at best ;-)
Obviously I'm not skilled enough to put something like this on.

I just thougt it might be a way to promote the forum and educate people on VBS. People come here for answers, this would help people
provide answers, learn to solve script problems and become better scripters.



Sam

Keep it Simple Make it Fun KiSMiF
#1
    ebgreen

    • Total Posts : 8088
    • Scores: 95
    • Reward points : 0
    • Joined: 7/12/2005
    • Status: offline
    RE: Weekly/Monthly Challenge? Friday, May 25, 2007 2:21 AM (permalink)
    0
    I think it would be fun. Have you looked at the Scripting Games that the Scripting Guys do at MS's Script Center?
    "... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
    Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
    http://www.visualbasicscript.com/m_47117/tm.htm
    #2
      ehvbs

      • Total Posts : 3312
      • Scores: 110
      • Reward points : 0
      • Joined: 6/22/2005
      • Location: Germany
      • Status: offline
      RE: Weekly/Monthly Challenge? Monday, June 11, 2007 3:06 AM (permalink)
      0
      I do like mcds99's proposal. If you like my sample for a challenge:

          According to the VBScript Docs ("VarType Constants") there are
          these subtypes of variants in VBScript:
          
          vbEmpty         0 Uninitialized (default)
          vbNull          1 Contains no valid data
          vbInteger       2 Integer subtype
          vbLong          3 Long subtype
          vbSingle        4 Single subtype
          vbDouble        5 Double subtype
          vbCurrency      6 Currency subtype
          vbDate          7 Date subtype
          vbString        8 String subtype
          vbObject        9 Object
          vbError        10 Error subtype
          vbBoolean      11 Boolean subtype
          vbVariant      12 Variant (used only for arrays of variants)
          vbDataObject   13 Data access object
          vbDecimal      14 Decimal subtype
          vbByte         17 Byte subtype
          vbArray      8192 Array
         
          Given the array:
         
              Dim aTests : aTests = Array( 1, "test" )
         
          The line:
         
              WScript.Echo Join( aTests, vbTab )
         
          will output:
         
              1   test
         
          but if you add an object to aTests:
         
              Dim aTests : aTests = Array( 1, "test", New RegExp )
         
          you'll get an error like:
         
              Das Objekt unterstützt diese Eigenschaft oder Methode nicht.
              (The object doesn't support this method or property)
         
          The challenge: Create an Array aTest with at least one sample for
          each possible subtype and write a
         
              Function JoinX( aArr, sSep )
         
          that does what Join() should have done in the first place.
         
      and we could reach an agreement regarding the way to post such
      challenges (and the - hopefully - many answers), I'd gladly do
      my best to keep you challenged.

      ehvbs
       
      #3
        ginolard

        • Total Posts : 1347
        • Scores: 23
        • Reward points : 0
        • Joined: 8/11/2005
        • Status: offline
        RE: Weekly/Monthly Challenge? Tuesday, June 12, 2007 8:58 PM (permalink)
        0
        I think the first challenge should be to get ehvbs to reply to someone in less than 3 lines


        Author of ManagePC - http://managepc.net

        #4
          ebgreen

          • Total Posts : 8088
          • Scores: 95
          • Reward points : 0
          • Joined: 7/12/2005
          • Status: offline
          RE: Weekly/Monthly Challenge? Wednesday, June 13, 2007 2:41 AM (permalink)
          0
          I was looking at this but I can't determine how to get a couple of the data types. Is anyone else looking at it?
          "... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
          Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
          http://www.visualbasicscript.com/m_47117/tm.htm
          #5
            ehvbs

            • Total Posts : 3312
            • Scores: 110
            • Reward points : 0
            • Joined: 6/22/2005
            • Location: Germany
            • Status: offline
            RE: Weekly/Monthly Challenge? Wednesday, June 13, 2007 3:41 AM (permalink)
            0
            Hi ebgreen,

            of course I'm looking at it! I appreciate your interest. This is the code I use
            to get sample data in a systematic/flexible way:

               Dim aTests : aTests = getDTSample()
               Dim vX, sX
               For Each vX In aTests
                   sX = "can't display this!"
             On Error Resume Next
                   sX = CStr( vX )
             On Error GoTo 0
                   WScript.Echo   Right( Space(  6 )    & VarType(  vX ),  6 ) _
                                , Left(  TypeName( vX ) + Space( 23 )   , 23 ) _
                                , ">" + sX + "<"
               Next
             
             Function getDTSample()
               Dim dicAll : Set dicAll = CreateObject( "Scripting.Dictionary" )
             '   vbEmpty         0 Uninitialized (default)
               dicAll( "vbEmpty"     ) = Array( True, Empty )
             '   vbNull          1 Contains no valid data
               dicAll( "vbNull"      ) = Array( True, Null  )
             '   vbInteger       2 Integer subtype
               dicAll( "vbInteger0"  ) = Array( True, CInt(  0 )  )
               dicAll( "vbInteger1"  ) = Array( True, CInt( -1 )  )
             '   vbLong          3 Long subtype
               dicAll( "vbLong0"     ) = Array( True, CLng(  0 )  )
             '   vbSingle        4 Single subtype
               dicAll( "vbSingle0"   ) = Array( True, CSng(  0.0 )  )
             '   vbDouble        5 Double subtype
               dicAll( "vbDouble0"   ) = Array( True, CDbl(  0.0 )  )
             '   vbCurrency      6 Currency subtype
               dicAll( "vbCurrency0" ) = Array( True, CCur(  0.0 )  )
             '   vbDate          7 Date subtype
               dicAll( "vbDate0"     ) = Array( True, Now )
               dicAll( "vbDate1"     ) = Array( True, #4/13/1953 12:13:14# )
             '   vbString        8 String subtype
               dicAll( "vbString0"   ) = Array( True, "" )
               dicAll( "vbString1"   ) = Array( True, " " )
               dicAll( "vbString2"   ) = Array( True, "Alle Vögel sind schon da." )
             '   vbObject        9 Object
               dicAll( "vbObject0"   ) = Array( True, New RegExp )
               dicAll( "vbObject1"   ) = Array( True, CreateObject( "Scripting.FileSystemObject" ) )
             '   vbError        10 Error subtype
               dicAll( "vbError"     ) = Array( True, Err )
             '   vbBoolean      11 Boolean subtype
               dicAll( "vbBoolean0"  ) = Array( True, False )
               dicAll( "vbBoolean1"  ) = Array( True, True  )
             '   vbVariant      12 Variant (used only for arrays of variants)
             '   vbDataObject   13 Data access object
             '   vbDecimal      14 Decimal subtype
             '   vbByte         17 Byte subtype
               dicAll( "vbByte0"     ) = Array( True, CByte( 0 )  )
             '   vbArray      8192 Array
             '   vbVarArray   8204 Array of Variants
               dicAll( "vbVarArray0" ) = Array( True, Array() )
             
               ReDim aRVal( dicAll.Count - 1 )
               Dim   nCnt : nCnt = -1
               Dim   sKey
               For Each sKey In dicAll.Keys
                   If dicAll( sKey )( 0 ) Then
                      nCnt = nCnt + 1
                      If IsObject( dicAll( sKey )( 1 ) ) Then
                         Set aRVal( nCnt ) = dicAll( sKey )( 1 )
                      Else
                             aRVal( nCnt ) = dicAll( sKey )( 1 )
                      End If
                   End If
               Next
               ReDim Preserve aRVal( nCnt )
               getDTSample = aRVal
             End Function
             
             ---- output ----
             === allDataTypes: samples for (nearly) all VBS Data Types ========
                  0 Empty                   ><
                  1 Null                    >can't display this!<
                  2 Integer                 >0<
                  2 Integer                 >-1<
                  3 Long                    >0<
                  4 Single                  >0<
                  5 Double                  >0<
                  6 Currency                >0<
                  7 Date                    >13.06.2007 17:36:09<
                  7 Date                    >13.04.1953 12:13:14<
                  8 String                  ><
                  8 String                  > <
                  8 String                  >Alle Vögel sind schon da.<
                  9 RegExp                  >can't display this!<
                  9 FileSystemObject        >can't display this!<
                  3 Object                  >0<
                 11 Boolean                 >Falsch<
                 11 Boolean                 >Wahr<
                 17 Byte                    >0<
               8204 Variant()               >can't display this!<
             === allDataTypes: 0 done (00:00:00) ==============================
             


            I hope, this time I am lucky and get some further feedback!

            ehvbs

            #6
              ebgreen

              • Total Posts : 8088
              • Scores: 95
              • Reward points : 0
              • Joined: 7/12/2005
              • Status: offline
              RE: Weekly/Monthly Challenge? Wednesday, June 13, 2007 5:43 AM (permalink)
              0
              Here is what I was working with:
               
              Option Explicit
               Dim arrTest
               Dim i
               Dim vEmpty
               Dim oErr
               On Error Resume Next
               Err.Raise(3)
               oErr = Err
               Err.Clear()
                
               arrTest = Array(vEmpty, Null, 0, CLng(0), CSng(0), CDbl(0), CCur(0), CDate(Now()), "", New Regexp, oErr, CBool(0), Array(0), CreateObject("ADOConnectObject.ADOConnectObject"), 0.0, CByte(0))
               For i=0 To UBound(arrTest)
                WScript.Echo i & ")" & VarType(arrTest(i))
               Next

               
              I think I will move onto the JoinX question now.
              "... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
              Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
              http://www.visualbasicscript.com/m_47117/tm.htm
              #7
                ehvbs

                • Total Posts : 3312
                • Scores: 110
                • Reward points : 0
                • Joined: 6/22/2005
                • Location: Germany
                • Status: offline
                RE: Weekly/Monthly Challenge? Wednesday, June 13, 2007 8:48 AM (permalink)
                0
                Hi ebgreen,

                some short remarks (trying to do it in 3 lines netto)

                (1) oErr = Err  => Set oErr = Err (?)

                (2) On Error GoTo 0 missing (?)

                (3) Is "ADOConnectObject.ADOConnectObject" valid (?)

                Looking forward to your XJoin()!

                ehvbs
                #8
                  dm_4ever

                  • Total Posts : 3673
                  • Scores: 82
                  • Reward points : 0
                  • Joined: 6/29/2006
                  • Location: Orange County, California
                  • Status: offline
                  RE: Weekly/Monthly Challenge? Wednesday, June 13, 2007 4:07 PM (permalink)
                  0
                  ginolard - , ehvbs overwhelms me sometimes with his long posts...I'd be afraid to see extremely concise explanations or code from him...so it's good where he's at...at least this way after reading and looking for a few minutes it makes sense to me.

                  I wanted to take a crack at this but wasn't sure how to handle those types that can't be echoed out...looking at the examples by ebgreen and ehvbs (who I think gave a lot away)...this is what I have so far.

                   Option Explicit
                   
                   On Error Resume Next
                   Err.Raise(6)
                   Dim oErr : oErr = Err
                   On Error GoTo 0
                   Dim arrTest : arrTest = Array(Empty, Null, 0, CLng(0), CSng(0), CDbl(0), CCur(0), CDate(Now()), "", New Regexp, oErr, CBool(0), Array(0), CreateObject("ADOConnectObject.ADOConnectObject"), 0.0, CByte(0))
                   
                   WScript.Echo JoinX(arrTest, "|")
                   WScript.Echo VbCrLf 
                   WScript.Echo JoinX(getDTSample(), ",")
                   
                   Function JoinX(arrInput, strSeperator)
                       Dim objDict : Set objDict = CreateObject("Scripting.Dictionary")
                       objDict.Add "Null", "" : objDict.Add "Variant()", ""
                       Dim intElem, strOutput
                       For intElem = 0 To UBound(arrInput)
                           strOutput = Split(strOutput, Chr(7))
                           ReDim Preserve strOutput(UBound(strOutput) + 1)
                           Select Case True
                               Case objDict.Exists(TypeName(arrInput(intElem))), IsObject(arrInput(intElem))
                                   strOutput(UBound(strOutput)) = "can't display this!"
                               Case Else
                                   strOutput(UBound(strOutput)) = CStr(arrInput(intElem))
                           End Select
                           strOutput = Join(strOutput, strSeperator)
                       Next
                       JoinX = strOutput
                   End Function
                   
                   Function getDTSample()
                       Dim dicAll : Set dicAll = CreateObject( "Scripting.Dictionary" )
                       '   vbEmpty         0 Uninitialized (default)
                       dicAll( "vbEmpty"     ) = Array( True, Empty )
                       '   vbNull          1 Contains no valid data
                       dicAll( "vbNull"      ) = Array( True, Null  )
                       '   vbInteger       2 Integer subtype
                       dicAll( "vbInteger0"  ) = Array( True, CInt(  0 )  )
                       dicAll( "vbInteger1"  ) = Array( True, CInt( -1 )  )
                       '   vbLong          3 Long subtype
                       dicAll( "vbLong0"     ) = Array( True, CLng(  0 )  )
                       '   vbSingle        4 Single subtype
                       dicAll( "vbSingle0"   ) = Array( True, CSng(  0.0 )  )
                       '   vbDouble        5 Double subtype
                       dicAll( "vbDouble0"   ) = Array( True, CDbl(  0.0 )  )
                       '   vbCurrency      6 Currency subtype
                       dicAll( "vbCurrency0" ) = Array( True, CCur(  0.0 )  )
                       '   vbDate          7 Date subtype
                       dicAll( "vbDate0"     ) = Array( True, Now )
                       dicAll( "vbDate1"     ) = Array( True, #4/13/1953 12:13:14# )
                       '   vbString        8 String subtype
                       dicAll( "vbString0"   ) = Array( True, "" )
                       dicAll( "vbString1"   ) = Array( True, " " )
                       dicAll( "vbString2"   ) = Array( True, "Alle Vögel sind schon da." )
                       '   vbObject        9 Object
                       dicAll( "vbObject0"   ) = Array( True, New RegExp )
                       dicAll( "vbObject1"   ) = Array( True, CreateObject( "Scripting.FileSystemObject" ) )
                       '   vbError        10 Error subtype
                       dicAll( "vbError"     ) = Array( True, Err )
                       '   vbBoolean      11 Boolean subtype
                       dicAll( "vbBoolean0"  ) = Array( True, False )
                       dicAll( "vbBoolean1"  ) = Array( True, True  )
                       '   vbVariant      12 Variant (used only for arrays of variants)
                       '   vbDataObject   13 Data access object
                       '   vbDecimal      14 Decimal subtype
                       '   vbByte         17 Byte subtype
                       dicAll( "vbByte0"     ) = Array( True, CByte( 0 )  )
                       '   vbArray      8192 Array
                       '   vbVarArray   8204 Array of Variants
                       dicAll( "vbVarArray0" ) = Array( True, Array() )
                       
                       ReDim aRVal( dicAll.Count - 1 )
                       Dim   nCnt : nCnt = -1
                       Dim   sKey
                       For Each sKey In dicAll.Keys
                           If dicAll( sKey )( 0 ) Then
                               nCnt = nCnt + 1
                               If IsObject( dicAll( sKey )( 1 ) ) Then
                                   Set aRVal( nCnt ) = dicAll( sKey )( 1 )
                               Else
                                   aRVal( nCnt ) = dicAll( sKey )( 1 )
                               End If
                           End If
                       Next
                       ReDim Preserve aRVal( nCnt )
                       getDTSample = aRVal
                   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
                  #9
                    ehvbs

                    • Total Posts : 3312
                    • Scores: 110
                    • Reward points : 0
                    • Joined: 6/22/2005
                    • Location: Germany
                    • Status: offline
                    RE: Weekly/Monthly Challenge? Wednesday, June 20, 2007 9:54 AM (permalink)
                    0
                    [shameless attempt to get some attention for this topic]

                    This looks like becoming a yearly challenge!

                    [no offense meant]


                    #10
                      ginolard

                      • Total Posts : 1347
                      • Scores: 23
                      • Reward points : 0
                      • Joined: 8/11/2005
                      • Status: offline
                      RE: Weekly/Monthly Challenge? Wednesday, June 20, 2007 7:00 PM (permalink)
                      0
                      Well, I'm a bit closer than you guys.  Using the Arraylist .NET object you can return objects

                      However, for some reason, it doesn't like the Currency vartype.

                      UPDATE: Fixed that little problem by simply copying the DataList to an array and adding the Currency vartype at the end of the array.

                      What do I win? ;)

                       Set DataList = CreateObject ("System.Collections.ArrayList")
                       DataList.Add Empty
                       DataList.Add Null
                       DataList.Add Cint(0)
                       DataList.Add CInt(-1)
                       DataList.Add CLng(0)
                       DataList.Add CSng(0)
                       DataList.Add CDbl(0.0)
                       DataList.Add Now
                       DataList.Add #4/13/1953 12:13:14#
                       DataList.Add CStr("")
                       DataList.Add CStr(" ")
                       DataList.Add CStr("This is just a test string")
                       DataList.Add New RegExp
                       DataList.Add CreateObject("Scripting.FileSystemObject")
                       DataList.Add Err
                       DataList.Add False
                       DataList.Add True
                       DataList.Add CByte(0)
                       DataList.Add Array()
                       
                       MyArray=DataList.ToArray
                       
                       ReDim Preserve MyArray(UBound(MyArray) + 1 )
                       MyArray(19) = CCur(1.1)
                       
                       For Each strItem in MyArray
                            Wscript.Echo TypeName(strItem) & " = " & vartype(strItem) 
                       Next
                       
                      <message edited by ginolard on Wednesday, June 20, 2007 7:58 PM>
                      Author of ManagePC - http://managepc.net

                      #11
                        ehvbs

                        • Total Posts : 3312
                        • Scores: 110
                        • Reward points : 0
                        • Joined: 6/22/2005
                        • Location: Germany
                        • Status: offline
                        RE: Weekly/Monthly Challenge? Thursday, June 21, 2007 5:22 AM (permalink)
                        0
                        Hi all ye worthy contenders!

                        The most important question first:

                        (1) The price: If we get some more interesting/inspiring contributions I would send
                              to the winner (determined by a poll (?) or mutual consense): A German book
                              about VBScript for Beginners with a dedication/devotement signed by me stating
                              that the winner doesn't need the book

                        (2) Looks like sample data for all types can be fabricated now: the literals Empty,
                              Null und Nothing come handy; the global Err object can be use directly (but see
                              (3)); "CDate(Now())" seems a bit tautologous to me

                        (3) Did you spot that for the Err object the TypeName is object but the VarType
                              is 3 (Long)? That came as a nasty surprise for me!

                        (4) Decimal isn't supported by VBScript, so I wouldn't reject a JoinX() that skips
                              this data type; I believe that ginolard's roundabout way via .NET changed
                              his VBScript Currency variable into a Decimal - but I'm not sure

                        (5) dm_4ever started with the concatenation functionality. Good start, but it
                              looks very complicated to me - isn't there a more simple way? - remember
                              you'll have to cope with an Array containing an Array containing ...
                             
                        (6) As to the escape (?) to .NET: We (ok - I) want a function JoinX() that can
                              be used as easily as Join(). We (ok - I) wouldn't like the necessity to convert
                              my VBScript arrays to .NET Arraylists. I would renege on this statement if
                              somebody can show/prove that the Arraylist can be joined without further
                              programming, like sJoined = DataList.Join( ", " ).

                        Looking forwards to more interesting ideas and code!

                        ehvbs

                        #12
                          ginolard

                          • Total Posts : 1347
                          • Scores: 23
                          • Reward points : 0
                          • Joined: 8/11/2005
                          • Status: offline
                          RE: Weekly/Monthly Challenge? Thursday, June 21, 2007 8:17 AM (permalink)
                          0
                          Bah - now he's moving the goalposts!

                          ;)
                          Author of ManagePC - http://managepc.net

                          #13
                            ehvbs

                            • Total Posts : 3312
                            • Scores: 110
                            • Reward points : 0
                            • Joined: 6/22/2005
                            • Location: Germany
                            • Status: offline
                            RE: Weekly/Monthly Challenge? Thursday, June 21, 2007 8:26 AM (permalink)
                            0
                            Hi ginolard,

                            that wasn't my intention. Could you give me a hint about the movement -
                            I will try to make myself clear(er).

                            ehvbs
                            #14
                              ginolard

                              • Total Posts : 1347
                              • Scores: 23
                              • Reward points : 0
                              • Joined: 8/11/2005
                              • Status: offline
                              RE: Weekly/Monthly Challenge? Thursday, June 21, 2007 8:02 PM (permalink)
                              0
                              Well, not allowing DataLists....I thought I was on to a winner there ;)
                              Author of ManagePC - http://managepc.net

                              #15
                                ebgreen

                                • Total Posts : 8088
                                • Scores: 95
                                • Reward points : 0
                                • Joined: 7/12/2005
                                • Status: offline
                                RE: Weekly/Monthly Challenge? Friday, June 22, 2007 3:02 AM (permalink)
                                0
                                I have not had much time to look at this, but it did remind me of something that I wrote a very long time ago. I wrote this code when I was learning VBScript so that I could understand dictionaries. It doesn't directly have to do with joining arrays, but the recursive approach that it takes could be a useful point in a possible direction for someone with more time than I have right now.
                                 
                                Option Explicit
                                 Dim oDic
                                 Dim arrTest
                                 Dim oTemp
                                 Dim oTemp2
                                 Set oDic = CreateObject("Scripting.Dictionary")
                                 oDic.Add "String", "Test"
                                 oDic.Add "Bool", True
                                 oDic.Add "Int", 1
                                 arrTest = Array("1", "2")
                                 oDic.Add "Array", arrTest
                                 Set oTemp = CreateObject("Scripting.Dictionary")
                                 oTemp.Add "First", "One"
                                 oTemp.Add "Second", "Two"
                                 oDic.Add "Dictionary", oTemp
                                 Set oTemp = Nothing
                                 Set oTemp2 = CreateObject("Scripting.Dictionary")
                                 otemp2.add "Uno", 1
                                 otemp2.Add "Dos", 2
                                 oDic("Dictionary").Add "secondDic", oTemp2
                                 oDIc("Dictionary")("secondDic").Add "Tres", 3
                                 WScript.Echo oDIc("Dictionary")("secondDic")("Tres")
                                 ShowDic oDic, "oDic", 0
                                 Sub ShowDic(oD, strName, Indent)
                                     Dim strSpace
                                     Dim strKey
                                     strSpace = Space(Indent * 4)
                                     For Each strKey In oD.Keys()
                                         Select Case TypeName(oD.Item(strKey))
                                             Case "Integer"
                                                 WScript.Echo strSpace & strName & "(" & strKey & ") => " & oD.Item(strKey)
                                             Case "String"
                                                 WScript.Echo strSpace & strName & "(" & strKey & ") => " & oD.Item(strKey)
                                             Case "Boolean"
                                                 WScript.Echo strSpace & strName & "(" & strKey & ") => " & oD.Item(strKey)
                                             Case "Variant()"
                                                 ShowArray oD.Item(strKey), strKey, Indent + 1
                                             Case "Dictionary"
                                                 ShowDic od.Item(strKey), strKey, Indent + 1
                                             Case Else
                                                 WScript.Echo "UNKNOWN TYPE: " & TypeName(od.Item(strKey)) & " " & strName & "(" & strKey & ") => " & oD.Item(strKey)
                                         End Select
                                     Next
                                 End Sub
                                 Sub ShowArray(oA, strName, Indent)
                                     Dim strSpace
                                     Dim  i
                                     strSpace = Space(Indent * 4)
                                     For i = 0 To UBound(oA)
                                         Select Case TypeName(oA(i))
                                             Case "Integer"
                                                 WScript.Echo strSpace & strName & "(" & i & ") => " & oA(i)
                                             Case "String"
                                                 WScript.Echo strSpace & strName & "(" & i & ") => " & oA(i)
                                             Case "Boolean"
                                                 WScript.Echo strSpace & strName & "(" & i & ") => " & oA(i)
                                             Case "Variant()"
                                                 ShowArray oA(i), strName & "(" & i & ")", Indent + 1
                                             Case "Dictionary"
                                                 ShowDic oA(i), strName & "(" & i & ")", Indent + 1
                                             Case Else
                                                 WScript.Echo "UNKNOWN TYPE: " & TypeName(od.Item(strKey)) & " " & strName & "(" & strKey & ") => " & oD.Item(strKey)
                                         End Select
                                     Next
                                 End Sub        
                                     

                                "... when you are good and crazy, oooh, oooh, oooh, the sky is the limit!" - The Tick
                                Goog places to start:http://www.visualbasicscript.com/m_24727/tm.htm
                                http://www.visualbasicscript.com/m_47117/tm.htm
                                #16
                                  DiGiTAL.SkReAM

                                  • Total Posts : 1259
                                  • Scores: 7
                                  • Reward points : 0
                                  • Joined: 9/7/2005
                                  • Location: Clearwater, FL, USA
                                  • Status: offline
                                  RE: Weekly/Monthly Challenge? Saturday, June 23, 2007 1:54 PM (permalink)
                                  0
                                  I've gotta admit, I'm completely lost as to what you are looking for, ehvbs.
                                  First off, all variables are type variant in vbs.  Never heard of 'subtypes'.
                                   
                                  It sounds like you are looking for some kind of recursive element-testing function, that tests each element in an array to see if that element is an array itself.  If it is, it tests each of those elements, etc.  And then it joins each array/element together.
                                   
                                   arrA = array(1,2,3)
                                   arrB = array(4,5,6)
                                   arrC = array(arrA,arrB)
                                   arrD = Array("testing",arrC,"hobosoda")
                                   wscript.echo xjoin(arrD,",")
                                    
                                    
                                   Function xjoin(arr1,sSep)
                                        Dim oDic
                                        Set oDic = CreateObject("Scripting.Dictionary")
                                        For Each thing In arr1 
                                                  If IsArray(thing) Then 
                                                       sJoined = xjoin(thing,sSep)
                                                  Else
                                                       sJoined = thing
                                                  End If 
                                             oDic.Add oDic.Count,sJoined
                                        Next 
                                        xjoin = Join(oDic.Items,sSep)
                                   End Function
                                   

                                   
                                  Is that what you are looking for?  I am unsure as all this talk of subtypes has made me somewhat dizzy.
                                  "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
                                  #17
                                    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, June 24, 2007 5:43 AM (permalink)
                                    0
                                    I have to admit I am a bit confused as to what the expected output should be as well.

                                    DiGiTAL.SkReAM, I like the way you used the dictionary to build the new array and join it...decided to change mine to use the same technique

                                    So after changing a few things....

                                     Option Explicit
                                     
                                     On Error Resume Next
                                     Err.Raise(6)
                                     Dim oErr : oErr = Err
                                     On Error GoTo 0
                                     Dim arrTest : arrTest = Array(Empty, Null, 0, CLng(0), CSng(0), CDbl(0), CCur(0), CDate(Now()), "", New Regexp, oErr, CBool(0), Array(0,1,2,3,4), CreateObject("ADOConnectObject.ADOConnectObject"), 0.0, CByte(0))
                                     
                                     WScript.Echo JoinX(arrTest, "|")
                                     WScript.Echo VbCrLf 
                                     WScript.Echo JoinX(getDTSample(), ",")
                                     
                                     Function JoinX(arrInput, strSeperator)
                                         Dim objDict : Set objDict = CreateObject("Scripting.Dictionary")
                                         Dim intElem, strOutput
                                         For intElem = 0 To UBound(arrInput)
                                             Select Case True
                                                 Case IsArray(arrInput(intElem)) 
                                                     strOutput = JoinX(arrInput(intElem), strSeperator)
                                                 Case TypeName(arrInput(intElem)) = "Null"
                                                     strOutput = "<NULL>"
                                                 Case IsObject(arrInput(intElem))
                                                     strOutput = TypeName(arrInput(intElem))
                                                 Case Else
                                                     strOutput = CStr(arrInput(intElem))
                                             End Select
                                             objDict.Add objDict.Count, strOutput
                                         Next
                                         JoinX = Join(objDict.Items, strSeperator)
                                     End Function
                                     
                                     Function getDTSample()
                                         Dim dicAll : Set dicAll = CreateObject( "Scripting.Dictionary" )
                                         '   vbEmpty         0 Uninitialized (default)
                                         dicAll( "vbEmpty"     ) = Array( True, Empty )
                                         '   vbNull          1 Contains no valid data
                                         dicAll( "vbNull"      ) = Array( True, Null  )
                                         '   vbInteger       2 Integer subtype
                                         dicAll( "vbInteger0"  ) = Array( True, CInt(  0 )  )
                                         dicAll( "vbInteger1"  ) = Array( True, CInt( -1 )  )
                                         '   vbLong          3 Long subtype
                                         dicAll( "vbLong0"     ) = Array( True, CLng(  0 )  )
                                         '   vbSingle        4 Single subtype
                                         dicAll( "vbSingle0"   ) = Array( True, CSng(  0.0 )  )
                                         '   vbDouble        5 Double subtype
                                         dicAll( "vbDouble0"   ) = Array( True, CDbl(  0.0 )  )
                                         '   vbCurrency      6 Currency subtype
                                         dicAll( "vbCurrency0" ) = Array( True, CCur(  0.0 )  )
                                         '   vbDate          7 Date subtype
                                         dicAll( "vbDate0"     ) = Array( True, Now )
                                         dicAll( "vbDate1"     ) = Array( True, #4/13/1953 12:13:14# )
                                         '   vbString        8 String subtype
                                         dicAll( "vbString0"   ) = Array( True, "" )
                                         dicAll( "vbString1"   ) = Array( True, " " )
                                         dicAll( "vbString2"   ) = Array( True, "Alle Vögel sind schon da." )
                                         '   vbObject        9 Object
                                         dicAll( "vbObject0"   ) = Array( True, New RegExp )
                                         dicAll( "vbObject1"   ) = Array( True, CreateObject( "Scripting.FileSystemObject" ) )
                                         '   vbError        10 Error subtype
                                         dicAll( "vbError"     ) = Array( True, Err )
                                         '   vbBoolean      11 Boolean subtype
                                         dicAll( "vbBoolean0"  ) = Array( True, False )
                                         dicAll( "vbBoolean1"  ) = Array( True, True  )
                                         '   vbVariant      12 Variant (used only for arrays of variants)
                                         '   vbDataObject   13 Data access object
                                         '   vbDecimal      14 Decimal subtype
                                         '   vbByte         17 Byte subtype
                                         dicAll( "vbByte0"     ) = Array( True, CByte( 0 )  )
                                         '   vbArray      8192 Array
                                         '   vbVarArray   8204 Array of Variants
                                         dicAll( "vbVarArray0" ) = Array( True, Array(1,2,3,4))
                                         
                                         ReDim aRVal( dicAll.Count - 1 )
                                         Dim   nCnt : nCnt = -1
                                         Dim   sKey
                                         For Each sKey In dicAll.Keys
                                             If dicAll( sKey )( 0 ) Then
                                                 nCnt = nCnt + 1
                                                 If IsObject( dicAll( sKey )( 1 ) ) Then
                                                     Set aRVal( nCnt ) = dicAll( sKey )( 1 )
                                                 Else
                                                     aRVal( nCnt ) = dicAll( sKey )( 1 )
                                                 End If
                                             End If
                                         Next
                                         ReDim Preserve aRVal( nCnt )
                                         getDTSample = aRVal
                                     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
                                    #18
                                      ehvbs

                                      • Total Posts : 3312
                                      • Scores: 110
                                      • Reward points : 0
                                      • Joined: 6/22/2005
                                      • Location: Germany
                                      • Status: offline
                                      RE: Weekly/Monthly Challenge? Tuesday, June 26, 2007 10:04 AM (permalink)
                                      0
                                      Hi all virtual and real participants,

                                      sorry about the delay and the necessity to clarify my intentions.

                                      (1) VBScript Datatypes:
                                          DiGiTAL.SkReAM is right to say that all VBScript variables (and expressions,
                                          constants, and even functions -

                                                Function funcNix( a )
                                                  WScript.Echo "funcNix called"
                                                  funcNix = "Nix"
                                                End Function

                                                Const csName = "ehvbs"
                                                WScript.Echo 0, TypeName( 2 * 2  ), VarType( 2 * 2  )
                                                WScript.Echo 1, TypeName( csName ), VarType( csName )
                                                Set fncSelf = GetRef( "funcNix" )
                                                WScript.Echo 2, TypeName( fncSelf ), VarType( fncSelf )

                                            ==>

                                                0 Integer 2
                                                1 String 8
                                                2 Object 9

                                          ) are Variants. But as the functions TypeName() and VarType() show, each
                                          VBScript entity belongs to some subtype (String, Integer, ...).

                                      (2) Shortcomings of Join():
                                          One context in which those subtypes show their (ugly) face is the
                                          Join() function. If you send an array like

                                                Array( 1, "test", New RegExp )

                                          to Join(), you will get an error, because Join() can't handle variants
                                          of subtype Object or Array to name just a few. The challenge is to write
                                          a JoinX() function that will process an array with all - or at least the
                                          most important - subtypes in a sensible way. To exercise/test/prove this
                                          JoinX() function you need an array of sample data. That's why I included
                                          "Create an Array aTest with at least one sample for each possible subtype"
                                          a part of the challenge.
                                          Even for variable(subtype)s that are handled by Join() it could be asked
                                          whether the output format is desirable for all purposes. If you are interested
                                          to see what's in your arrays, Join() will disguise differences:

                                                WScript.Echo 1, Join( Array( 1, Empty, 3 ), "," )
                                                WScript.Echo 2, Join( Array( 1, "", 3 ), "," )
                                                WScript.Echo 3, Join( Array( 1, "2", 3 ), "," )
                                                WScript.Echo 4, Join( Array( 1,  2 , 3 ), "," )
                                                WScript.Echo 5, Join( Array( 1,  "2,3" ), "," )

                                            output:

                                                1 1,,3
                                                2 1,,3
                                                3 1,2,3
                                                4 1,2,3
                                                5 1,2,3

                                          If your ultimate aim is some kind of serialisation, Join() will help you
                                          in some very few/resticted cases:

                                                Dim aIntsOnly : aIntsOnly = Array( 1, 2, 3 )
                                                Dim sIntsOnly : sIntsOnly = Join( aIntsOnly, "," )
                                                WScript.Echo 6, sIntsOnly
                                                sIntsOnly = "Array( " + sIntsOnly + ")"
                                                aIntsOnly = Eval( sIntsOnly )
                                                WScript.Echo 7, Join( aIntsOnly, "," )

                                            output:

                                                6 1,2,3
                                                7 1,2,3

                                          but fail under all other circumstances.
                                          Things like that make me wish for a better Join().

                                      (3) No restrictions:
                                          My remarks concerning ginolard's use of the .NET ArrayList weren't meant
                                          to exclude this - or any other - approach to a solution. If it works, it's
                                          ok. But I'd consider a JoinX() function better that wouldn't involve a
                                          transformation from VBScript Array to .NET ArrayList, especially as ginolard
                                          himself pointed out problems with the Currency subtype. But this personal
                                          preference won't rule out that a poll/some other form of mutual agreement
                                          declares ginolard's solution (enhanced by a JoinX() function) the winner.
                                          As I said, if the .Net ArrayList will make join part easier, then I would
                                          even take back my sceptic words about ginolard's idea.

                                      (4) Getting the data:
                                          I believe we got enough examples of how to fill an array with sample data
                                          to enable everybody interested in this challenge to concentrate on the
                                          JoinX() function. There may be some details - e.g. the Err object - to discuss
                                          and while we probably can agree on excluding the Decimal subtype (you can't
                                          create such a variable anyway) we may have to ponder, whether or not DataObjects
                                          can/should be handled.

                                      (5) Recursive JoinX():
                                          The JoinX() function has to recursive to handle Arrays (and Dictionaries?,
                                          thanks for the remainder, ebgreen!). If you compare ebgreen's recursive dictionary
                                          lister to the approaches proposed by DiGiTAL.SkReAM and dm_4ever, you will
                                          see an important difference: While ebgreen's code keeps the hierarchical
                                          structure of the input array, both DiGiTAL.SkReAM's and dm_4ever's functions
                                          'flatten' the structure (like the arguments to a sub in Perl are 'flattened'
                                          in one continous array). Code like this

                                             Dim aOne : aOne = Array( 1, 2, 3, 4 )
                                             Dim aTwo : aTwo = Array( Array( 1, 2 ), Array( 3, 4 ) )
                                             WScript.Echo "aOne:", JoinX( aOne, "|" )
                                             WScript.Echo "aTwo:", JoinX( aTwo, "|" )

                                          will get you output like this:

                                              cscript  digitalscream01.vbs
                                              aOne: 1|2|3|4
                                              aTwo: 1|2|3|4

                                              cscript dm_4ever01.vbs
                                              aOne: 1|2|3|4
                                              aTwo: 1|2|3|4

                                          but

                                              Dim aOne : aOne = Array( 1, 2, 3, 4 )
                                              Dim aTwo : aTwo = Array( Array( 1, 2 ), Array( 3, 4 ) )
                                              WScript.Echo "aOne: ----------"
                                              ShowArray aOne, "aOne", 0
                                              WScript.Echo "aTwo: ----------"
                                              ShowArray aTwo, "aTwo", 0

                                          results in:

                                              cscript ebgreen01.vbs
                                              aOne: ----------
                                              aOne(0) => 1
                                              aOne(1) => 2
                                              aOne(2) => 3
                                              aOne(3) => 4
                                              aTwo: ----------
                                                  aTwo(0)(0) => 1
                                                  aTwo(0)(1) => 2
                                                  aTwo(1)(0) => 3
                                                  aTwo(1)(1) => 4

                                          Which way is 'better'? Do we have to decide? Perl's flattening of arguments to
                                          a sub is a successful design decision, but Data::Dumper works hard to keep the
                                          internal structure of the dumped variables. Serialisation would be impossible
                                          with a flattening version of JoinX(), but do we need it?

                                      (6) The nits to pick:
                                          I posted this challenge, because I'm in need of a suitable JoinX() function
                                          and I hoped to get some insight/ideas/code from you. This hope is being
                                          fullfilled. Thanks for all the past - and future - efforts you put into this.
                                          My critical remarks are intended as arguments/questions/suggestions in a
                                          peer to peer discussion, not as judgements of an arrogant teacher about
                                          the pupils homework.

                                          dm_4ever's last proprosal is 'nearly there', but I don't like the treatment
                                          of Empty. If Null gets <Null> then Empty should get <Empty> - and what about
                                          Nothing? Perhaps adding suitable delimiters - string => "string", date =>
                                          #date#, array => Array(JoinX(array)) - would improve the lucidity of the
                                          output, handle the recursion/structure problem and pave the way for seriali-
                                          sation? I'm wondering, whether DiGiTAL.SkReAM's tactic of using a dictionary
                                          to collect the reworked items of the original array to feed the keys to
                                          VBScript's own Join() [nice trick, by the way] is the most efficient in this
                                          special case. Couldn't you use an array instead because you can

                                             ReDim aTmp( UBound( arrInput )
                                             
                                          before the loop - no need for dynamic growing here? Neither for strOutput
                                         
                                            aTmp( intElem ) = <whatever>
                                           
                                          and at the end just
                                         
                                            JoinX = Join(aTmp, strSeperator)
                                           
                                          Surely putting a value in an existing array slot is more efficient than
                                          adding a new item to a dictionary?
                                         
                                          DiGiTAL.SkReAM nearly solved the problem although he was 'completely lost as
                                          to what' I was looking for. Just a bit more work in this ELSE part

                                              Else
                                                sJoined = thing
                                              End If

                                          to handle the difficult subtypes ( Empty, Null, ... ). Perhaps a crossbred
                                          with dm_4ever's SELECT
                                         
                                              Else
                                                Select Case True
                                                   Case TypeName( thing ) = "Null"
                                                       sJoined = "<NULL>"
                                                   Case IsObject( thing )
                                                       sJoined = TypeName( thing )
                                                   ....
                                                   Case Else
                                                       sJoined = CStr( thing )
                                                End Select       
                                              End If
                                          
                                          Thanks to ebgreen for demonstrating the keeping of the data structure in
                                          his recursive directory lister. I really hope, you can spare some time to
                                          look at this again - the SELECT
                                         
                                            Select Case TypeName(oA(i))
                                                 Case "Integer"
                                                     WScript.Echo strSpace & strName & "(" & i & ") => " & oA(i)
                                                    
                                          could be combined with DiGiTAL.SkReAM's or dm_4ever's code for collecting
                                          and joining the elements.
                                         
                                          ginolard's contribution lacks the joining part of the problem. Perhaps
                                          he could outrun everybody - if he can harness the .NET String.Join( sSep,
                                          aList ) function.


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

                                      ehvbs
                                      #19
                                        DiGiTAL.SkReAM

                                        • Total Posts : 1259
                                        • Scores: 7
                                        • Reward points : 0
                                        • Joined: 9/7/2005
                                        • Location: Clearwater, FL, USA
                                        • Status: offline
                                        RE: Weekly/Monthly Challenge? Tuesday, June 26, 2007 11:17 AM (permalink)
                                        0

                                        ORIGINAL: ehvbs
                                           I'm wondering, whether DiGiTAL.SkReAM's tactic of using a dictionary
                                           to collect the reworked items of the original array to feed the keys to
                                           VBScript's own Join() [nice trick, by the way] is the most efficient in this
                                           special case. Couldn't you use an array instead because you can

                                              ReDim aTmp( UBound( arrInput )
                                              
                                           before the loop - no need for dynamic growing here? Neither for strOutput
                                          
                                             aTmp( intElem ) = <whatever>
                                            
                                           and at the end just
                                          
                                             JoinX = Join(aTmp, strSeperator)
                                            
                                           Surely putting a value in an existing array slot is more efficient than
                                           adding a new item to a dictionary?
                                          

                                         
                                        You are correct.  Taking a look at this code, that can be proven rather easily:
                                         Option Explicit 
                                         Dim oFSO, i, iIterations, x, t1, t2, t3, e1, e2, e3, iNumItems
                                         Set oFSO = CreateObject("Scripting.FileSystemObject")
                                         iNumItems = 10000
                                         ReDim aData(iNumItems)
                                          For i = 0 To (iNumItems - 1)
                                           aData(i) = oFSO.GetTempName
                                          Next 
                                         iIterations = 3
                                         t1 = Timer
                                          For x = 1 To iIterations
                                           ArrayBuilderWithRedim
                                          Next 
                                         e1 = Timer - t1
                                         t2 = Timer
                                          For x = 1 To iIterations
                                           DicBuilder
                                          Next 
                                         e2 = Timer - t2
                                         t3 = Timer
                                          For x = 1 To iIterations
                                           ArrayBuilderWithoutRedim
                                          Next 
                                         e3 = Timer - t3
                                         WScript.Echo "Array With Redim : " & e1 & VbCrLf & "Dictionary : " & e2 & VbCrLf & "Array Without Redim : " & e3
                                         Sub ArrayBuilderWithRedim
                                          Dim aTest, iCount, item, s
                                          iCount = 0
                                           For Each item In aData
                                            iCount = iCount + 1 
                                            ReDim aTest(iCount)
                                            aTest(iCount) = item
                                           Next
                                          s = Join(aTest,",")
                                         End Sub
                                         Sub DicBuilder
                                          Dim oDic, item, s
                                          Set oDic = CreateObject("Scripting.Dictionary")
                                           For Each item In aData
                                            oDic.Add oDic.Count,item
                                           Next 
                                          s = Join(oDic.Items,",")
                                         End Sub
                                         Sub ArrayBuilderWithoutRedim
                                          ReDim aTest(iNumItems)
                                          Dim item, s, n
                                           For n = 0 To UBound(aTest)
                                            aTest(n) = aData(n)
                                           Next
                                          s = Join(aTest,",")
                                         End Sub
                                         

                                         
                                        However, I defend my choice of using the dictionary due to ... um... ginolard made me do it!  *I* didn't want to, but he told me that I HAD to!!!
                                        Ok, ok... it was just being lazy.  Dictionaries are just too easy to use.
                                        "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
                                        #20

                                          Online Bookmarks Sharing: Share/Bookmark
                                          Change Page: 1234 > | Showing page 1 of 4, messages 1 to 20 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