VERSION 5.00 Begin VB.Form frmAbout BorderStyle = 3 'Fixed Dialog Caption = "About PPCalc" ClientHeight = 3135 ClientLeft = 2340 ClientTop = 1935 ClientWidth = 5730 ClipControls = 0 'False Icon = "frmAbout.frx":0000 LinkTopic = "Form2" MaxButton = 0 'False MinButton = 0 'False ScaleHeight = 3135 ScaleWidth = 5730 ShowInTaskbar = 0 'False StartUpPosition = 1 'CenterOwner Begin VB.CommandButton cmdOK Cancel = -1 'True Caption = "OK" Default = -1 'True Height = 345 Left = 4245 TabIndex = 0 Top = 2160 Width = 1260 End Begin VB.CommandButton cmdSysInfo Caption = "&System Info..." Height = 345 Left = 4260 TabIndex = 1 Top = 2640 Width = 1260 End Begin VB.Label label1 Height = 975 Index = 9 Left = 375 TabIndex = 13 Top = 810 Width = 2070 End Begin VB.Shape Shape1 Height = 1215 Index = 1 Left = 240 Top = 720 Width = 2295 End Begin VB.Label label1 AutoSize = -1 'True Caption = "2.2" Height = 195 Index = 7 Left = 3720 TabIndex = 11 Top = 1335 Width = 225 End Begin VB.Label label1 AutoSize = -1 'True Caption = "Version:" Height = 195 Index = 6 Left = 3060 TabIndex = 10 Top = 1335 Width = 570 End Begin VB.Label label1 AutoSize = -1 'True Caption = "November 04, 2005" Height = 195 Index = 5 Left = 3720 TabIndex = 9 Top = 1575 Width = 1410 End Begin VB.Label label1 AutoSize = -1 'True Caption = "Date:" Height = 195 Index = 3 Left = 3240 TabIndex = 8 Top = 1575 Width = 390 End Begin VB.Label label1 AutoSize = -1 'True Caption = "Email:" Height = 195 Index = 2 Left = 3210 TabIndex = 7 Top = 1095 Width = 420 End Begin VB.Label label1 AutoSize = -1 'True Caption = "Website:" Height = 195 Index = 1 Left = 3000 TabIndex = 6 Top = 855 Width = 630 End Begin VB.Shape Shape1 Height = 1215 Index = 0 Left = 2685 Top = 720 Width = 2895 End Begin VB.Label label1 AutoSize = -1 'True Caption = "contact@ppcalc.com" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 195 Index = 0 Left = 3720 TabIndex = 5 Top = 1095 Width = 1530 End Begin VB.Line Line1 BorderColor = &H00808080& BorderStyle = 6 'Inside Solid Index = 1 X1 = 120 X2 = 5684 Y1 = 2025 Y2 = 2025 End Begin VB.Label label1 AutoSize = -1 'True Caption = "http://www.ppcalc.com" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 400 Underline = -1 'True Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 195 Index = 4 Left = 3720 TabIndex = 2 Top = 855 Width = 1695 End Begin VB.Label label1 AutoSize = -1 'True BackStyle = 0 'Transparent BorderStyle = 1 'Fixed Single Caption = " PPCalc - PayPal Fee Calculator " BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H006E3E12& Height = 255 Index = 8 Left = 930 TabIndex = 4 Top = 255 Width = 3945 End Begin VB.Line Line1 BorderColor = &H00FFFFFF& Index = 0 X1 = 120 X2 = 5669 Y1 = 2040 Y2 = 2040 End Begin VB.Label label1 ForeColor = &H00000000& Height = 825 Index = 11 Left = 255 TabIndex = 3 Top = 2160 Width = 3870 End Begin VB.Label label1 AutoSize = -1 'True BackStyle = 0 'Transparent Caption = "PPCalc - PayPal Fee Calculator" BeginProperty Font Name = "MS Sans Serif" Size = 8.25 Charset = 0 Weight = 700 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00E0E0E0& Height = 195 Index = 10 Left = 1570 TabIndex = 12 Top = 300 Width = 2685 End End Attribute VB_Name = "frmAbout" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit ' Reg Key Security Options... Const READ_CONTROL = &H20000 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 KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _ KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _ KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL ' Reg Key ROOT Types... Const HKEY_LOCAL_MACHINE = &H80000002 Const ERROR_SUCCESS = 0 Const REG_SZ = 1 ' Unicode nul terminated string Const REG_DWORD = 4 ' 32-bit number Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location" Const gREGVALSYSINFOLOC = "MSINFO" Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO" Const gREGVALSYSINFO = "PATH" 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 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 Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Private Sub cmdSysInfo_Click() Call StartSysInfo End Sub Private Sub cmdOK_Click() Unload Me End Sub Private Sub Form_Load() 'Label1(7).Caption = App.Major & "." & App.Minor lHandle = LoadCursor(0, 32649&) Label1(9).Caption = "Do you have any ideas, comments, or suggestions about how to make this software better? Please feel free to send me an e-mail." Label1(11).Caption = "PPCalc is not written by, owned, operated, endorsed, affiliated, or sponsored by PayPal in any way. PayPal and the PayPal logo are registered trademarks of PayPal, Inc. an eBay company." End Sub Public Sub StartSysInfo() On Error GoTo SysInfoErr Dim rc As Long Dim SysInfoPath As String ' Try To Get System Info Program Path\Name From Registry... If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then ' Try To Get System Info Program Path Only From Registry... ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then ' Validate Existance Of Known 32 Bit File Version If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then SysInfoPath = SysInfoPath & "\MSINFO32.EXE" ' Error - File Can Not Be Found... Else GoTo SysInfoErr End If ' Error - Registry Entry Can Not Be Found... Else GoTo SysInfoErr End If Call Shell(SysInfoPath, vbNormalFocus) Exit Sub SysInfoErr: MsgBox "System Information Is Unavailable At This Time", vbOKOnly End Sub Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean Dim i As Long ' Loop Counter Dim rc As Long ' Return Code Dim hKey As Long ' Handle To An Open Registry Key Dim hDepth As Long ' Dim KeyValType As Long ' Data Type Of A Registry Key Dim tmpVal As String ' Tempory Storage For A Registry Key Value Dim KeyValSize As Long ' Size Of Registry Key Variable '------------------------------------------------------------ ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...} '------------------------------------------------------------ rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error... tmpVal = String$(1024, 0) ' Allocate Variable Space KeyValSize = 1024 ' Mark Variable Size '------------------------------------------------------------ ' Retrieve Registry Key Value... '------------------------------------------------------------ rc = RegQueryValueEx(hKey, SubKeyRef, 0, _ KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String... tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String Else ' WinNT Does NOT Null Terminate String... tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only End If '------------------------------------------------------------ ' Determine Key Value Type For Conversion... '------------------------------------------------------------ Select Case KeyValType ' Search Data Types... Case REG_SZ ' String Registry Key Data Type KeyVal = tmpVal ' Copy String Value Case REG_DWORD ' Double Word Registry Key Data Type For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char. Next KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String End Select GetKeyValue = True ' Return Success rc = RegCloseKey(hKey) ' Close Registry Key Exit Function ' Exit GetKeyError: ' Cleanup After An Error Has Occured... KeyVal = "" ' Set Return Val To Empty String GetKeyValue = False ' Return Failure rc = RegCloseKey(hKey) ' Close Registry Key End Function Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single) Me.MousePointer = 0 End Sub Private Sub Label1_MouseDown(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Index = 0 Or Index = 4 Then If (lHandle > 0) Then SetCursor lHandle End If End Sub Private Sub label1_MouseMove(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Index = 0 Or Index = 4 Then If (lHandle > 0) Then SetCursor lHandle End If End Sub Private Sub label1_MouseUp(Index As Integer, Button As Integer, Shift As Integer, x As Single, y As Single) If Index = 0 Then 'email If (lHandle > 0) Then SetCursor lHandle ShellExecute 0, vbNullString, "mailto:contact@ppcalc.com", vbNullString, vbNullString, vbNormalFocus ElseIf Index = 4 Then 'website If (lHandle > 0) Then SetCursor lHandle ShellExecute 0, vbNullString, "http://www.ppcalc.com", vbNullString, vbNullString, vbNormalFocus End If End Sub