ascnd
asked on
Deterimine if Oracle Client is installed using Visual Basic VB
I need visual basic code to determine if a PC has Oracle client installed. This program would run on the PC and not remotely. It is part of a larger program. My app will not work if the Oracle Client is not installed so it must check for that first then give the user a warning message. I do NOT want the solution in .NET it has to be good ole VB.
and, do you care about client version?
If you find an oracle home but it turns out to be a version 7 client, do you still want to call that a success?
If you find an oracle home but it turns out to be a version 7 client, do you still want to call that a success?
ASKER
Successful check would be the presence of a home directory and I don't care about client version.
ASKER
Please refund my points and remove this question. I figured it out myself.
How did you do it? My app looks for the Oracle Home reg key
ASKER
I used the following code. Is it the same thing you did?
Option Compare Database
Option Explicit
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA" (ByVal lpApplicationName _
As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Public Function OracleClientExist(Optional ShowMsg As Integer) As Boolean
Dim intX As Integer
Dim strKeyOracle0 As String
Dim strValueNameOracle0 As String
Dim strValueOracle0 As String
Dim strDest As String
Dim blnNamesFound As Boolean
Dim strFoundLoc As String
Dim strOracle As String
Dim strErr As String
Dim fS As Object
Set fS = CreateObject("Scripting.Fi leSystemOb ject")
OracleClientExist = False
blnNamesFound = False
strOracle = ""
For intX = 0 To 20
strKeyOracle0 = "SOFTWARE\ORACLE\ALL_HOMES \ID" & intX
strValueNameOracle0 = "Path"
strValueOracle0 = QueryValue(strKeyOracle0, strValueNameOracle0)
If Not strValueOracle0 = "" Then
OracleClientExist = True
strOracle = strValueOracle0
strDest = strValueOracle0 & "\NETWORK\ADMIN\tnsnames.o ra"
If Dir(strDest) <> "" Then
blnNamesFound = True
strFoundLoc = strDest
End If
End If
Next intX
If OracleClientExist Then
If Not blnNamesFound Then
If fS.FolderExists(Left(strDe st, InStrRev(strDest, "\"))) Then
FileCopy Left(CurrentProject.Path, InStrRev(CurrentProject.Pa th, "\")) & "Resources\tnsnames.ora", strDest
End If
End If
End If
Exit Function
ErrorHandler:
strErr = Err.Number & " " & Err.Description
Select Case Err.Number
Case 0
Case Else
If ShowMsg = 1 Then MsgBox SplitErrText(strErr, 0), vbCritical, "OracleClientExist Error"
End Select
Err.Clear
End Function
Public Function QueryValue(sKeyName As String, sValueName As String)
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MA CHINE, sKeyName, 0, KEY_QUERY_VALUE, hKey)
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey, szValueName, 0&, lType, 0&, cch)
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKe y, szValueName, 0&, lType, _
sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey, szValueName, 0&, lType, _
lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
Option Compare Database
Option Explicit
Public Const REG_SZ As Long = 1
Public Const REG_DWORD As Long = 4
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_CURRENT_USER = &H80000001
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const HKEY_USERS = &H80000003
Public Const ERROR_NONE = 0
Public Const ERROR_BADDB = 1
Public Const ERROR_BADKEY = 2
Public Const ERROR_CANTOPEN = 3
Public Const ERROR_CANTREAD = 4
Public Const ERROR_CANTWRITE = 5
Public Const ERROR_OUTOFMEMORY = 6
Public Const ERROR_ARENA_TRASHED = 7
Public Const ERROR_ACCESS_DENIED = 8
Public Const ERROR_INVALID_PARAMETERS = 87
Public Const ERROR_NO_MORE_ITEMS = 259
Public Const KEY_QUERY_VALUE = &H1
Public Const KEY_SET_VALUE = &H2
Public Const KEY_ALL_ACCESS = &H3F
Public Const REG_OPTION_NON_VOLATILE = 0
Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Declare Function RegCreateKeyEx Lib "advapi32.dll" Alias _
"RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions _
As Long, ByVal samDesired As Long, ByVal lpSecurityAttributes _
As Long, phkResult As Long, lpdwDisposition As Long) As Long
Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, _
ByVal ulOptions As Long, ByVal samDesired As Long, phkResult As _
Long) As Long
Declare Function RegQueryValueExString Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As String, lpcbData As Long) As Long
Declare Function RegQueryValueExLong Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, lpData As _
Long, lpcbData As Long) As Long
Declare Function RegQueryValueExNULL Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As _
String, ByVal lpReserved As Long, lpType As Long, ByVal lpData _
As Long, lpcbData As Long) As Long
Declare Function RegSetValueExString Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, ByVal lpValue As _
String, ByVal cbData As Long) As Long
Declare Function RegSetValueExLong Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpValue As Long, _
ByVal cbData As Long) As Long
Public Declare Function GetPrivateProfileString Lib "kernel32" _
Alias "GetPrivateProfileStringA"
As String, ByVal lpKeyName As Any, ByVal lpDefault As String, _
ByVal lpReturnedString As String, ByVal nSize As Long, _
ByVal lpFileName As String) As Long
Public Function OracleClientExist(Optional
Dim intX As Integer
Dim strKeyOracle0 As String
Dim strValueNameOracle0 As String
Dim strValueOracle0 As String
Dim strDest As String
Dim blnNamesFound As Boolean
Dim strFoundLoc As String
Dim strOracle As String
Dim strErr As String
Dim fS As Object
Set fS = CreateObject("Scripting.Fi
OracleClientExist = False
blnNamesFound = False
strOracle = ""
For intX = 0 To 20
strKeyOracle0 = "SOFTWARE\ORACLE\ALL_HOMES
strValueNameOracle0 = "Path"
strValueOracle0 = QueryValue(strKeyOracle0, strValueNameOracle0)
If Not strValueOracle0 = "" Then
OracleClientExist = True
strOracle = strValueOracle0
strDest = strValueOracle0 & "\NETWORK\ADMIN\tnsnames.o
If Dir(strDest) <> "" Then
blnNamesFound = True
strFoundLoc = strDest
End If
End If
Next intX
If OracleClientExist Then
If Not blnNamesFound Then
If fS.FolderExists(Left(strDe
FileCopy Left(CurrentProject.Path, InStrRev(CurrentProject.Pa
End If
End If
End If
Exit Function
ErrorHandler:
strErr = Err.Number & " " & Err.Description
Select Case Err.Number
Case 0
Case Else
If ShowMsg = 1 Then MsgBox SplitErrText(strErr, 0), vbCritical, "OracleClientExist Error"
End Select
Err.Clear
End Function
Public Function QueryValue(sKeyName As String, sValueName As String)
Dim lRetVal As Long 'result of the API functions
Dim hKey As Long 'handle of opened key
Dim vValue As Variant 'setting of queried value
lRetVal = RegOpenKeyEx(HKEY_LOCAL_MA
lRetVal = QueryValueEx(hKey, sValueName, vValue)
QueryValue = vValue
RegCloseKey (hKey)
End Function
Function QueryValueEx(ByVal lhKey As Long, ByVal szValueName As _
String, vValue As Variant) As Long
Dim cch As Long
Dim lrc As Long
Dim lType As Long
Dim lValue As Long
Dim sValue As String
On Error GoTo QueryValueExError
' Determine the size and type of data to be read
lrc = RegQueryValueExNULL(lhKey,
If lrc <> ERROR_NONE Then Error 5
Select Case lType
' For strings
Case REG_SZ:
sValue = String(cch, 0)
lrc = RegQueryValueExString(lhKe
sValue, cch)
If lrc = ERROR_NONE Then
vValue = Left$(sValue, cch - 1)
Else
vValue = Empty
End If
' For DWORDS
Case REG_DWORD:
lrc = RegQueryValueExLong(lhKey,
lValue, cch)
If lrc = ERROR_NONE Then vValue = lValue
Case Else
'all other data types not supported
lrc = -1
End Select
QueryValueExExit:
QueryValueEx = lrc
Exit Function
QueryValueExError:
Resume QueryValueExExit
End Function
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
I'm going to award you the points just so I can close this.
oh wow thanks,
Its a shame there isnt a faster way to get the points back, as you are the only person to have really answered your own question.
Its a shame there isnt a faster way to get the points back, as you are the only person to have really answered your own question.
ASKER
I don't know what your experience has been like with EE but I have been a member since 01/2004 and I feel that there are too many people who just give drive by answers and then the question gets lost in a black hole. Lots of the so called "Experts" don't even read the question throughly and you end up having to reiterate the question again. I currently have four questions open that have been that way for quite some time.
it's true, while I have found many answers on EE - NONE of them have been answers posted to questions I have asked myself.
ASKER
Do you have any possible solutions to my other questions?
Sorry you haven't been happy with your EE experience. I wasn't trying to do a "drive by". I inquired for more details so I could provide as thorough and accurate an answer as possible. However I got swamped by own my projects the past week and couldn't get back to it. Particularly since your case isn't easy for me to work on because I don't have machines with VB on them where I also have db's to connect to. So it's a contrived setup. Keep asking, particularly in the Oracle DB zones and I'll try to help as best I can.
I will look out for your other questions ascnd
presence of a record in the registry?
presence of a home directory?
presence of oci.dll?
execute something?