home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch14code / main.bas < prev    next >
BASIC Source File  |  1995-08-08  |  4KB  |  134 lines
  1. Attribute VB_Name = "Module1"
  2. Option Explicit
  3.  
  4. ' Registration APIs used to check entry.
  5. #If Win16 Then
  6. Declare Function RegOpenKey Lib "Shell" _
  7.     (ByVal HKeyIn As Long, _
  8.     ByVal LPCSTR As String, _
  9.     HKeyOut As Long) _
  10.     As Long
  11. Declare Function RegCloseKey Lib "Shell" _
  12.     (ByVal HKeyIn As Long) _
  13.     As Long
  14. Declare Function RegQueryValue Lib "Shell" _
  15.     (ByVal HKeyIn As Long, _
  16.     ByVal SubKey As String, _
  17.     ByVal KeyValue As String, _
  18.     KeyValueLen As Long) _
  19.     As Long
  20. Declare Function RegSetValue Lib "Shell" _
  21.     (ByVal HKeyIn As Long, _
  22.     ByVal SubKey As String, _
  23.     ByVal lType As Long, _
  24.     ByVal strNewValue As String, _
  25.     ByVal lIngnored As Long) _
  26.     As Long
  27. Declare Sub RegDeleteKey Lib "Shell" _
  28.     (ByVal HKeyIn As Long, _
  29.     ByVal SubKeyName As String)
  30. #Else
  31. Declare Function RegOpenKey Lib "advapi32" _
  32.     Alias "RegOpenKeyA" _
  33.     (ByVal HKeyIn As Long, _
  34.     ByVal LPCSTR As String, _
  35.     HKeyOut As Long) _
  36.     As Long
  37. Declare Function RegOpenKeyEx Lib "advapi32" _
  38.     Alias "RegOpenKeyExA" _
  39.     (ByVal HKeyIn As Long, ByVal LPCSTR _
  40.     As String, ByVal dwRes _
  41.     As Long, ByVal dwAccess _
  42.     As Long, HKeyOut As _
  43.     Long) As Long _
  44.  
  45. Declare Function RegCloseKey Lib "advapi32" _
  46.     (ByVal HKeyIn As Long) _
  47.     As Long
  48. Declare Function RegQueryValue Lib "advapi32" _
  49.     Alias "RegQueryValueA" _
  50.     (ByVal HKeyIn As Long, _
  51.     ByVal SubKey As String, _
  52.     ByVal KeyValue As String, _
  53.     KeyValueLen As Long) _
  54.     As Long
  55. Declare Function RegSetValue Lib "advapi32" _
  56.     Alias "RegSetValueA" _
  57.     (ByVal HKeyIn As Long, _
  58.     ByVal SubKey As String, _
  59.     ByVal lType As Long, _
  60.     ByVal strNewValue As String, _
  61.     ByVal lIngnored As Long) _
  62.     As Long
  63. Declare Function RegDeleteKey Lib "advapi32" _
  64.     Alias "RegDeleteKeyA" _
  65.     (ByVal HKeyIn As Long, _
  66.     ByVal SubKeyName As String) _
  67.     As Long
  68. #End If
  69.  
  70. #If Win16 Then
  71.     Const HKEY_CLASSES_ROOT = &H1
  72. #Else
  73.     Const HKEY_CLASSES_ROOT = &H80000000
  74.     Const HKEY_CURRENT_USER = &H80000001
  75.     Const HKEY_LOCAL_MACHINE = &H80000002
  76.     Const HKEY_USERS = &H80000003
  77.     Const HKEY_PERFORMANCE_DATA = &H80000004
  78. #End If
  79.  
  80. Public Const ERROR_SUCCESS = 0
  81.  
  82. Sub Main()
  83.     ' Check registration entries on start-up.
  84.     CheckRegistrationEntry "Store.Application"
  85.     ' If there was a command line, try to load
  86.     ' the file.
  87.     If Len(Command$()) Then
  88.         frmStore.OpenFile Command$()
  89.     End If
  90.     ' Show form.
  91.     frmStore.Show
  92. End Sub
  93.  
  94. Sub CheckRegistrationEntry(strSearchKey As String)
  95.     Dim hkroot As Long, lError As Long, lLen As Long
  96.     Dim strKeyID As String, strKeyDesc As String
  97.     Dim strAppName As String
  98.     ' Get current application path and file name.
  99.     strAppName = App.Path & "\" & App.EXEName & ".EXE" & _
  100.         " %1"
  101.     lLen = 255
  102.     ' Specify subentry value to check.
  103.     strKeyID = "command"
  104.     ' Initalize key description (value returned by RegQueryValue).
  105.     strKeyDesc = String(lLen, 0)
  106.     ' Get the registry entry for the Open key.
  107.     lError = RegOpenKey(HKEY_CLASSES_ROOT, strSearchKey & _
  108.         "\shell\open", hkroot)
  109.     ' Get the value of the entry.
  110.     lError = RegQueryValue(hkroot, strKeyID, strKeyDesc, lLen)
  111.     ' If RegOpenKey or RegQueryValue return an error,
  112.     ' display a message and end.
  113.     If lError Then
  114.         MsgBox "Couldn't find registry entry. Please reinstall" & _
  115.             "the application."
  116.         End
  117.     End If
  118.     ' Check the value against the current installation.
  119.     If Left(strKeyDesc, lLen - 1) <> strAppName Then
  120.             ' If it doesn't match, change the registered value.
  121.             lError = RegSetValue(hkroot, strKeyID, 1, strAppName, 0)
  122.     End If
  123.     ' If RegOpenKey or RegQueryValue return an error,
  124.     ' display a message and end.
  125.     If lError Then
  126.         MsgBox "Couldn't update registry entry."
  127.         End
  128.     End If
  129.     ' Close the registration key.
  130.     lError = RegCloseKey(hkroot)
  131. End Sub
  132.  
  133.  
  134.