frmAbout.frm
上传用户:nicktai
上传日期:2010-01-26
资源大小:40k
文件大小:10k
源码类别:

Ftp服务器

开发平台:

Visual Basic

  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BackColor       =   &H00FFFFFF&
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "About vbip FTP Client"
  6.    ClientHeight    =   3135
  7.    ClientLeft      =   2340
  8.    ClientTop       =   1935
  9.    ClientWidth     =   6165
  10.    ClipControls    =   0   'False
  11.    LinkTopic       =   "Form2"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2163.833
  15.    ScaleMode       =   0  'User
  16.    ScaleWidth      =   5789.254
  17.    ShowInTaskbar   =   0   'False
  18.    StartUpPosition =   2  'CenterScreen
  19.    Begin VB.PictureBox picIcon 
  20.       AutoSize        =   -1  'True
  21.       BorderStyle     =   0  'None
  22.       ClipControls    =   0   'False
  23.       Height          =   705
  24.       Left            =   240
  25.       Picture         =   "frmAbout.frx":0000
  26.       ScaleHeight     =   495.145
  27.       ScaleMode       =   0  'User
  28.       ScaleWidth      =   1896.3
  29.       TabIndex        =   1
  30.       Top             =   120
  31.       Width           =   2700
  32.    End
  33.    Begin VB.CommandButton cmdOK 
  34.       Cancel          =   -1  'True
  35.       Caption         =   "OK"
  36.       Default         =   -1  'True
  37.       Height          =   345
  38.       Left            =   4800
  39.       TabIndex        =   0
  40.       Top             =   120
  41.       Width           =   1260
  42.    End
  43.    Begin VB.CommandButton cmdSysInfo 
  44.       Caption         =   "&System Info..."
  45.       Height          =   345
  46.       Left            =   4800
  47.       TabIndex        =   2
  48.       Top             =   600
  49.       Width           =   1245
  50.    End
  51.    Begin VB.Image Image1 
  52.       Height          =   150
  53.       Left            =   240
  54.       Picture         =   "frmAbout.frx":0F40
  55.       Top             =   2760
  56.       Width           =   2595
  57.    End
  58.    Begin VB.Label lblURL 
  59.       Alignment       =   2  'Center
  60.       AutoSize        =   -1  'True
  61.       BackStyle       =   0  'Transparent
  62.       Caption         =   "Visual Basic Internet Programming (http://www.vbip.com)"
  63.       BeginProperty Font 
  64.          Name            =   "MS Sans Serif"
  65.          Size            =   8.25
  66.          Charset         =   204
  67.          Weight          =   400
  68.          Underline       =   -1  'True
  69.          Italic          =   0   'False
  70.          Strikethrough   =   0   'False
  71.       EndProperty
  72.       ForeColor       =   &H00C00000&
  73.       Height          =   195
  74.       Left            =   240
  75.       MouseIcon       =   "frmAbout.frx":129D
  76.       MousePointer    =   99  'Custom
  77.       TabIndex        =   5
  78.       ToolTipText     =   "Click here to launch your default web browser"
  79.       Top             =   2400
  80.       Width           =   4050
  81.    End
  82.    Begin VB.Label Label2 
  83.       BackStyle       =   0  'Transparent
  84.       Caption         =   "Label2"
  85.       Height          =   615
  86.       Left            =   240
  87.       TabIndex        =   4
  88.       Top             =   1680
  89.       Width           =   4215
  90.    End
  91.    Begin VB.Label Label1 
  92.       BackStyle       =   0  'Transparent
  93.       Caption         =   "Label1"
  94.       Height          =   735
  95.       Left            =   240
  96.       TabIndex        =   3
  97.       Top             =   960
  98.       Width           =   3855
  99.    End
  100. End
  101. Attribute VB_Name = "frmAbout"
  102. Attribute VB_GlobalNameSpace = False
  103. Attribute VB_Creatable = False
  104. Attribute VB_PredeclaredId = True
  105. Attribute VB_Exposed = False
  106. Option Explicit
  107. ' Reg Key Security Options...
  108. Const READ_CONTROL = &H20000
  109. Const KEY_QUERY_VALUE = &H1
  110. Const KEY_SET_VALUE = &H2
  111. Const KEY_CREATE_SUB_KEY = &H4
  112. Const KEY_ENUMERATE_SUB_KEYS = &H8
  113. Const KEY_NOTIFY = &H10
  114. Const KEY_CREATE_LINK = &H20
  115. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  116.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  117.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  118.                      
  119. ' Reg Key ROOT Types...
  120. Const HKEY_LOCAL_MACHINE = &H80000002
  121. Const ERROR_SUCCESS = 0
  122. Const REG_SZ = 1                         ' Unicode nul terminated string
  123. Const REG_DWORD = 4                      ' 32-bit number
  124. Const gREGKEYSYSINFOLOC = "SOFTWAREMicrosoftShared Tools Location"
  125. Const gREGVALSYSINFOLOC = "MSINFO"
  126. Const gREGKEYSYSINFO = "SOFTWAREMicrosoftShared ToolsMSINFO"
  127. Const gREGVALSYSINFO = "PATH"
  128. 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
  129. 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
  130. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  131. Private Declare Function GetActiveWindow Lib "user32" () As Long
  132. 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) As Long
  133. Private Sub cmdSysInfo_Click()
  134.   Call StartSysInfo
  135. End Sub
  136. Private Sub cmdOK_Click()
  137.   Unload Me
  138. End Sub
  139. Public Sub StartSysInfo()
  140.     On Error GoTo SysInfoErr
  141.   
  142.     Dim rc As Long
  143.     Dim SysInfoPath As String
  144.     
  145.     ' Try To Get System Info Program PathName From Registry...
  146.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  147.     ' Try To Get System Info Program Path Only From Registry...
  148.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  149.         ' Validate Existance Of Known 32 Bit File Version
  150.         If (Dir(SysInfoPath & "MSINFO32.EXE") <> "") Then
  151.             SysInfoPath = SysInfoPath & "MSINFO32.EXE"
  152.             
  153.         ' Error - File Can Not Be Found...
  154.         Else
  155.             GoTo SysInfoErr
  156.         End If
  157.     ' Error - Registry Entry Can Not Be Found...
  158.     Else
  159.         GoTo SysInfoErr
  160.     End If
  161.     
  162.     Call Shell(SysInfoPath, vbNormalFocus)
  163.     
  164.     Exit Sub
  165. SysInfoErr:
  166.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  167. End Sub
  168. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  169.     Dim i As Long                                           ' Loop Counter
  170.     Dim rc As Long                                          ' Return Code
  171.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  172.     Dim hDepth As Long                                      '
  173.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  174.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  175.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  176.     '------------------------------------------------------------
  177.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  178.     '------------------------------------------------------------
  179.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  180.     
  181.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  182.     
  183.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  184.     KeyValSize = 1024                                       ' Mark Variable Size
  185.     
  186.     '------------------------------------------------------------
  187.     ' Retrieve Registry Key Value...
  188.     '------------------------------------------------------------
  189.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  190.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  191.                         
  192.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  193.     
  194.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  195.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  196.     Else                                                    ' WinNT Does NOT Null Terminate String...
  197.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  198.     End If
  199.     '------------------------------------------------------------
  200.     ' Determine Key Value Type For Conversion...
  201.     '------------------------------------------------------------
  202.     Select Case KeyValType                                  ' Search Data Types...
  203.     Case REG_SZ                                             ' String Registry Key Data Type
  204.         KeyVal = tmpVal                                     ' Copy String Value
  205.     Case REG_DWORD                                          ' Double Word Registry Key Data Type
  206.         For i = Len(tmpVal) To 1 Step -1                    ' Convert Each Bit
  207.             KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1)))   ' Build Value Char. By Char.
  208.         Next
  209.         KeyVal = Format$("&h" + KeyVal)                     ' Convert Double Word To String
  210.     End Select
  211.     
  212.     GetKeyValue = True                                      ' Return Success
  213.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  214.     Exit Function                                           ' Exit
  215.     
  216. GetKeyError:      ' Cleanup After An Error Has Occured...
  217.     KeyVal = ""                                             ' Set Return Val To Empty String
  218.     GetKeyValue = False                                     ' Return Failure
  219.     rc = RegCloseKey(hKey)                                  ' Close Registry Key
  220. End Function
  221. Private Sub Form_Load()
  222.     Label1 = "This sample application demonstrates how to develop " & _
  223.             "Internet applications with Microsoft Visual Basic " & _
  224.             "and Winsock Control."
  225.     Label2 = "If you want the tutorials and articles about Internet " & _
  226.             "programming with Visual Basic as well as download " & _
  227.             "other samples, please welcome to:"
  228. End Sub
  229. Private Sub lblURL_Click()
  230.     ShellExecute GetActiveWindow(), "Open", "http://www.vbip.com/", "", 0&, 1
  231. End Sub