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 / ch29code / frmexist.frm (.txt) < prev    next >
Visual Basic Form  |  1995-08-02  |  5KB  |  113 lines
  1. VERSION 4.00
  2. Begin VB.Form frmExists 
  3.    AutoRedraw      =   -1  'True
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "IsAppPresent Test"
  6.    ClientHeight    =   1515
  7.    ClientLeft      =   1095
  8.    ClientTop       =   1515
  9.    ClientWidth     =   2655
  10.    Height          =   1920
  11.    Left            =   1035
  12.    LinkTopic       =   "Form1"
  13.    MaxButton       =   0   'False
  14.    MinButton       =   0   'False
  15.    ScaleHeight     =   1515
  16.    ScaleWidth      =   2655
  17.    Top             =   1170
  18.    Width           =   2775
  19.    Begin VB.CommandButton cmdExit 
  20.       Caption         =   "&Exit"
  21.       Height          =   375
  22.       Left            =   90
  23.       TabIndex        =   0
  24.       Top             =   1125
  25.       Width           =   2490
  26.    End
  27. Attribute VB_Name = "frmExists"
  28. Attribute VB_Creatable = False
  29. Attribute VB_Exposed = False
  30. '********************************************************************
  31. ' FRMEXISTS.FRM - Lists the existence of several Office apps.
  32. '********************************************************************
  33. Option Explicit
  34. #If Win16 Then
  35. Private Declare Function GetProfileString% Lib "Kernel" (ByVal _
  36.     sSection$, ByVal sKey$, ByVal sDef$, ByVal sRetStr$, _
  37.     ByVal iSize%)
  38. #End If
  39. '********************************************************************
  40. ' Checks to see if a file exists.
  41. '********************************************************************
  42. Function FileExists(sFileName$) As Boolean
  43.     On Error Resume Next
  44.     FileExists = IIf(Dir(Trim(sFileName)) <> "", True, False)
  45. End Function
  46. #If Win32 Then
  47. '********************************************************************
  48. ' This function determines if a application is present by seeing
  49. ' if there is any text in the registry for the provided SubKey.
  50. '********************************************************************
  51. Public Function IsAppPresent(strSubKey$, strValueName$) As Boolean
  52.     IsAppPresent = CBool(Len(GetRegString(HKEY_CLASSES_ROOT, _
  53.                             strSubKey, strValueName)))
  54. End Function
  55. #Else
  56. '********************************************************************
  57. ' This function determines if a application is present.
  58. ' The sExtension arg is the 3 letter extension of its data files.
  59. ' The sDefaultPath is where you think the app might be installed.
  60. '********************************************************************
  61. Public Function IsAppPresent(sExtension$, sDefaultPath$) As Boolean
  62. Dim sAppPath As String
  63.     '****************************************************************
  64.     ' Check the [Extensions] section of the WIN.INI to see where
  65.     ' the app is located. If the extension is not found, then
  66.     ' the default EXE path (sDefaultPath) is checked.
  67.     '****************************************************************
  68.     sAppPath = Space(4098)
  69.     GetProfileString "Extensions", sExtension, sDefaultPath & " ^" _
  70.                                & sExtension, sAppPath, Len(sAppPath)
  71.     '****************************************************************
  72.     ' The [Extensions] section stores info in the following format:
  73.     '        <extension>=<application path> ^<extension>
  74.     ' To get the application path, you'll need to take everything
  75.     ' to the left of the caret (^).
  76.     '****************************************************************
  77.     sAppPath = Left(sAppPath, InStr(sAppPath, "^") - 1)
  78.     '****************************************************************
  79.     ' Return whether or not the application is present.
  80.     '****************************************************************
  81.     IsAppPresent = FileExists(sAppPath)
  82. End Function
  83. #End If
  84. '********************************************************************
  85. ' Unloads the form.
  86. '********************************************************************
  87. Private Sub cmdExit_Click()
  88.     Unload Me
  89. End Sub
  90. '********************************************************************
  91. ' Performs some initialization steps, and list the existance of
  92. ' certain Office apps.
  93. '********************************************************************
  94. Private Sub Form_Load()
  95.     Move (Screen.Width - Width) / 2, (Screen.Height - Height) / 2
  96.     Print 'Print blank line
  97.     '****************************************************************
  98.     ' Call the appropriate version of IsAppPresent, depending on
  99.     ' the current platform.
  100.     '****************************************************************
  101. #If Win32 Then
  102.     Print " Access", IsAppPresent("Access.Database\CurVer", "")
  103.     Print " Excel", IsAppPresent("Excel.Sheet\CurVer", "")
  104.     Print " PowerPoint", IsAppPresent("PowerPoint.Slide\CurVer", "")
  105.     Print " Word", IsAppPresent("Word.Document\CurVer", "")
  106. #Else
  107.     Print " Access", IsAppPresent("mdb", "c:\access\msaccess.exe")
  108.     Print " Excel", IsAppPresent("xls", "c:\excel\excel.exe")
  109.     Print " PowerPoint", IsAppPresent("ppt", "c:\powerpnt\powerpnt.exe")
  110.     Print " Word", IsAppPresent("doc", "c:\winword\winword.exe")
  111. #End If
  112. End Sub
  113.