Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1439
  • Last Modified:

VBScript Array shift

I need to represent the hours of the week, divided into 8 hour blocks, in an array using vbScript.  This will result in an 8 column x 21 row array, which goes from right to left, and top to bottom.  This will represent the hours that a user can log onto a computer, where "0" means not allowed and "1" means allowed.  The hard part is, I need to introduce an integer for the timezone, which shifts each element in the arrays (assuming Greenwich means 0 shift, Eastern Standard would be 5, etc).  For example, a shift of 2 will push the last 2 elements from row 0 to the first 2 elements of row 1...and row 21 will push to row 0.  It is also important to note that the rows have static Day & hour Mappings.

Row0: Saturday 16-23:59
Row1: Sunday 0-7:59
Row2: Sunday 8-15:59
Row3: Sunday 16-23.59
Row4: Monday 0-7:59
......
Row20: Saturday 0-7:59
Row21: Saturday 8-15:59

To create the array, I can use the following code:
'Create 21x8 array (Day,Hours)
Dim arrLogonHrs(21,8)
'Zero Fill Array
For i = 1 to 21
  For j = 1 to 8
    arrLogonHrs(i,j) = 0
  Next
Next

The array will look as follows:
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000
00000000

To input how the hours, days, and timezone it will be a true or false (like a check box stating the 24 hours and 7 days which then populate zero filled array with 1's and shifting it appropriately)

Essentially, I am stuck on creating a good way to do the timezone shift.  If you have any further questions, or my explanation was not well, let me know.

Thanks
0
deadite
Asked:
deadite
  • 4
  • 3
1 Solution
 
basicinstinctCommented:
Copy the code below, paste it into an empty text file, call it arrayshift.vbs (or whatever) and run it.

Note:I do not guarantee this algorithm is perfect, I gave it a shot but there is still some work for you to do in terms of testing it and integrating it with your code.  I was not sure whether to post it, but I know what it's like to be stuck, and I thought this would help you get 'unstuck'.  Good luck.



'START CODE
Const upperRow = 20
Const upperCol = 7
Const cols = 2
Dim arrLogcolsonHrs
ReDim arrLogonHrs(upperRow,upperCol)
'Zero Fill Array
For i = LBound(arrLogonHrs) to UBound(arrLogonHrs)
  For j = LBound(arrLogonHrs, cols) to UBound(arrLogonHrs, cols)
    arrLogonHrs(i,j) = 0
    arrLogonHrs(i,(i mod UBound(arrLogonHrs, cols))) = 1 'this is just to fill with test data - remove this line
  Next
Next

MsgBox "This is the array we will shift" & vbcrlf &  PrintArray(arrLogonHrs)
MsgBox "This is the array shifted" & vbcrlf &   PrintArray(ShiftArray(cols, arrLogonHrs))

Function ShiftArray(shift, theArray())
      Dim tmp
      ReDim tmp(upperRow,upperCol)
      Dim tmpRow
      Dim tmpCol  
      If shift > 0 Then
            If Int(shift / (UBound(tmp, cols) + 1)) > 1 then
                  tmpRow = Int(shift / (UBound(tmp, cols) + 1)) - 1
            else
                  tmpRow = 0
            end if
            tmpCol = shift mod (UBound(tmp, cols) + 1)
            For i = LBound(tmp) to UBound(tmp)
              For j = 0 to UBound(tmp, cols)
                    If tmpCol mod (UBound(tmp, cols) + 1) = 0 Then
                          tmpRow = tmpRow + 1
                    End If
                    tmp(tmpRow mod (UBound(tmp) + 1), tmpCol mod (UBound(tmp, cols) + 1)) = theArray(i, j)
                  tmpCol = tmpCol + 1
              Next
            Next
      ElseIf shift = 0 Then
            ShiftArray = theArray
      End If      
      ShiftArray = tmp
End Function

Function PrintArray(theArray)
      For i = LBound(theArray) to UBound(theArray)
        For j = LBound(theArray, cols) to UBound(theArray, cols)
          s = s & theArray(i,j)
        Next
        s = s & vbcrlf
      Next
      PrintArray = s
End Function
'END CODE
0
 
basicinstinctCommented:
By the way, the function which does the work has this signature:

Function ShiftArray(shift, theArray())


Pass it the array you want to shift (theArray) and the amount you want to shift it by (shift).

In my example I called it like this:

ShiftArray(cols, arrLogonHrs)

That was a mistake, doesn't hurt but makes it unclear.  It shoudl have been:

ShiftArray(2, arrLogonHrs)

I just went crazy replacing literals with constants with 'find/replace'.

For example, if you want to shift by 5, call it like this:

ShiftArray(5, arrLogonHrs)
0
 
deaditeAuthor Commented:
It will probably take me a day to test your code out, but at a quick glance it is looks good.  So far my attempt at it looks a bit like this:


'****************************
'INPUT VARIABLES FROM WEBFORM
'****************************

'Input Timezone Shift Variable
Dim tzShift
tzShift = 5

'Input Hour Variable
Dim hr0,hr1,hr2,hr3,hr4,hr5,hr6,hr7,hr8,hr9,hr10,hr11,hr12,hr13,hr14,hr15,hr16,hr17,hr18,hr19,hr20,hr21,hr22,hr23
hr0 = False
hr1 = False
hr2 = False
hr3 = False
hr4 = False
hr5 = False
hr6 = False
hr7 = True
hr8 = True
hr9 = True
hr10 = True
hr11 = True
hr12 = True
hr13 = True
hr14 = True
hr15 = True
hr16 = True
hr17 = True
hr18 = True
hr19 = False
hr20 = False
hr21 = False
hr22 = False
hr23 = False
Dim arrHour
arrHour = array(hr0,hr1,hr2,hr3,hr4,hr5,hr6,hr7,hr8,hr9,hr10,hr11,hr12,hr13,hr14,hr15,hr16,hr17,hr18,hr19,hr20,hr21,hr22,hr23)

'Input Day Variable
Dim daySun,dayMon,dayTue,dayWed,dayThu,dayFri
daySun = False
dayMon = True
dayTue = True
dayWed = True
dayThu = True
dayFri = True
daySat = False



'****************************
'INITIALIZE arrLogonHrs
'****************************
'Create 21x8 array (Day,Hours)
Dim arrLogonHrs(21,8)

'Zero Fill Array
For i = 1 to 21
  For j = 1 to 8
    arrLogonHrs(i,j) = 0
  Next
Next



'****************************
'Map Array Row with Day
'****************************
Dim test(10)
Dim arrSun
arrSun = array(1,2,3)

Dim arrMon
arrMon = array(4,5,6)

Dim arrTue
arrTue = array(7,8,9)

Dim arrWed
arrWed = array(10,11,12)

Dim arrThu
arrThu = array(13,14,15)

Dim arrFri
arrFri = array(16,17,18)

Dim arrSat
arrSat = array(19,20,0)



'****************************
'Test Logon Days
'****************************

If daySun = True Then
  writeHrs(arrSun)
End If

If dayMon = True Then
  writeHrs(arrMon)
End If

If dayTue = True Then
  writeHrs(arrTue)
End If

If dayWed = True Then
  writeHrs(arrWed)
End If

If dayThu = True Then
  writeHrs(arrThu)
End If

If dayFri = True Then
  writeHrs(arrFri)
End If

If daySat = True Then
  writeHrs(arrSat)
End If


'Check Our Answers
For i = 1 to 21
  row = row & vbCrLf & "Row " & i & ":" & vbTab
  For j = 1 to 8
    row = row & arrLogonHrs(i,j)
  Next
Next

MsgBox row



Sub writeHrs(arrDay)
  For i = 0 to 23
    If i < 8 Then  '****GOOD I THINK
      'Set Day & Hour Array Position to Initial Position
      tmpDay = arrDay(0)
      testHour = arrHour(i)
     
      'Hour is Checked
      If testHour = True Then
          'Shift Hour According to TimeZone
          tmpHour = i + tzShift
          'MsgBox "i=" & i & vbcrlf & "tzShift=" & tzShift & vbcrlf & "tmpHour = " & i & " + " & tzShift & " = " & tmpHour
     
          'Push Extra Data From Shift to Next Row
          If tmpHour > 7 Then
            tmpDay = tmpDay + 1
            If tmpDay > 20 Then
              tmpDay = 0
            End If
            tmpHour = tmpHour - 8
          End If
          arrLogonHrs(tmpDay,tmpHour) = 1
          'MsgBox "Write To Array" & vbcrlf & "Day:" & tmpDay & vbcrlf & "Hour:" & tmpHour
      End If
    Elseif i < 16 Then  '*****TEST
      'Set Day & Hour Array Position to Initial Position
      tmpDay = arrDay(1)
      testHour = arrHour(i)
     
      'Hour is Checked
      If testHour = True Then
          'Shift Hour According to TimeZone
          tmpHour = i + tzShift
          'MsgBox "i=" & i & vbcrlf & "tzShift=" & tzShift & vbcrlf & "tmpHour = " & i & " + " & tzShift & " = " & tmpHour
     
          'Push Extra Data From Shift to Next Row
          If tmpHour > 15 Then
            tmpDay = tmpDay + 1
            If tmpDay > 20 Then
              tmpDay = 0
            End If
            tmpHour = tmpHour - 8
          End If
          'arrLogonHrs(tmpDay,tmpHour) = 1
          'MsgBox "Write To Array" & vbcrlf & "Day:" & tmpDay & vbcrlf & "Hour:" & tmpHour
      End If
    Elseif i < 24 Then  '*****TEST

    End If
  Next
End Sub
0
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
basicinstinctCommented:
Hi

I haven't had a chance to look at your code properly.  I have, however, made some changes to the algorithm I gave you yesterday.  The changes are:

1. I think it had some mistakes in it.
2. I made it more readable (I hope).
3. Time differences can be positive or negative.  Did you think of that?  So the shift needs to handle positive numbers (like a shift of +5 hours) AND negative numbers (like -5 hours).  The new algorithm handles that too.

One comment on your code, I will try to get a look at it properly later, but I'm uncomfortable with the way you are using your VB arrays.  For example, here you say:

'Create 21x8 array (Day,Hours)
Dim arrLogonHrs(21,8)

Well if you have been using any other programming language (Java, C# etc) that would be correct.  In VB however, you have created a 22x9 array.  In this statement:

Dim arrLogonHrs(21,8)

You are not saying "21 by 8 elements" you are saying "let the upper indexex be 21 and 8".  Because the arrays are zero based that gives dimensions of 22 x 9.

You seem to be somewhat aware of this, as you loop through the array using this instruction:

For i = 1 to 21

Well that works, but you have the poor old '0' array item sitting there doing nothing.  It is also not a good habit if you are programming in other lanugages.



Here's the new code:

'START CODE
Const UPPER_ROW = 20
Const UPPER_COL = 7
Const COL_DIMENSION = 2
Dim arrLogonHrs
ReDim arrLogonHrs(UPPER_ROW,UPPER_COL)
'Zero Fill Array
For i = LBound(arrLogonHrs) to UBound(arrLogonHrs)
  For j = LBound(arrLogonHrs, COL_DIMENSION) to UBound(arrLogonHrs, COL_DIMENSION)
    arrLogonHrs(i,j) = 0
    arrLogonHrs(i,(i mod UBound(arrLogonHrs, COL_DIMENSION))) = 1 'this is just to fill with test data - remove this line
  Next
Next

MsgBox "This is the array we will shift" & vbcrlf &  PrintArray(arrLogonHrs)
MsgBox "This is the array shifted" & vbcrlf &   PrintArray(ShiftArray(2, arrLogonHrs))

Function ShiftArray(shift, theArray())
      Dim tmp
      ReDim tmp(UPPER_ROW,UPPER_COL)
      Dim tmpRow
      Dim tmpCol
      Dim colCount
      Dim rowCount
      rowCount = UBound(tmp)
      colCount = UBound(tmp, COL_DIMENSION)
      If shift <> 0 Then
            If shift < 0 Then
                  tmpRow = Int(shift / (colCount)) + (rowCount + 1)
                  tmpCol = (colCount + 1) + shift
                  While tmpCol < 0
                        tmpCol = colCount + tempCol
                  Wend
                  MsgBox tmpCol
            ElseIf Int(shift / (colCount + 2)) >= 1 Then
                  tmpRow = Int(shift / (colCount + 1))
                  tmpCol = shift mod (colCount + 1)
            Else
                  tmpRow = 0
                  tmpCol = shift mod (colCount + 1)
            End If
            For i = LBound(tmp) to rowCount
              For j = 0 to colCount
                    If tmpCol mod (colCount + 1) = 0 Then
                          tmpRow = tmpRow + 1
                    End If
                    tmp(tmpRow mod (rowCount + 1), tmpCol mod (colCount + 1)) = theArray(i, j)
                  tmpCol = tmpCol + 1
              Next
            Next
      Else
            ShiftArray = theArray
      End If      
      ShiftArray = tmp
End Function

Function PrintArray(theArray)
      For i = LBound(theArray) to UBound(theArray)
        For j = LBound(theArray, COL_DIMENSION) to UBound(theArray, COL_DIMENSION)
          s = s & theArray(i,j)
        Next
        s = s & vbcrlf
      Next
      PrintArray = s
End Function
'END CODE
0
 
deaditeAuthor Commented:
Thanks for the comments,

I will check over this later today
0
 
deaditeAuthor Commented:
Hey,

You can basically any ugly mistakes in the code I pasted above... that was scratch that I worked on whenever I had 5 free minutes and changed more stuff than I can rememeber...  So I'm sure it's full of sloppy stuff.

Anyways, I tested your code and the shift works pefect.  You took it a bit further than I had planned, but works fine.  I only originally planned on use 0-24 for timezones, but this is nice and reusable.  

Incase you are wondering where this comes in handy, it is useful for writing logon hours in Active Directory (which microsofts doesn't provide example code for) and the only examples I found are for reading the array.  I could just write a few static arrays, but I found an issue on the domains I tested that seems to assume greenwhich timezone (because my arrays are shifted by the timezone set on the AD servers).  Here's a few links to further explain some details:

http://www.microsoft.com/technet/scriptcenter/scripts/ad/users/list/uslsvb05.mspx
http://groups.google.com/group/microsoft.public.scripting.wsh/browse_thread/thread/17859143dab3004d/af05cd305d82c2a7?lnk=st&q=loginHours+%22adodb.stream%22+group%3A*.scripting+author%3AMichael+Harris&rnum=3&hl=en#af05cd305d82c2a7
0
 
basicinstinctCommented:
thanks for that info dude - i was wondering what it was all about - glad it worked - it was kind of tricky - i gave up a few times but it had me in its grasp
0

Featured Post

What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

  • 4
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now