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.
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.
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
'****************************
'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
Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.
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
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:
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
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.
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,upper
'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
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