OCIBreak analog in managed ODP.NET - oracle

I'm trying to migrate to managed ODP.NET, but I'm having problems with the OCIBreak.
Friend Shared Sub Break(dbConn As OracleConnection)
Dim ContextHandle = DirectCast(dbConn.GetType.GetProperty("ServiceContextHandle", ref.BindingFlags.Instance Or ref.BindingFlags.NonPublic).GetValue(dbConn, Nothing), Runtime.InteropServices.SafeHandle)
Dim ErrorHandle = DirectCast(dbConn.GetType.GetProperty("ErrorHandle", ref.BindingFlags.Instance Or ref.BindingFlags.NonPublic).GetValue(dbConn, Nothing), Runtime.InteropServices.SafeHandle)
OCIBreak(ContextHandle, ErrorHandle)
End Sub
<Runtime.InteropServices.DllImport("oci.dll", CallingConvention:=Runtime.InteropServices.CallingConvention.Cdecl)>
Private Shared Function OCIBreak(Context As Runtime.InteropServices.SafeHandle, ErrorHandle As Runtime.InteropServices.SafeHandle) As Integer
End Function
What I found out, you can partially emulate it using following code.
Private Sub Cancel(conn As OracleConnection)
Using cmd = New OracleCommand("", conn)
cmd.Cancel()
End Using
End Sub
I expect this to work, because OracleCommand.Cancel cancels currently running command, which is not necessarily this one (docs).
And it actually does work this way - but only for SELECT-queries, it doesn't cancel PL/SQL-blocks or stored procedures. It is still possible to cancel those, but only via the corresponding OracleCommand-instance.
Is it possible to achieve somehow? Maybe there is a way to get that currently running command from oracle connection object?

Related

How to get rid of prompt on quitting MS ACCESS

I am running a Sub procedure stored in an ACCESS database using VBScript. The procedure queries the database and exports/saves a CSV file.
My problem is that the script successfully opens the database, runs the procedure but then leaves ACCESS open because ACCESS opens a prompt asking "Are you sure that you want to leave ACCESS" (rather its equivalent in German). I want it to close without interaction.
The basic idea of this script is to run it via the Windows Task Scheduler. (Which does not work right now but that is another question.)
Here is the part of my VBScript dealing with the ACCESS database:
Dim objAccess
Set objAccess = createObject("Access.Application")
objAccess.OpenCurrentDataBase("C:\FiselTools\Allgemein\Scripte\Pellenc-CopyBelegarchiv3.accdb")
objAccess.Run "CopyBelegarchiv"
objAccess.Quit acQuitSaveAll
Set objAccess = Nothing
Using this script manually, it does open the database, export the file, finally executes the part following the code from above - so only closing ACCESS does not work and my guess is that it's not a problem with the script or the procedure but the ACCESS.
Erik A basically gave the right answer: there was some VBA code that is responsible for this prompt (see below). It was part of the primary form.
So in this case I found two possible solutions:
Do not display/show the form (which worked for me as I made a copy of the file dedicated for just this purpose).
If you need the form then you might need to delete the VBA code.
Private Sub Form_Unload(Cancel As Integer)
Dim Answer As Variant
Answer = MsgBox("Wollen Sie die Anwendung wirklich beenden?" & vbNewLine & vbNewLine & "Nicht gespeicherte Änderungen gehen dabei möglicherweise verloren", vbQuestion + vbYesNo + vbDefaultButton2)
If Answer = vbNo Then
Cancel = True
Else
DoCmd.Quit acQuitSaveNone
End If
End Sub
Since it is part of the Access class object of the form that is configured to be displayed on opening the ACCESS database and I do not need the form when I run the procedure via VBScript I simply changed the database to not display any form when the database is opened.
Some day I will remove any form, query, and any other object not needed from this special copy of the database that I don't need to run from VBScript.
Thanks!

Creating a view and agent in multiple databases

