Re: Upgrading Ingres Client from 2.5 to 2.6

Here's the VB source code... Remember.. standard software disclaimer
here... provided 'as is' without warranty of any kind, either express
or implied, including, but not limited to, the implied warranties of
fitness for a purpose, or the warranty of non-infringement....blah
blah blah..

Enjoy

:-)


Private Type SERVICE_STATUS
dwServiceType As Long
dwCurrentState As Long
dwControlsAccepted As Long
dwWin32ExitCode As Long
dwServiceSpecificExitCode As Long
dwCheckPoint As Long
dwWaitHint As Long
End Type



Declare Function RegCloseKey& Lib "advapi32.dll" (ByVal hKey&)
Declare Function RegOpenKeyExA& Lib "advapi32.dll" (ByVal hKey&, ByVal
lpszSubKey$, dwOptions&, ByVal samDesired&, lpHKey&)
Declare Function RegQueryValueExA& Lib "advapi32.dll" (ByVal hKey&,
ByVal lpszValueName$, ByVal lpdwRes&, lpdwType&, ByVal lpDataBuff$,
nSize&)

Public Declare Function RegOpenKey Lib "advapi32.dll" Alias
"RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult
As Long) As Long
'Public Declare Function RegCloseKey Lib "advapi32.dll" Alias
"RegCloseKeyA" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib "advapi32.dll" Alias
"RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String,
phkResult As Long) As Long
Public Declare Function RegDeleteKey Lib "advapi32.dll" Alias
"RegDeleteKeyA" (ByVal hKey As Long, ByVal lpSubKey As String) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As
Long
'--------------------------------------------------
Public Declare Function RegEnumKey Lib "advapi32.dll" Alias
"RegEnumKeyA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpName
As String, ByVal cbName As Long) As Long
Public Declare Function RegEnumValue Lib "advapi32.dll" Alias
"RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal
lpValueName As String, lpcbValueName As Long, lpReserved As Long,
lpType As Long, lpData As Byte, lpcbData As Long) As Long
'--------------------------------------------------
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As
Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32.dll" Alias
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String,
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, ByVal
cbData As Long) As Long
'--------------------------------------------------
Private Declare Function OpenSCManager Lib "advapi32.dll" Alias
"OpenSCManagerA" (ByVal lpMachineName As String, ByVal lpDatabaseName
As String, ByVal dwDesiredAccess As Long) As Long
Private Declare Function CloseServiceHandle Lib "advapi32.dll" (ByVal
hSCObject As Long) As Long
Private Declare Function OpenService Lib "advapi32.dll" Alias
"OpenServiceA" (ByVal hSCManager As Long, ByVal lpServiceName As
String, ByVal dwDesiredAccess As Long) As Long
Private Declare Function StartService Lib "advapi32.dll" Alias
"StartServiceA" (ByVal hService As Long, ByVal dwNumServiceArgs As
Long, ByVal lpServiceArgVectors As Long) As Long
Private Declare Function ControlService Lib "advapi32.dll" (ByVal
hService As Long, ByVal dwControl As Long, lpServiceStatus As
SERVICE_STATUS) As Long


Const HKEY_CLASSES_ROOT = &H80000000
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_LOCAL_MACHINE = &H80000002
Const HKEY_USERS = &H80000003

Const ERROR_SUCCESS = 0&
Const REG_SZ = 1& ' Unicode nul terminated
string
Const REG_EXPAND_SZ = 2&
Const REG_DWORD = 4& ' 32-bit number

Public Const HKEY_PERFORMANCE_DATA = &H80000004
Public Const HKEY_CURRENT_CONFIG = &H80000005
Public Const HKEY_DYN_DATA = &H80000006
Public Const REG_BINARY = 3 ' Free form binary
Public Const GW_HWNDFIRST = 0
Public Const GW_HWNDNEXT = 2

Const KEY_QUERY_VALUE = &H1&
Const KEY_SET_VALUE = &H2&
Const KEY_CREATE_SUB_KEY = &H4&
Const KEY_ENUMERATE_SUB_KEYS = &H8&
Const KEY_NOTIFY = &H10&
Const KEY_CREATE_LINK = &H20&
Const READ_CONTROL = &H20000
Const WRITE_DAC = &H40000
Const WRITE_OWNER = &H80000
Const SYNCHRONIZE = &H100000
Const STANDARD_RIGHTS_REQUIRED = &HF0000
Const STANDARD_RIGHTS_READ = READ_CONTROL
Const STANDARD_RIGHTS_WRITE = READ_CONTROL
Const STANDARD_RIGHTS_EXECUTE = READ_CONTROL
Const KEY_READ = STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or
KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY
Const KEY_WRITE = STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
KEY_CREATE_SUB_KEY
Const KEY_EXECUTE = KEY_READ

Const GENERIC_EXECUTE = &H20000000
Const SERVICE_CONTROL_STOP = 1
Const SERVICE_CONTROL_PAUSE = 2
Const SERVICE_CONTROL_CONTINUE = 3


Dim newpath As String
Dim newinclude As String

