home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / pagede1a / frmabout.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1999-08-31  |  9.4 KB  |  248 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   4  'Fixed ToolWindow
  4.    Caption         =   "About MyApp"
  5.    ClientHeight    =   3555
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1890
  8.    ClientWidth     =   5730
  9.    ClipControls    =   0   'False
  10.    LinkTopic       =   "Form2"
  11.    MaxButton       =   0   'False
  12.    MinButton       =   0   'False
  13.    ScaleHeight     =   2453.724
  14.    ScaleMode       =   0  'User
  15.    ScaleWidth      =   5380.766
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.PictureBox picIcon 
  19.       AutoSize        =   -1  'True
  20.       BorderStyle     =   0  'None
  21.       ClipControls    =   0   'False
  22.       Height          =   480
  23.       Left            =   240
  24.       Picture         =   "frmAbout.frx":0000
  25.       ScaleHeight     =   337.12
  26.       ScaleMode       =   0  'User
  27.       ScaleWidth      =   337.12
  28.       TabIndex        =   1
  29.       Top             =   240
  30.       Width           =   480
  31.    End
  32.    Begin VB.CommandButton cmdOK 
  33.       Cancel          =   -1  'True
  34.       Caption         =   "OK"
  35.       Default         =   -1  'True
  36.       Height          =   345
  37.       Left            =   4245
  38.       TabIndex        =   0
  39.       Top             =   2625
  40.       Width           =   1260
  41.    End
  42.    Begin VB.CommandButton cmdSysInfo 
  43.       Caption         =   "&System Info..."
  44.       Height          =   345
  45.       Left            =   4260
  46.       TabIndex        =   2
  47.       Top             =   3075
  48.       Width           =   1245
  49.    End
  50.    Begin VB.Label Label2 
  51.       AutoSize        =   -1  'True
  52.       BackStyle       =   0  'Transparent
  53.       Caption         =   "Web page: "
  54.       BeginProperty Font 
  55.          Name            =   "MS Sans Serif"
  56.          Size            =   8.25
  57.          Charset         =   0
  58.          Weight          =   400
  59.          Underline       =   -1  'True
  60.          Italic          =   0   'False
  61.          Strikethrough   =   0   'False
  62.       EndProperty
  63.       Height          =   195
  64.       Left            =   1080
  65.       TabIndex        =   8
  66.       Top             =   1560
  67.       Width           =   840
  68.    End
  69.    Begin VB.Label Label1 
  70.       Caption         =   "http://www.geocities.com/ResearchTriangle/Campus/4598/ pd.html"
  71.       ForeColor       =   &H00FF0000&
  72.       Height          =   495
  73.       Left            =   1050
  74.       MouseIcon       =   "frmAbout.frx":030A
  75.       MousePointer    =   99  'Custom
  76.       TabIndex        =   7
  77.       Top             =   1800
  78.       Width           =   4455
  79.       WordWrap        =   -1  'True
  80.    End
  81.    Begin VB.Line Line1 
  82.       BorderColor     =   &H00808080&
  83.       BorderStyle     =   6  'Inside Solid
  84.       Index           =   1
  85.       X1              =   84.515
  86.       X2              =   5309.398
  87.       Y1              =   1687.583
  88.       Y2              =   1687.583
  89.    End
  90.    Begin VB.Label lblDescription 
  91.       Caption         =   "Copyright 1999 for Mostafa, All Right Reserved"
  92.       ForeColor       =   &H00000000&
  93.       Height          =   330
  94.       Left            =   1050
  95.       TabIndex        =   3
  96.       Top             =   1125
  97.       Width           =   3885
  98.    End
  99.    Begin VB.Label lblTitle 
  100.       Caption         =   "Application Title"
  101.       ForeColor       =   &H00000000&
  102.       Height          =   480
  103.       Left            =   1050
  104.       TabIndex        =   5
  105.       Top             =   240
  106.       Width           =   3885
  107.    End
  108.    Begin VB.Line Line1 
  109.       BorderColor     =   &H00FFFFFF&
  110.       BorderWidth     =   2
  111.       Index           =   0
  112.       X1              =   98.6
  113.       X2              =   5309.398
  114.       Y1              =   1697.936
  115.       Y2              =   1697.936
  116.    End
  117.    Begin VB.Label lblVersion 
  118.       Caption         =   "Version"
  119.       Height          =   225
  120.       Left            =   1050
  121.       TabIndex        =   6
  122.       Top             =   780
  123.       Width           =   3885
  124.    End
  125.    Begin VB.Label lblDisclaimer 
  126.       Caption         =   "Warning: ...This program is protected by copyright laws."
  127.       ForeColor       =   &H00000000&
  128.       Height          =   825
  129.       Left            =   255
  130.       TabIndex        =   4
  131.       Top             =   2625
  132.       Width           =   3870
  133.    End
  134. Attribute VB_Name = "frmAbout"
  135. Attribute VB_GlobalNameSpace = False
  136. Attribute VB_Creatable = False
  137. Attribute VB_PredeclaredId = True
  138. Attribute VB_Exposed = False
  139. Option Explicit
  140. Const READ_CONTROL = &H20000
  141. Const KEY_QUERY_VALUE = &H1
  142. Const KEY_SET_VALUE = &H2
  143. Const KEY_CREATE_SUB_KEY = &H4
  144. Const KEY_ENUMERATE_SUB_KEYS = &H8
  145. Const KEY_NOTIFY = &H10
  146. Const KEY_CREATE_LINK = &H20
  147. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  148.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  149.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  150.                      
  151. Const HKEY_LOCAL_MACHINE = &H80000002
  152. Const ERROR_SUCCESS = 0
  153. Const REG_SZ = 1
  154. Const REG_DWORD = 4
  155. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  156. Const gREGVALSYSINFOLOC = "MSINFO"
  157. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  158. Const gREGVALSYSINFO = "PATH"
  159. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  160. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  161. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  162. Private Sub cmdSysInfo_Click()
  163.   Call StartSysInfo
  164. End Sub
  165. Private Sub cmdOK_Click()
  166.   Unload Me
  167. End Sub
  168. Private Sub Form_Load()
  169. On Error Resume Next
  170.     Me.Caption = "About " & App.Title
  171.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  172.     lblTitle.Caption = App.Title + " (Trial Version)"
  173. End Sub
  174. Public Sub StartSysInfo()
  175.     On Error GoTo SysInfoErr
  176.     Dim rc As Long
  177.     Dim SysInfoPath As String
  178.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  179.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  180.        
  181.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  182.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  183.             
  184.        
  185.         Else
  186.             GoTo SysInfoErr
  187.         End If
  188.     Else
  189.         GoTo SysInfoErr
  190.     End If
  191.     Call Shell(SysInfoPath, vbNormalFocus)
  192.     Exit Sub
  193. SysInfoErr:
  194.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  195. End Sub
  196. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  197.     Dim i As Long
  198.     Dim rc As Long
  199.     Dim hKey As Long
  200.     Dim hDepth As Long
  201.     Dim KeyValType As Long
  202.     Dim tmpVal As String
  203.     Dim KeyValSize As Long
  204.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey)
  205.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
  206.     tmpVal = String$(1024, 0)
  207.     KeyValSize = 1024
  208.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  209.                          KeyValType, tmpVal, KeyValSize)
  210.                         
  211.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError
  212.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  213.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then
  214.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  215.     Else                                                    ' WinNT Does NOT Null Terminate String...
  216.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  217.     End If
  218.     Select Case KeyValType                                  ' Search Data Types...
  219.     Case REG_SZ                                             ' String Registry Key Data Type
  220.         KeyVal = tmpVal                                     ' Copy String Value
  221.     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  222.         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  223.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  224.         Next
  225.         KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  226.     End Select
  227.     End If
  228.     GetKeyValue = True                                      ' Return Success
  229.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  230.     Exit Function                                           ' Exit
  231. GetKeyError:      ' Cleanup After An Error Has Occured...
  232.     KeyVal = ""                                             ' Set Return Val To Empty String
  233.     GetKeyValue = False                                     ' Return Failure
  234.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  235. End Function
  236. Private Sub Label1_Click()
  237. On Error Resume Next
  238.     Dim Scr_hDC As Long
  239.     Dim startdoc As Long
  240.     Dim l, txtt
  241.     Scr_hDC = GetDesktopWindow()
  242.     startdoc = ShellExecute(Scr_hDC, "Open", "http://www.geocities.com/ResearchTriangle/Campus/4598/ pd.html", "", "c:\", SW_SHOWNORMAL)
  243.        
  244.         If Err Then
  245.            MsgBox Err.Description
  246.         End If
  247. End Sub
  248.