The problem I am encountering is that some of the messages are not accessible by the user ID file, I would like to skip these files instead of the agent crashing out. The error message received is as follows:
Using the view approach if this happened I was able to delete the document temporarily and re-run the agent but if there is a way to skip documents it would be a great help.
Thanks for the help guys.
Ok I have amended the code to a point where I am almost comfortable with it.
Sub Initialize
Dim s As New notessession
Dim db As notesdatabase
Dim view As notesview
Dim doc As notesdocument
Dim nextdoc As notesdocument
Set db = s.currentdatabase
If view Is Nothing Then
Set view = db.CreateView("Encrypted",{Encrypt="1"})
End If
Set doc = view.getfirstdocument
On Error Goto ErrorHandler
While Not doc Is Nothing
nextDocument:
Set nextdoc = view.getnextdocument(doc)
'The below loop is mandatory to ensure that all $File entries are unecrypted
Forall i In doc.items
If i.isencrypted Then
i.isencrypted=False
End If
End Forall
'Must have at least 1 field encrypted in order to call Encrypt method
Dim temp As New NotesItem(doc,"tempjunk","temp")
temp.IsEncrypted=True
Call doc.encrypt
Call doc.save(True, False)
'This portion can now remove the fields relative to encrypting the
'single token encrypted field.
Call doc.removeitem("$Seal")
Call doc.removeitem("$SealData")
Call doc.removeitem("SecretEncryptionKeys")
Call doc.removeitem("Encrypt")
Call doc.removeItem("tempjunk")
Call doc.save(True, False)
Set doc = nextdoc
Wend
Exit Sub
ErrorHandler:
On Error Resume nextDocument
Exit Sub
End Sub
The error handling is not playing nice;
On Error Resume nextDocument is showing up as an error.
I have tried suppressing all of the error warnings which seems to attempt to strip the encryption but I think they body of the messages is being destroyed as a result.
It is no problem to create an agent in a container database and let that agent access documents in all "target" databases and modify them accordingly - No need to copy that agent to all databases.
Only restriction: If the databases are on another server, then on the server security tab of the target server you have to enter the server with the container database as trusted server.
AND: If your agent runs longer than the allowed maximum run time for agents on the server, then it will be killed prematurely.
There is no need to create views in the target databases, you can use NotesDatabase.Search() to get the corresponding documents in the databases...
You can create views by copying them from another database. Say you create a view "Encrypted" in your db with the agent.
Then add a piece of code to get a handle of this view as a NotesDocument:
Dim dbThis As NotesDatabase
Dim viewTemplate As NotesView
Dim docView As NotesDocument
Set dbThis = s.currentDatabase
Set viewTemplate = dbThis.getView("Encrypted")
Set docView = dbThis.Getdocumentbyunid(viewTemplate.Universalid)
In the agent loop, test if view Encrypted exists, if not copy the "view template":
Set view = db.getview("Encrypted")
If view Is Nothing Then
Call docView.Copytodatabase(db)
Set view = db.getview("Encrypted")
End If
Finally, if you insist, a similar procedure might be used to copy the agent to all databases, but for me the idea of running the agent in one db sounds better.
Edited: In the view of full disclosure - of course you can create a view (I guess that was the original question).
If view Is Nothing Then
Set view = db.Createview("Encrypted", {Encrypt="1"})
End If
Or do one-shot dbSearch suggested by Torsten, with a good re-mark of Richard - if you intend to run your code several times - say if encrypted documents might get created again or re-encrypted, rather go for the view.
My method is a bit old fashioned (pre-dates availability of createView) and works well if you need more than selection formula, so you can pre-build a complicated view for re-use.
Performance-wise: whatever method you will choose either creating view using createView or copying from other db or doing dbSearch there is going to be a certain slow-down while the view gets built or dbSearch executes. Karl-Henry's approach will avoid this search/view build, but will be relatively slow if there are not many encrypted documents.
Whichever method you choose - here is a small tip to boost performance. Make your loops like this to release memory as you go; for example, assuming Karl-Henry's approach:
Dim doc1 as NotesDocument
Set doc = col.GetFirstDocument()
Do Until doc Is Nothing
Set doc1 = col.GetNextDocument(doc)
formname = doc.GetItemValue("Form")(0)
If IsElement(exclude(formname))=False Then
Call RemoveEncryption(doc) '*** Your function to remove encryption
End If
' releasing memory when processing thousands of documents improves performance and avoids crashes
Delete doc
Set doc = doc1
Loop
Now again, as you are talking only about migration (so one shot) of 20+ databases, the speed or implementation details should not be that critical.
If you have to process all (or almost all) documents in each database, you can use db.AllDocuments. It is more efficient than using db.Search() with an #All formula.
If you want to exclude certain documents, perhaps based on the form name, I would build a list of forms to exclude, and then use IsElement to check each document being processed against that list.
Dim exclude List As Boolean
exclude("FormA")=True
exclude("FormB")=True
Set col = db.AllDocuments
Set doc = col.GetFirstDocument()
Do Until doc Is Nothing
formname = doc.GetItemValue("Form")(0)
If IsElement(exclude(formname))=False Then
Call RemoveEncryption(doc) '*** Your function to remove encryption
End If
Set doc = col.GetNextDocument(doc)
Loop
Something like that. By the way, you can create the list as any data type. I just choose Boolean as it is a small data type, and that it makes the code easier to read. The IsElement() function just check if the element exists, it does not use the value you set.
You would wrap the code above in a function and call it once per database.
Appended answer, based on additional info in original question:
That should not be hard, just add error handling to your code.
Before you start to loop throung the document:
On Error Goto errHandler
Before you get the next document in the loop:
nextDocument:
At the end of your code:
Exit Sub
errHandler:
Resume nextDocument
End Sub
Try that.