Function RegGetValue$(MainKey&, SubKey$, value$)
' MainKey must be one of the Publicly declared HKEY constants.
Dim sKeyType& 'returns the key type. This function expects
REG_SZ or REG_DWORD
Dim Ret& 'returned by registry functions, should be 0&
Dim lpHKey& 'return handle to opened key
Dim lpcbData& 'length of data in returned string
Dim ReturnedString$ 'returned string value
Dim fTempDbl!
If MainKey >= &H80000000 And MainKey <= &H80000006 Then
' Open key
Ret = RegOpenKeyExA(MainKey, SubKey, 0&, KEY_READ, lpHKey)
If Ret <> ERROR_SUCCESS Then
RegGetValue = ""
Exit Function 'No key open, so leave
End If

' Set up buffer for data to be returned in.
' Adjust next value for larger buffers.
lpcbData = 255
ReturnedString = Space$(lpcbData)

' Read key
Ret& = RegQueryValueExA(lpHKey, value, ByVal 0&, sKeyType,
ReturnedString, lpcbData)
If Ret <> ERROR_SUCCESS Then
RegGetValue = "" 'Key still open, so finish up
Else
If sKeyType = REG_DWORD Then
fTempDbl = Asc(Mid$(ReturnedString, 1, 1)) + &H100& *
Asc(Mid$(ReturnedString, 2, 1)) + &H10000 * Asc(Mid$(ReturnedString,
3, 1)) + &H1000000 * CDbl(Asc(Mid$(ReturnedString, 4, 1)))
RegGetValue = Format$(fTempDbl, "000")
Else
RegGetValue = Left$(ReturnedString, lpcbData - 1)
End If
End If
' Always close opened keys.
Ret = RegCloseKey(lpHKey)
End If
End Function

Public Sub savestring(hKey As Long, strPath As String, strValue As
String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata,
Len(strdata))
r = RegCloseKey(keyhand)
End Sub

