home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 September / Chip_2002-09_cd1.bin / zkuste / vbasic / Data / Utils / glm2demo.exe / %MAINDIR% / Scanner / frmTestabout.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  2002-06-10  |  13.3 KB  |  319 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "About MyApp"
  5.    ClientHeight    =   4080
  6.    ClientLeft      =   2340
  7.    ClientTop       =   1935
  8.    ClientWidth     =   5985
  9.    ClipControls    =   0   'False
  10.    ControlBox      =   0   'False
  11.    LinkTopic       =   "Form2"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2816.089
  15.    ScaleMode       =   0  'User
  16.    ScaleWidth      =   5620.225
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   1  'CenterOwner
  19.    Begin VB.PictureBox picIcon 
  20.       AutoSize        =   -1  'True
  21.       BorderStyle     =   0  'None
  22.       ClipControls    =   0   'False
  23.       Height          =   480
  24.       Left            =   240
  25.       Picture         =   "frmTestabout.frx":0000
  26.       ScaleHeight     =   337.12
  27.       ScaleMode       =   0  'User
  28.       ScaleWidth      =   337.12
  29.       TabIndex        =   1
  30.       Top             =   240
  31.       Width           =   480
  32.    End
  33.    Begin VB.CommandButton cmdOK 
  34.       Cancel          =   -1  'True
  35.       Caption         =   "OK"
  36.       Default         =   -1  'True
  37.       Height          =   345
  38.       Left            =   4419
  39.       TabIndex        =   0
  40.       Top             =   2865
  41.       Width           =   1260
  42.    End
  43.    Begin VB.CommandButton cmdSysInfo 
  44.       Caption         =   "&System Info..."
  45.       Height          =   345
  46.       Left            =   4419
  47.       TabIndex        =   2
  48.       Top             =   3315
  49.       Width           =   1245
  50.    End
  51.    Begin VB.Label Label1 
  52.       Caption         =   "Or, send an email to:"
  53.       ForeColor       =   &H00000000&
  54.       Height          =   210
  55.       Left            =   1080
  56.       TabIndex        =   11
  57.       Top             =   2190
  58.       Width           =   3525
  59.    End
  60.    Begin VB.Label lblEMail 
  61.       Caption         =   "support@desaware.com"
  62.       BeginProperty Font 
  63.          Name            =   "MS Sans Serif"
  64.          Size            =   8.25
  65.          Charset         =   0
  66.          Weight          =   700
  67.          Underline       =   -1  'True
  68.          Italic          =   0   'False
  69.          Strikethrough   =   0   'False
  70.       EndProperty
  71.       ForeColor       =   &H00FF0000&
  72.       Height          =   210
  73.       Left            =   1080
  74.       MouseIcon       =   "frmTestabout.frx":0442
  75.       MousePointer    =   99  'Custom
  76.       TabIndex        =   10
  77.       Top             =   2384
  78.       Width           =   2325
  79.    End
  80.    Begin VB.Label lblWebSite 
  81.       Caption         =   "http://www.desaware.com"
  82.       BeginProperty Font 
  83.          Name            =   "MS Sans Serif"
  84.          Size            =   8.25
  85.          Charset         =   0
  86.          Weight          =   700
  87.          Underline       =   -1  'True
  88.          Italic          =   0   'False
  89.          Strikethrough   =   0   'False
  90.       EndProperty
  91.       ForeColor       =   &H00FF0000&
  92.       Height          =   210
  93.       Left            =   1080
  94.       MouseIcon       =   "frmTestabout.frx":074C
  95.       MousePointer    =   99  'Custom
  96.       TabIndex        =   9
  97.       Top             =   1995
  98.       Width           =   2325
  99.    End
  100.    Begin VB.Label lblSubComponent 
  101.       Caption         =   "Desaware TWAIN Scanning Sample Program (VB5)"
  102.       BeginProperty Font 
  103.          Name            =   "MS Sans Serif"
  104.          Size            =   8.25
  105.          Charset         =   0
  106.          Weight          =   700
  107.          Underline       =   0   'False
  108.          Italic          =   0   'False
  109.          Strikethrough   =   0   'False
  110.       EndProperty
  111.       ForeColor       =   &H00000000&
  112.       Height          =   240
  113.       Left            =   1080
  114.       TabIndex        =   8
  115.       Top             =   480
  116.       Width           =   4605
  117.       WordWrap        =   -1  'True
  118.    End
  119.    Begin VB.Label lblCopyright 
  120.       Caption         =   "Copyright 
  121.  1999  Desaware, Inc. All rights reserved."
  122.       ForeColor       =   &H00000000&
  123.       Height          =   210
  124.       Left            =   1080
  125.       TabIndex        =   7
  126.       Top             =   1200
  127.       Width           =   3885
  128.    End
  129.    Begin VB.Line Line1 
  130.       BorderColor     =   &H00808080&
  131.       BorderStyle     =   6  'Inside Solid
  132.       Index           =   1
  133.       X1              =   84.515
  134.       X2              =   5520.686
  135.       Y1              =   1853.235
  136.       Y2              =   1853.235
  137.    End
  138.    Begin VB.Label lblDescription 
  139.       BorderStyle     =   1  'Fixed Single
  140.       Caption         =   "For more information on Desaware and its products, call (408) 377-4770, visit our web page at:"
  141.       ForeColor       =   &H00000000&
  142.       Height          =   1050
  143.       Left            =   1050
  144.       TabIndex        =   3
  145.       Top             =   1560
  146.       Width           =   3885
  147.    End
  148.    Begin VB.Label lblTitle 
  149.       Caption         =   "Desaware Gallimaufry "
  150.       BeginProperty Font 
  151.          Name            =   "MS Sans Serif"
  152.          Size            =   8.25
  153.          Charset         =   0
  154.          Weight          =   700
  155.          Underline       =   0   'False
  156.          Italic          =   0   'False
  157.          Strikethrough   =   0   'False
  158.       EndProperty
  159.       ForeColor       =   &H00000000&
  160.       Height          =   240
  161.       Left            =   1080
  162.       TabIndex        =   5
  163.       Top             =   240
  164.       Width           =   3885
  165.    End
  166.    Begin VB.Line Line1 
  167.       BorderColor     =   &H00FFFFFF&
  168.       BorderWidth     =   2
  169.       Index           =   0
  170.       X1              =   98.6
  171.       X2              =   5521.625
  172.       Y1              =   1863.588
  173.       Y2              =   1863.588
  174.    End
  175.    Begin VB.Label lblVersion 
  176.       Caption         =   "For development in the Windows environment using Microsoft Visual Basic
  177.       Height          =   465
  178.       Left            =   1080
  179.       TabIndex        =   6
  180.       Top             =   720
  181.       Width           =   3885
  182.    End
  183.    Begin VB.Label lblDisclaimer 
  184.       Caption         =   $"frmTestabout.frx":0A56
  185.       ForeColor       =   &H00000000&
  186.       Height          =   1065
  187.       Left            =   240
  188.       TabIndex        =   4
  189.       Top             =   2850
  190.       Width           =   4065
  191.    End
  192. Attribute VB_Name = "frmAbout"
  193. Attribute VB_GlobalNameSpace = False
  194. Attribute VB_Creatable = False
  195. Attribute VB_PredeclaredId = True
  196. Attribute VB_Exposed = False
  197. ' dwPerspectiveList Control
  198. ' Copyright 
  199.  1997 by Desaware Inc. All Rights Reserved
  200. Option Explicit
  201. Private Declare Function ShellExecute& Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long)
  202. Private Const SW_SHOW = 5
  203. ' Reg Key Security Options...
  204. Const READ_CONTROL = &H20000
  205. Const KEY_QUERY_VALUE = &H1
  206. Const KEY_SET_VALUE = &H2
  207. Const KEY_CREATE_SUB_KEY = &H4
  208. Const KEY_ENUMERATE_SUB_KEYS = &H8
  209. Const KEY_NOTIFY = &H10
  210. Const KEY_CREATE_LINK = &H20
  211. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  212.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  213.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  214.                      
  215. ' Reg Key ROOT Types...
  216. Const HKEY_LOCAL_MACHINE = &H80000002
  217. Const ERROR_SUCCESS = 0
  218. Const REG_SZ = 1                         ' Unicode nul terminated string
  219. Const REG_DWORD = 4                      ' 32-bit number
  220. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  221. Const gREGVALSYSINFOLOC = "MSINFO"
  222. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  223. Const gREGVALSYSINFO = "PATH"
  224. 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
  225. 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
  226. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  227. Private Sub cmdSysInfo_Click()
  228.   Call StartSysInfo
  229. End Sub
  230. Private Sub cmdOK_Click()
  231.   Unload Me
  232. End Sub
  233. Private Sub Form_Load()
  234.     Me.Caption = "About " & App.Title
  235.     lblSubComponent.Caption = lblSubComponent.Caption & " " & App.Major & "." & App.Minor & "." & App.Revision
  236. End Sub
  237. Public Sub StartSysInfo()
  238.     On Error GoTo SysInfoErr
  239.     Dim rc As Long
  240.     Dim SysInfoPath As String
  241.     ' Try To Get System Info Program Path\Name From Registry...
  242.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  243.     ' Try To Get System Info Program Path Only From Registry...
  244.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  245.         ' Validate Existance Of Known 32 Bit File Version
  246.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  247.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  248.             
  249.         ' Error - File Can Not Be Found...
  250.         Else
  251.             GoTo SysInfoErr
  252.         End If
  253.     ' Error - Registry Entry Can Not Be Found...
  254.     Else
  255.         GoTo SysInfoErr
  256.     End If
  257.     Call Shell(SysInfoPath, vbNormalFocus)
  258.     Exit Sub
  259. SysInfoErr:
  260.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  261. End Sub
  262. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  263.     Dim i As Long                                           ' Loop Counter
  264.     Dim rc As Long                                          ' Return Code
  265.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  266.     Dim hDepth As Long                                      '
  267.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  268.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  269.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  270.     '------------------------------------------------------------
  271.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  272.     '------------------------------------------------------------
  273.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  274.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  275.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  276.     KeyValSize = 1024                                       ' Mark Variable Size
  277.     '------------------------------------------------------------
  278.     ' Retrieve Registry Key Value...
  279.     '------------------------------------------------------------
  280.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  281.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  282.                         
  283.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  284.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  285.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  286.     Else                                                    ' WinNT Does NOT Null Terminate String...
  287.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  288.     End If
  289.     '------------------------------------------------------------
  290.     ' Determine Key Value Type For Conversion...
  291.     '------------------------------------------------------------
  292.     Select Case KeyValType                                  ' Search Data Types...
  293.     Case REG_SZ                                             ' String Registry Key Data Type
  294.         KeyVal = tmpVal                                     ' Copy String Value
  295.     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  296.         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  297.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  298.         Next
  299.         KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  300.     End Select
  301.     GetKeyValue = True                                      ' Return Success
  302.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  303.     Exit Function                                           ' Exit
  304. GetKeyError:      ' Cleanup After An Error Has Occured...
  305.     KeyVal = ""                                             ' Set Return Val To Empty String
  306.     GetKeyValue = False                                     ' Return Failure
  307.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  308. End Function
  309. Private Sub lblEMail_Click()
  310.     Screen.MousePointer = vbArrowHourglass
  311.     Call ShellExecute(Me.hWnd, "open", "mailto:support@desaware.com", vbNullString, CurDir$, SW_SHOW)
  312.     Screen.MousePointer = vbNormal
  313. End Sub
  314. Private Sub lblWebSite_Click()
  315.     Screen.MousePointer = vbArrowHourglass
  316.     Call ShellExecute(Me.hWnd, "open", "http://www.desaware.com", vbNullString, CurDir$, SW_SHOW)
  317.     Screen.MousePointer = vbNormal
  318. End Sub
  319.