Stringify a method call in VBScript

I'm currently working every day with QuickTest Professional 11, which uses VBScript behind the scenes. Lately, I've started developing some of my own functions to handle common situations. I'm pretty new to VBscript, most of my programming experience is in C and Python.
I'm trying to implement Python's Try/Except in VBScript, mostly to wrap around actions like clicking links or selecting values from dropdown boxes. Here's what I have so far:
Class cls_ErrorHandler
Private bWasError
Private Sub Class_Initialize()
bWasError = False
End Sub
Private Sub IsErr
If Err.Number <> 0 Then
bWasError = True
Else
bWasError = False
End If
Err.Clear
End Sub
' If the command fails, set bWasError
Public Sub Try(strCommandToTry)
On Error Resume Next
Execute(strCommandToTry)
me.IsErr
On Error Goto 0
End Sub
Public Sub Except(strCommandInCaseOfError)
If bWasError Then
Execute(strCommandInCaseOfError)
End If
bWasError = False
End Sub
End Class
I'd like to be able to write things like this:
Set oErrorHandler = New cls_ErrorHandler
oErrorHandler.Try(Stringify(Browser("Browser Name").Page("Page Name").WebCheckBox("Checkbox Name").Set "ON"
oErrorHander.Except(Stringify(Browser("Browser Name").Page("Page Name").WebButton("Save").Click))
As far as I can tell, there really isn't any nice way to pass a function as an argument to another function in VBScript. The best way seems to be to pass a string containing the name of a function, and then feed that string into Execute() or Eval(). Objects in QuickTest Professional tend to have lots of quotation marks, so escaping them all by hand would make the code unreadable.
In C, I'd use something like this:
#define Stringify(obj) #obj
and it would be done... but nothing like that seems to exist in VBScript. Is there any way to implement this? Is there anything in VBScript that takes an object as its input and returns a string representation of that object's name? Would it be possible to write a DLL in C/C# that would provide this kind of functionality?
You can use GetRef to obtain a function/sub pointer, and call the function/sub using that pointer. See online help, it shows an example for an event handler, but you can refer to any global function or sub with GetRef, and use the variable holding the GetRef return value just like an alias for the sub/function.
Be aware, however, that there are cases you won't be able to cover with this:
You cannot use a GetRef function pointer if the current calling stack contains a
method call that is a function registered to a test object via
RegisterUserFunc.
You cannot call such a test object method from within a routine call
that was adressed via a GetRef function pointer.
Also consider using ExecuteGlobal instead of Execute so the code you pass can set global variables that the ExecuteGlobal caller can access afterwards.

"Method or Data Member Not Found" When Trying to Execute Database Code

I have a test project I'm using to familiarise myself with VB6. Just a listbox, a button to get info, and a button to clear info:
Code:
Option Explicit
Private Sub btnGet_Click()
lstResults.DataSource = GetMenuItems
End Sub
Private Sub btnClear_Click()
lstResults.Clear
End Sub
Public Function GetMenuItems() As ADODB.Recordset
Dim rs As ADODB.Recordset
Dim conn As New ADODB.Connection
conn.ConnectionString = "File Name=C:\connString.udl"
Dim cmd As New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "dbo.GetMenuItems"
Set rs = cmd.Execute()
GetMenuItems = rs
End Function
The following error appears when I click the Get Items button (btnGet):
Compile Error: Method or Data Member Not Found
At first I thought it might be something to do with the event/button, that some sort of binding between them wasn't present. But just putting in something like "MsgBox("Hello")" works fine. Yet it doesn't even seems to get to the line where the GetMenuItems function is called before throwing the error.
This being my first whirl with VB, I'm a little stumped.
EDIT - I've had a look at the UDL file I was using too. Tested that and its connecting ok on its own.
In Sub btnGet_Click, use
Set lstResults.DataSource = GetMenuItems
Assigning object references without using Set is hardly ever the right thing to do. For what it's worth, omitting Set references the left-hand side's default property; this was part of VB6 (OK, VB4, when classes were introduced) as a help to VB3 programmers, before there were such things as objects. Whatever kind of object lstResults.DataSource returns likely does not have a default property, leading to the "Method or data member not found" error.
You've got a private sub btnGet_Click() calling a public function GetMenuItems(), which may cause problems.
Also I'm not sure you can use a udl as the connection string. Instead, open the UDL (you may need to change the file extension to .txt temporarily), take the connection string out, and use that in place of the file name.
Also, check the stored procedure exists dbo.GetMenuItems

Legacy VB6 app throwing type mismatch error during ActiveX create object

I've been tasked with making a change to a legacy VB6 Winform app. What I found is that this app was unnecessarily split up into multiple DLLs (some of the DLL were simply a couple of classes). So, I'm working on consolidating some of the DLLs into the main program but I've run into a problem that I could use some help on.
One of the dlls contained a class called CTest(Test.cls). The main program used it in the following lines of code. strProgId is a string naming another DLL.
Dim objTest As CTest
Set objTest = CreateTestObject(strProgId)
Public Function CreateTestObject(strProgId As String) As Object
10 On Error GoTo ErrorHandler
20 Set CreateTestObject = CreateObject(strProgId)
30 Exit Function
ErrorHandler:
40 UpdateErrorInfo "CreateTestObject", "Globals", strProgId
50 HandleError
End Function
Here are the contents of CTest
Option Explicit
Private m_strName As String
Private m_strDescription As String
Private m_cnnADO As ADODB.Connection
Public Property Get Name() As String
10 Name = m_strName
End Property
Public Property Let Name(strNewName As String)
10 m_strName = strNewName
End Property
Public Property Get Connection() As ADODB.Connection
10 Set Connection = m_cnnADO
End Property
Public Property Set Connection(cnnADO As ADODB.Connection)
10 Set m_cnnADO = cnnADO
End Property
Public Property Get Description() As String
10 Description = m_strDescription
End Property
Public Property Let Description(strNewDescription As String)
10 m_strDescription = strNewDescription
End Property
Public Function Run(ByVal strSTMType As String, _
instInstruments As CInstruments, objResults As CTestResults) As Boolean
End Function
If CTest is still part of a DLL and I have a reference to it in the Main Program, it gets through the CreateTestObject line without an error. If I bring in the class into the main program it throws a type mismatch error.
Any help is appreciated, thank you in advance.
CreateObject will only work with publicly visible COM classes. Therefore, because you've brought CTest into your main program, CreateObject will no longer work and will raise errors just like you describe.
Either
Create the object via Set obj = New CTest
Or just leave the class in a separate DLL? Are you sure there's no other side effects of it being in a separate DLL? No other app using it?
I just solved this one after a day and a half. In my case I invoke the dll twice. The first time it worked and the second time it threw the error above. I have several projects open and each has its' own compatibility setting. For some unexplained reason the second reference to the common dll had compatibility set off. By setting the correct path in the version compatability and setting it to binary compatibility the problem cleared up.
If you're bringing CTest into your main program directly, then you don't need the CreateObject call - just instantiate it the normal way, now that it's part of your program, and it should work fine.

Resources