In my loop I am trying to remove items from a list that have a certain name. I can't do this with a for-each, so I tried a regular for-loop. It seems the for loop is not working as expected. It always goes over the limit. I had to put an if-then to break out of the loop (very ugly solution). I'm trying to find the correct way to accomplish this.
Dim canShowNextTable As Boolean = False
Dim allTablesInTab As List(Of Control) = ctrlFinder.GetTypeOfControls("Table", parentForm.Controls)
Dim totalTables As Integer = allTablesInTab.Count - 1
For i As Integer = 0 To totalTables
If allTablesInTab.Item(i).ID = "CustomerTable" Or _
allTablesInTab.Item(i).ID = "PMTable" Or _
allTablesInTab.Item(i).ID = "TableAListClrnCheck" Or _
allTablesInTab.Item(i).ID = "TableBListClrnCheck" Or _
allTablesInTab.Item(i).ID = "TableCListClrnCheck" Or _
allTablesInTab.Item(i).ID = "TableDListClrnCheck" Or _
allTablesInTab.Item(i).ID = "TableSignature" Then '' If the ID is one of these remove it from list
allTablesInTab.Remove(allTablesInTab.Item(i))
totalTables = totalTables - 1 '' Decrement number of tables to loop through
i = -1 '' Reset counter to prevent going over or premature stopping
End If
If i = 3 AndAlso totalTables = 3 Then '' Since loop continuously goes over limit, use if-then to exit for-loop
Exit For
End If
Next
You need to traverse your loop in reverse because once you remove an item the total count has changed and is no longer correct. Looping in reverse avoids this issue.
For i As Integer = totalTables To 0 Step -1
Also, instead of allTablesInTab.Remove(allTablesInTab.Item(i)) you can use:
allTablesInTab.RemoveAt(i)
Work through this logic on paper or the debugger to properly grasp the concept of what's happening. You might also find this related question useful. It's in C# but the concepts are the same: How to remove elements from a generic list while iterating around it?
Related
I am using OpenOffice Calc spreadsheet formulas with psuedo-random numbers to generate arrays of arithmetic problems which I can easily update to creating new worksheets (I'm a teacher)
Problems are output as formula mark-ups in string form. OOo Math formulas use these string commands typed into the editor to display nicely formatted maths expressions.
I can do this next step manually:
1) go to source cell and copy string mark-up to clipboard
2) select target cell and clear existing contents and objects
3) create new Math object anchored to target cell
4) open Math editor window and paste in mark-up string
5) exit Math editor window and return cursor to source cell
Result: a nice maths expression of given arithmetic problem.
I need to be able to do this for entire columns of source cells on various sheets.
...even better, to then add a listener to dynamically update as sources are updated.
I found code here: Cell content inside formula that achieves this for a fixed pair of cells, but despite all my best efforts, I have had to admit defeat - generalising this code is simply beyond my expertise!
The absolute ideal would be a macro function that I could call like a spreadsheet function; with input arguments (sourceCell, targetCell, listenerON/OFF) that could run the above algorithm and dynamically update if required.
Can anybody help me? A solution like this, or any kind of workaround would be immensely helpful.
UPDATE 2016/10/27
Thank you Jim K, that did work, but use of the dispacher comes with a whole host of difficulties I hadn't foreseen.
I just found Charlie Young's post in the OpenOffice forum which makes use of the API. I have included my adaptation of his code below.
Can anybody help me to integrate it into a function in a similar way as I've described? I don't know how to solve placement of the Math object in to the target cell.
The API code is great as it will create a new Math object each time the code is updated. Existing ones do need to be deleted though.
I think the limitation of not being able to delete existing objects from within a function is going to persist. Would this be the case even if done by a subroutine called by the function?
function InsertFormula(paraFromCell, paraToCell)
Dim oDoc As Object
Dim oSheet As Object
Dim oShape As Object
oDoc = ThisComponent
oSheet = oDoc.Sheets(0)
oShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")
oShape.CLSID = "078B7ABA-54FC-457F-8551-6147e776a997"
oSheet.Drawpage.Add(oShape)
oShape.Model.Formula = paraFromCell
oShape.setSize(oShape.OriginalSize)
end function
NEXT UPDATE
I've been managing to solve my own problems quite quickly now...
I've decided to go with a sub, not a function, so I can access the sheet to delete existing objects. Code is attached - Source cells are in Column C and target cells in matching rows of Column A. So far I am only able to send objects to $A$1.
How do I anchor each new object to a specific cell?
REM ***** BASIC *****
Sub InsertThisFormula
Dim oDoc As Object
Dim oSheet As Object
Dim oShape As Object
Dim sourceCell As Object
Dim targetCell As Object
oDoc = ThisComponent
oSheet = oDoc.Sheets(1)
Dim n As Integer
n = 1 'number of rows of formulas
for i = 0 To n-1
rem loop through cells
sourceCell = oSheet.getCellByPosition(2, i)
targetCell = oSheet.getCellByPosition(0, i)
rem clear target cell object/s
targetCell.ClearContents(128)
oShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")
oShape.CLSID = "078B7ABA-54FC-457F-8551-6147e776a997"
oSheet.Drawpage.Add(oShape)
oShape.Model.Formula = sourceCell.string
oShape.setSize(oShape.OriginalSize)
Next i
End Sub
Starting from Mifeet's example, add this to My Macros:
rem ----------------------------------------------------------------------
rem Creates a math formula from text
Function InsertFormulaFromCell(paramCellFrom, paramCellTo)
dim document as object
dim dispatcher as object
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem go to cell containing markup and copy it
dim fromCellArgs(0) as new com.sun.star.beans.PropertyValue
fromCellArgs(0).Name = "ToPoint"
fromCellArgs(0).Value = paramCellFrom
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, fromCellArgs())
dispatcher.executeDispatch(document, ".uno:Copy", "", 0, Array())
rem go to cell where I want the formula displayed
dim toCellArgs(0) as new com.sun.star.beans.PropertyValue
toCellArgs(0).Name = "ToPoint"
toCellArgs(0).Value = paramCellTo
dispatcher.executeDispatch(document, ".uno:GoToCell", "", 0, toCellArgs())
rem open Star.Math
oDesk = createUnoService ("com.sun.star.frame.Desktop")
dispatcher.executeDispatch(document, ".uno:InsertObjectStarMath", "", 0, Array())
document = ThisComponent.CurrentController.Frame
dispatcher = createUnoService("com.sun.star.frame.DispatchHelper")
rem paste clipboard using Array() as place-holder for variable name
dispatcher.executeDispatch(document, ".uno:Paste", "", 0, Array())
rem exit Star.Math
dispatcher.executeDispatch( _
document, ".uno:TerminateInplaceActivation", "", 0, Array())
InsertFormulaFromCell = "Math Formula updated " & Now()
End Function
To run it, put this formula in cell C5:
=INSERTFORMULAFROMCELL("$C$3","$C$20")
Now when the values get updated, it creates another formula.
Note: I could not get the .uno:Delete section of Mifeet's code to work, perhaps because functions are not supposed to access other cells. This may require manually deleting the formulas before creating new ones.
(Posted solution on behalf of the OP).
This is now solved. After a lot of searching, I found what I needed! Simple really. Future improvements might be to resize cells appropriately. Happy for now. Thanks to Jim K and the rest of the Stack Overflow community!
Complete macro below:
REM ***** BASIC *****
Sub InsertThisFormula
Dim oDoc As Object
Dim oSheet As Object
Dim oShape As Object
Dim sourceCell As Object
Dim targetCell As Object
oDoc = ThisComponent
oSheet = oDoc.Sheets(1)
Dim n As Integer
n = 6 'number of rows of formulas
for i = 0 To n-1
rem loop through cells
sourceCell = oSheet.getCellByPosition(2, i)
targetCell = oSheet.getCellByPosition(3, i)
rem clear target cell object/s
targetCell.ClearContents(128)
oShape = oDoc.createInstance("com.sun.star.drawing.OLE2Shape")
oShape.CLSID = "078B7ABA-54FC-457F-8551-6147e776a997"
oSheet.Drawpage.Add(oShape)
oShape.Model.Formula = sourceCell.string
oShape.setSize(oShape.OriginalSize)
oShape.Anchor = targetCell
oShape.MoveProtect = True
Next i
End Sub
I cannot explain well in the title so i'll explain here the scenario:
In here, i have a query that will be placed in an array.
Dim arrUsers As Object = {{sqlReader("dephead"), dropdown1}, {sqlReader("mm"), dropdown2}
I want to enable the dropdown object if it matches my if else condition:
'indexes1= the 1st indexes of each pair in the array (the sqlReaders)
'indexes2= my dropdown objects in my user control
For Each indexes1 In arrUsers
If Session.Item("EmployeeID") = indexes1 Then
indexes2.Enabled = True
End If
Next
so lets say the my session id will be "dephead", then the dropdown1 will be enabled. Thats what i would like to happen but im not familiar on arrays so kindly help me. Thanks.
This should work:
For i As Integer = 0 to arrUsers.GetUpperBound(0)
If Session.Item("EmployeeID") = arrUsers(i)(0) Then
arrUsers(i)(1).Enabled = True
End If
Next
You simply give the array two indexes instead of one. arrUsers(0)(1), for example. The first index returns the object at that index, and the second index returns the object inside the previously returned array. arrUsers(0)(1) will first grab the array at 0 index ({sqlReader("dephead"), dropdown1}), then get the object at index 1 (dropdown1).
This answered my question. The answer above helped me and i just changed the declaration of my arrays and changed some syntax.
Dim arrUsers(,) As Object =
New Object(,) {
{sqlReader("dephead"), dropdown1}, _
{sqlReader("mm"), dropdown2}, _
}
Dim bound0 As Integer = arrUsers.GetUpperBound(0)
Dim bound1 As Integer = arrUsers.GetUpperBound(1)
For i As Integer = 0 To bound0
If Session.Item("EmployeeID") = arrUsers(i, 0) Then
arrUsers(i, 1).Enabled = True
End If
Next
Given the following array as an example...
arr(0)(0) = 3
arr(0)(1) = name
arr(0)(2) = address
arr(1)(0) = 7
arr(1)(1) = name
arr(1)(2) = address
arr(2)(0) = 14
arr(2)(1) = name
arr(2)(2) = address
I need to delete the middle element (id=7) from the array. I understand that I need to loop through the array and move each record that isnt to be deleted into a new array. I tried like this...
Dim newArr,i
Redim newArr(Ubound(arr))
For i = 0 to Ubound(arr)
If (CStr(arr(i)(0)) <> 7 ) Then
newArr(i) = arr(i)
End if
Next
When debugging this I can see the if statement work so I know only 2 elements are copied but newArr is empty at the end of this. What am I missing. I am a PHP coder that is new to classic asp and Im used to having array functions that make this kind of thing unnecessary. Any help appreciated. Thank you.
You don't need new array, you can just reassign the items and "crop" the array:
Const removalIndex = 1
For x=removalIndex To UBound(arr)-1
arr(x) = arr(x + 1)
Next
ReDim Preserve arr(UBound(arr) - 1)
This code will remove the array item at index 1 from the main array. If you don't know in advance the index of the item to remove, you can easily find it with a simple loop over the array.
Instead of using array you can give Scripting.Dictionary a try.
It is much more flexible, and has, among others Remove method.
I suggest using Scripting.Dictionary and using it as a List/collection instead, as it allows for insertions and deletions. See here: Lists in VBScript
I don't know the definitive answer, but if I were to take a stab in the dark guess I'd suggest that since the array is two dimensional maybe you have to explicitly refer to it that way?
Dim newArr,i
Redim newArr(Ubound(arr),3)
For i = 0 to Ubound(arr)
If (CStr(arr(i)(0)) <> 7 ) Then
newArr(i)(0) = arr(i)(0)
newArr(i)(1) = arr(i)(1)
newArr(i)(2) = arr(i)(2)
End if
Next
I see some VBScript syntax issues. First:
arr(0)(0) = 3 'ERROR: Subscript out of range
arr(0, 0) = 3 'CORRECT
Next:
ReDim newArr(Ubound(arr)) 'this is 1 dimensional array
newArr(0) = arr(0) 'this will NOT work
newArr(0) = arr(0, 0) 'this will work
And finally: why you convert to String and then compare it to an Integer with:
(CStr(arr(i)(0)) <> 7)
Are there any simple encrypt/decrypt functions in Classic ASP?
The data that needs to be encrypted and decrypted is not super sensitive. So simple functions would do.
4guysfromrolla.com: RC4 Encryption Using ASP & VBScript
See the attachments at the end of the page.
The page layout looks a bit broken to me, but all the info is there. I made it readable it by deleting the code block from the DOM via bowser development tools.
Try this:
' Encrypt and decrypt functions for classic ASP (by TFI)
'********* set a random string with random length ***********
cryptkey = "GNQ?4i0-*\CldnU+[vrF1j1PcWeJfVv4QGBurFK6}*l[H1S:oY\v#U?i,oD]f/n8oFk6NesH--^PJeCLdp+(t8SVe:ewY(wR9p-CzG<,Q/(U*.pXDiz/KvnXP`BXnkgfeycb)1A4XKAa-2G}74Z8CqZ*A0P8E[S`6RfLwW+Pc}13U}_y0bfscJ<vkA[JC;0mEEuY4Q,([U*XRR}lYTE7A(O8KiF8>W/m1D*YoAlkBK#`3A)trZsO5xv#5#MRRFkt\"
'**************************** ENCRYPT FUNCTION ******************************
'*** Note: bytes 255 and 0 are converted into the same character, in order to
'*** avoid a char 0 which would terminate the string
function encrypt(inputstr)
Dim i,x
outputstr=""
cc=0
for i=1 to len(inputstr)
x=asc(mid(inputstr,i,1))
x=x-48
if x<0 then x=x+255
x=x+asc(mid(cryptkey,cc+1,1))
if x>255 then x=x-255
outputstr=outputstr&chr(x)
cc=(cc+1) mod len(cryptkey)
next
encrypt=server.urlencode(replace(outputstr,"%","%25"))
end function
'**************************** DECRYPT FUNCTION ******************************
function decrypt(byval inputstr)
Dim i,x
inputstr=urldecode(inputstr)
outputstr=""
cc=0
for i=1 to len(inputstr)
x=asc(mid(inputstr,i,1))
x=x-asc(mid(cryptkey,cc+1,1))
if x<0 then x=x+255
x=x+48
if x>255 then x=x-255
outputstr=outputstr&chr(x)
cc=(cc+1) mod len(cryptkey)
next
decrypt=outputstr
end function
'****************************************************************************
Function URLDecode(sConvert)
Dim aSplit
Dim sOutput
Dim I
If IsNull(sConvert) Then
URLDecode = ""
Exit Function
End If
'sOutput = REPLACE(sConvert, "+", " ") ' convert all pluses to spaces
sOutput=sConvert
aSplit = Split(sOutput, "%") ' next convert %hexdigits to the character
If IsArray(aSplit) Then
sOutput = aSplit(0)
For I = 0 to UBound(aSplit) - 1
sOutput = sOutput & Chr("&H" & Left(aSplit(i + 1), 2)) & Right(aSplit(i + 1), Len(aSplit(i + 1)) - 2)
Next
End If
URLDecode = sOutput
End Function
I know is a bit late for BrokenLink, but for the record and others like me who were looking for the same.
I found this https://www.example-code.com/vbscript/crypt_aes_encrypt_file.asp.
It needs to install a chilkat ActiveX component on WindowsServer. But this inconvenient becomes convenient when looking resources and processing time.
Its very easy to use, and the given example is pretty clear. To make it your own, just change the "keyHex" variable value and voilá.
I'm making a fair amount of calls to database tables via ADO.
In the spirit of keeping things DRY, I wrote the following functions to return an array of values from a recordset.
Is this hare brained?
I use it mainly for grabbing a set of combo-box values and the like, never for enormous values. Example Usage (error handling removed for brevity):
Function getEmployeeList()
getEmployeeList= Array()
strSQL = "SELECT emp_id, emp_name from employees"
getEmployeeList = getSQLArray( strSQL, "|" )
End Function
Then I just do whatever I want with the returned array.
Function getSQLArray( SQL, delimiter )
'*************************************************************************************
' Input a SQL statement and an optional delimiter, and this function
' will return an array of strings delimited by whatever (pipe defaults)
' You can perform a Split to extract the appropriate values.
' Additionally, this function will return error messages as well; check for
' a return of error & delimiter & errNum & delimiter & errDescription
'*************************************************************************************
getSQLArray = Array()
Err.Number = 0
Set objCon = Server.CreateObject("ADODB.Connection")
objCon.Open oracleDSN
Set objRS = objCon.Execute(SQL)
if objRS.BOF = false and objRS.EOF = false then
Do While Not objRS.EOF
for fieldIndex=0 to (objRS.Fields.Count - 1)
If ( fieldIndex <> 0 ) Then
fieldValue = testEmpty(objRS.Fields.Item(fieldIndex))
recordString = recordString & delimiter & fieldValue
Else
recordString = CStr(objRS.Fields.Item(fieldIndex))
End If
Next
Call myPush( recordString, getSQLArray )
objRS.MoveNext
Loop
End If
Set objRS = Nothing
objCon.Close
Set objCon = Nothing
End Function
Sub myPush(newElement, inputArray)
Dim i
i = UBound(inputArray) + 1
ReDim Preserve inputArray(i)
inputArray(i) = newElement
End Sub
Function testEmpty( inputValue )
If (trim( inputValue ) = "") OR (IsNull( inputValue )) Then
testEmpty = ""
Else
testEmpty = inputValue
End If
End Function
The questions I'd have are:
Does it make sense to abstract all the recordset object creation/opening/error handling into its own function call like this?
Am I building a Rube Goldberg machine, where anyone maintaining this code will curse my name?
Should I just suck it up and write some macros to spit out the ADO connection code, rather than try doing it in a function?
I'm very new to asp so I have holes in its capabilities/best practices, so any input would be appreciated.
There's nothing wrong with doing it your way. The ADO libraries were not really all that well designed, and using them directly takes too many lines of code, so I always have a few utility functions that make it easier to do common stuff. For example, it's very useful to make yourself an "ExecuteScalar" function that runs SQL that happens to return exactly one value, for all those SELECT COUNT(*)'s that you might do.
BUT - your myPush function is extremely inefficient. ReDim Preserve takes a LONG time because it has to reallocate memory and copy everything. This results in O(n2) performance, or what I call a Shlemiel the Painter algorithm. The recommended best practice would be to start by dimming, say, an array with room for 16 values, and double it in size whenever you fill it up. That way you won't have to call ReDim Preserve more than Lg2n times.
I wonder why you are not using GetRows? It returns an array, you will find more details here: http://www.w3schools.com/ado/met_rs_getrows.asp
A few notes on GetRows:
Set objRS = Server.CreateObject ("ADODB.Recordset")
objRS.Open cmd, , adOpenForwardOnly, adLockReadOnly
If Not objRS.EOF Then
astrEmployees = objRS.GetRows()
intRecFirst = LBound(astrEmployees, 2)
intRecLast = UBound(astrEmployees, 2)
FirstField = 0
SecondField = 1
End If
'2nd field of the fourth row (record) '
Response.Write (SecondField, 3)
Yes, it makes sense to factor out common tasks. I don't see anything wrong with the general idea. I'm wondering why you're returning an array of strings separated by a delimiter; you might as well return an array of arrays.