Public Sub savestring2(hKey As Long, strPath As String, strValue As
String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(hKey, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_EXPAND_SZ, ByVal
strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub


Public Sub DelSetting(hKey As Long, strPath As String, strValue As
String)
Dim Ret
r = RegCreateKey(hKey, strPath, Ret)
r = RegDeleteValue(Ret, strValue)
r = RegCloseKey(Ret)
End Sub


Sub Main()

' Form1.Show
' Form1.txt = "Stopping Services..."
' DoEvents

Call ServiceCommand("Ingres_Database_II", SERVICE_CONTROL_STOP)
Call ServiceCommand("OpenIngres_Database", SERVICE_CONTROL_STOP)

II_SYSTEM = RegGetValue$(HKEY_LOCAL_MACHINE, "SYSTEM
\CurrentControlSet\Control\Session Manager\Environment", "II_SYSTEM")
If II_SYSTEM <> "" Then
' Form1.txt = "Deleting II_SYSTEM (" & II_SYSTEM & ")"
' DoEvents
DelSetting HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet\Control
\Session Manager\Environment", "II_SYSTEM"
End If
' Form1.txt = "Attempt 1 To Removing Service..."
' DoEvents
x = Shell("cmd.exe /c opingsvc remove", vbHide)
' Form1.txt = "Attempt 2 To Removing Service..."
' DoEvents
x = Shell("cmd.exe /c opingclient remove", vbHide)

Path = RegGetValue$(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet
\Control\Session Manager\Environment", "Path")
' Form1.txt = "Tidying Path..."
' DoEvents
patharray = Split(Path, ";")
newpath = ""
For x = 0 To UBound(patharray)
Y1 = InStr(1, UCase(patharray(x)), "\INGRES")
Y2 = InStr(1, UCase(patharray(x)), "INGRES\")
Y3 = InStr(1, UCase(patharray(x)), "II_SYSTEM")

If Y1 = 0 And Y2 = 0 And Y3 = 0 And patharray(x) <> "" Then
If newpath = "" Then
newpath = patharray(x)
Else
newpath = newpath & ";" & patharray(x)
End If
End If
Next

' Form1.txt = "Setting New Path..."
' DoEvents
Call savestring2(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet
\Control\Session Manager\Environment", "Path", newpath)

' Form1.txt = "Tidying INCLUDE..."
' DoEvents
include = RegGetValue$(HKEY_LOCAL_MACHINE, "SYSTEM
\CurrentControlSet\Control\Session Manager\Environment", "Include")
includearray = Split(include, ";")
newinclude = ""
For x = 0 To UBound(includearray)
Y = InStr(1, UCase(includearray(x)), "\INGRES")
If Y = 0 And includearray(x) <> "" Then
If newinclude = "" Then
newinclude = includearray(x)
Else
newinclude = newinclude & ";" & includearray(x)
End If
End If
Next
' Form1.txt = "Setting New INCLUDE..."
' DoEvents
If newinclude <> "" Then
Call savestring2(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet
\Control\Session Manager\Environment", "Include", newinclude)
Else
DelSetting HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet
\Control\Session Manager\Environment", "Include"
End If

'
' Sort Out Unistaller
'
' Form1.txt = "Sorting Out Uninstall..."
' DoEvents
DeleteKey HKEY_LOCAL_MACHINE, "SOFTWARE\Microsoft\Windows
\CurrentVersion\Uninstall\Ingres"

' Form1.txt = "Tidying LIB..."
' DoEvents
newinclude = ""
include = RegGetValue$(HKEY_LOCAL_MACHINE, "SYSTEM
\CurrentControlSet\Control\Session Manager\Environment", "Lib")
includearray = Split(include, ";")
newinclude = ""
For x = 0 To UBound(includearray)
Y = InStr(1, UCase(includearray(x)), "\INGRES")
If Y = 0 And includearray(x) <> "" Then
If newinclude = "" Then
newinclude = includearray(x)
Else
newinclude = newinclude & ";" & includearray(x)
End If
End If
Next
' Form1.txt = "Setting New LIB..."
' DoEvents

If newinclude <> "" Then
Call savestring2(HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet
\Control\Session Manager\Environment", "Lib", newinclude)
Else
DelSetting HKEY_LOCAL_MACHINE, "SYSTEM\CurrentControlSet
\Control\Session Manager\Environment", "Lib"
End If


' Form1.txt = "Deleting Old Ingres Directories..."
' DoEvents
On Error Resume Next
KillRecursive ("c:\ingres")
' Form1.txt = "Deleting Old Oping Directories..."
' DoEvents
KillRecursive ("c:\Oping")
' Form1.txt = "Deleting Old IngresII Directories..."
' DoEvents
KillRecursive ("c:\IngresII")
' Form1.txt = "Deleting Old IngresII Program Group..."
' DoEvents
KillRecursive ("C:\WINNT\Profiles\All Users\Start Menu\Programs
\Ingres II")

' Form1.txt = "Old Installation Removal Complete..."
' DoEvents
' PauseTime = 3 ' Set duration.
' Start = Timer ' Set start time.
' Do While Timer < Start + PauseTime
' DoEvents ' Yield to other processes.
' Loop
'
' Unload Form1

End Sub



Private Sub KillRecursive(thispath$)
Dim nextdir$, nextfile$
' Delete any normal files
Do
nextfile$ = Dir$(thispath & "\*.*", vbNormal)
If nextfile$ <> "" Then Kill thispath & "\" & nextfile$
'If nextfile$ <> "" Then MsgBox thispath & "\" & nextfile$

Loop While nextfile <> ""

' Recursively delete any subdirectories
Do
nextdir$ = Dir$(thispath & "\*.*", vbDirectory)
' Skip past . and ..
Do While Left$(nextdir$, 1) = "."
nextdir$ = Dir$()
Loop
' Any real subdirectories?
If nextdir$ <> "" Then
KillRecursive thispath & "\" & nextdir$
End If
Loop While nextdir <> ""
' And delete the directory itself
RmDir thispath
End Sub


Public Function DeleteKey(lPredefinedKey As Long, sKeyName As String)
' Description:
' This Function will Delete a key
'
' Syntax:
' DeleteKey Location, KeyName
'
' Location must equal HKEY_CLASSES_ROOT, HKEY_CURRENT_USER,
HKEY_lOCAL_MACHINE
' , HKEY_USERS
'
' KeyName is name of the key you wish to delete, it may include
subkeys (example "Key1\SubKey1")


Dim lRetVal As Long 'result of the SetValueEx function
Dim hKey As Long 'handle of open key

'open the specified key

'lRetVal = RegOpenKeyEx(lPredefinedKey, sKeyName, 0,
KEY_ALL_ACCESS, hKey)
lRetVal = RegDeleteKey(lPredefinedKey, sKeyName)
'RegCloseKey (hKey)
End Function


' start/stop/pause/continue a service
' SERVICENAME is the internal name of the service
' COMMAND can be 0=Start, 1=Stop, 2=Pause, 3=Continue
'
' returns True if successful, False otherwise
' if any error, call Err.LastDLLError for more information

Function ServiceCommand(ByVal ServiceName As String, ByVal command As
Long) As _
Boolean
Dim hSCM As Long
Dim hService As Long
Dim res As Long
Dim lpServiceStatus As SERVICE_STATUS

' first, check the command
If command < 0 Or command > 3 Then Err.Raise 5

' open the connection to Service Control Manager, exit if error
hSCM = OpenSCManager(vbNullString, vbNullString, GENERIC_EXECUTE)
If hSCM = 0 Then Exit Function

' open the given service, exit if error
hService = OpenService(hSCM, ServiceName, GENERIC_EXECUTE)
If hService = 0 Then GoTo CleanUp

' start the service
Select Case command
Case 0
' to start a service you must use StartService
res = StartService(hService, 0, 0)
Case SERVICE_CONTROL_STOP, SERVICE_CONTROL_PAUSE, _
SERVICE_CONTROL_CONTINUE
' these commands use ControlService API
' (pass a NULL pointer because no result is expected)
res = ControlService(hService, command, lpServiceStatus)
End Select
If res = 0 Then GoTo CleanUp

' return success
ServiceCommand = True

CleanUp:
If hService Then CloseServiceHandle hService
' close the SCM
CloseServiceHandle hSCM

End Function

.

Relevant Pages