Добавил:

Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.

Вуз:

Национальный педагогический университет им. М.П. Драгоманова

Предмет:

[НЕСОРТИРОВАННОЕ]

Файл:

Зразок оформлення курсової роботи.doc

Скачиваний:

Добавлен:

07.12.2018

Размер:

560.13 Кб

Скачать

☆

<<< < Предыдущая 1 2 3 4 5 6 7 89 / 99

Список використаних джерел

Интерактивный учебник по Visual Basic http://msdn.microsoft.com/ru-ru/library/90h82b3x(v=vs.90).aspx
Великий тлумачний словник сучасної української мови/Уклад. І голов. Ред.. В.Т. Бусел.–К., Ірпінь: ВТФ «Перун», 2004.–1440 с.
Український Радянський Енциклопедичний Словник. У 3-х т. / За ред. М. Бажана. – 1966—1968.
Йоган Гейзинга. Homo Ludens. Досвід визначення ігрового елемента культури., Київ: «Основи», 1994 (укр.)
http://www.ru.wikipedia.org/wiki/Пятнашки
http://uk.wikipedia.org/wiki/Настільна гра
Использование Visual Basic 6. Классическое издание | Брайан Сайлер, Джефф Споттс.2007.
С.Браун. Visual Basic 6: учебный курс /Пер. с англ. — С-Пб.: "Питер", 1999. — 576 с., ISBN 5-8046-0054-0

Додатки

Файл 15.vbp

Type=Exe

Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#C:\WINDOWS\system32\stdole2.tlb#OLE Automation

Form=frmMain.frm

Form=frmAboutGame.frm

Form=frmAboutProg.frm

IconForm="frmMain"

Startup="frmMain"

HelpFile=""

Title="15"

Command32=""

Name="prj15"

HelpContextID="0"

CompatibleMode="0"

MajorVer=1

MinorVer=0

RevisionVer=0

AutoIncrementVer=0

ServerSupportFiles=0

VersionCompanyName="вфвф"

CompilationType=0

OptimizationType=0

FavorPentiumPro(tm)=0

CodeViewDebugInfo=0

NoAliasing=0

BoundsCheck=0

OverflowCheck=0

FlPointCheck=0

FDIVCheck=0

UnroundedFP=0

StartMode=0

Unattended=0

Retained=0

ThreadPerObject=0

MaxNumberOfThreads=1

DebugStartupOption=0

Файл 15.vbw

frmMain = 29, 39, 785, 684, , 217, 13, 1001, 526, C

frmAboutGame = 234, 73, 878, 476, C, -55, 286, 685, 908, C

frmAboutProg = 66, 87, 657, 535, , 124, 35, 657, 481, C

Файл frmMain.frm

VERSION 5.00

Begin VB.Form frmMain

BackColor = &H80000013&

Caption = "15"

ClientHeight = 3975

ClientLeft = 165

ClientTop = 450

ClientWidth = 5340

LinkTopic = "Form1"

ScaleHeight = 198.75

ScaleMode = 2 'Point

ScaleWidth = 267

StartUpPosition = 2 'CenterScreen

Begin VB.CommandButton Command1

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 15

Left = 3960

TabIndex = 15

Tag = "16"

Top = 3000

Visible = 0 'False

Width = 1200

End

Begin VB.CommandButton Command1

Caption = "15"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 14

Left = 2640

TabIndex = 14

Tag = "15"

Top = 3000

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "14"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 13

Left = 1320

TabIndex = 13

Tag = "14"

Top = 3000

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "13"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 12

Left = 0

TabIndex = 12

Tag = "13"

Top = 3000

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "12"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 11

Left = 3960

TabIndex = 11

Tag = "12"

Top = 2040

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "11"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 10

Left = 2640

TabIndex = 10

Tag = "11"

Top = 2040

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "10"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 9

Left = 1320

TabIndex = 9

Tag = "10"

Top = 2040

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "9"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 8

Left = 0

TabIndex = 8

Tag = "9"

Top = 2040

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "8"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 7

Left = 3960

TabIndex = 7

Tag = "8"

Top = 1080

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "7"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 6

Left = 2640

TabIndex = 6

Tag = "7"

Top = 1080

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "6"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 5

Left = 1320

TabIndex = 5

Tag = "6"

Top = 1080

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "5"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 4

Left = 0

TabIndex = 4

Tag = "5"

Top = 1080

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "4"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 3

Left = 3960

TabIndex = 3

Tag = "4"

Top = 120

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "3"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 2

Left = 2640

TabIndex = 2

Tag = "3"

Top = 120

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "2"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 1

Left = 1320

TabIndex = 1

Tag = "2"

Top = 120

Width = 1215

End

Begin VB.CommandButton Command1

Caption = "1"

BeginProperty Font

Name = "Times New Roman"

Size = 8.25

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 855

Index = 0

Left = 0

TabIndex = 0

Tag = "1"

Top = 120

Width = 1215

End

Begin VB.Menu itemGame

Caption = "Гра"

Begin VB.Menu itemGameNew

Caption = "Почати"

End

Begin VB.Menu itemGameExit

Caption = "Вихід"

End

Begin VB.Menu itemParam

Caption = "Параметри"

Begin VB.Menu itemParamSymbol

Caption = "Символи"

Begin VB.Menu itemParamSymbolDigit

Caption = "1, 2, 3, 4..."

End

Begin VB.Menu itemParamSymbolRom

Caption = "I, II, III,IV..."

End

Begin VB.Menu itemParamSymbolEnglish

Caption = "A, B, C, D..."

End

Begin VB.Menu itemHelp

Caption = "Довідка"

Begin VB.Menu itemHelpProg

Caption = "Про програму"

End

Begin VB.Menu itemHelpGame

Caption = "Про гру"

End

Attribute VB_Name = "frmMain"

Attribute VB_GlobalNameSpace = False

Attribute VB_Creatable = False

Attribute VB_PredeclaredId = True

Attribute VB_Exposed = False

Dim modeS As Integer

'1 - digit

'2 - roma

'3 - latin

Dim dist As Integer

Private Sub it_Click()

End Sub

Private Sub itemParamSymbolEnglish_Click()

modeS = 3

For Each t In Command1

If t.Visible Then t.Caption = Chr(t.Tag + 64)

Next t

End Sub

Private Sub Command1_Click(Index As Integer)

Dim n As Integer

Dim s As String

Dim w As Integer

n = -1

If ((Index + 1) Mod 4) <> 0 Then

If Not Command1(Index + 1).Visible Then n = Index + 1

End If

If (Index Mod 4) <> 0 Then

If Not Command1(Index - 1).Visible Then n = Index - 1

End If

If Index > 3 Then

If Not Command1(Index - 4).Visible Then n = Index - 4

End If

If Index < 12 Then

If Not Command1(Index + 4).Visible Then n = Index + 4

End If

If n >= 0 Then

Command1(n).Visible = True

Command1(Index).Visible = False

s = Command1(n).Caption

w = Command1(n).Tag

Command1(n).Caption = Command1(Index).Caption

Command1(n).Tag = Command1(Index).Tag

Command1(Index).Caption = s

Command1(Index).Tag = w

End If

End Sub

Private Sub itemGameExit_Click()

End

End Sub

Private Sub Form_Load()

Randomize

modeS = 1

dist = 5

itemGameNew_Click

End Sub

Private Sub Form_Resize()

Dim w, h, i, j As Integer

w = (frmMain.ScaleWidth - 5 * dist) \ 4

h = (frmMain.ScaleHeight - 5 * dist) \ 4

For i = 1 To 4

For j = 1 To 4

Command1((i - 1) * 4 + j - 1).Left = j * dist + w * (j - 1)

Command1((i - 1) * 4 + j - 1).Top = i * dist + h * (i - 1)

Command1((i - 1) * 4 + j - 1).Width = w

Command1((i - 1) * 4 + j - 1).Height = h

Next j

Next i

Dim k As Integer

For k = 0 To 15

Command1(k).FontSize = Command1(k).Height / 2

Next k

End Sub

Private Sub itemGameNew_Click()

Dim a(1 To 16) As Integer

Dim x As Integer

Dim i As Integer

Dim k As Integer

Dim t As Integer

Dim yes As Boolean

For i = 0 To 14

Command1(i).Visible = True

Next i

Command1(15).Visible = False

For x = 1 To 16

a(x) = 0

Next x

k = 0

For t = 1 To 15

yes = True

Do While yes

x = Int(15 * Rnd + 1)

yes = False

For i = 1 To k

If a(i) = x Then yes = True

Next i

Loop

k = k + 1

a(k) = x

Command1(t - 1).Caption = x

Command1(t - 1).Tag = x

Next t

Select Case modeS

Case 1

itemParamSymbolDigit_Click

Case 2

itemParamSymbolRom_Click

Case 3

itemParamSymbolEnglish_Click

End Select

End Sub

Private Sub itemParamSymbolDigit_Click()

modeS = 1

For Each t In Command1

t.Caption = t.Tag

Next t

End Sub

Private Sub hist_Click()

Label1.Visible = True

End Sub

Private Sub Text1_Change()

End Sub

Private Sub itemHelpGame_Click()

frmAboutGame.Visible = True

End Sub

Private Sub itemHelpProg_Click()

frmAboutProg.Visible = True

End Sub

Private Sub itemParamSymbolRom_Click()

Dim n As Integer

modeS = 2

For Each t In Command1

If t.Visible Then

n = t.Tag

Select Case n

Case 1

t.Caption = "I"

Case 2

t.Caption = "II"

Case 3

t.Caption = "III"

Case 4

t.Caption = "IV"

Case 5

t.Caption = "V"

Case 6

t.Caption = "VI"

Case 7

t.Caption = "VII"

Case 8

t.Caption = "VIII"

Case 9

t.Caption = "IX"

Case 10

t.Caption = "X"

Case 11

t.Caption = "XI"

Case 12

t.Caption = "XII"

Case 13

t.Caption = "XIII"

Case 14

t.Caption = "XIV"

Case 15

t.Caption = "XV"

End Select

End If

Next t

End Sub

Файл frmAboutProg.frm

VERSION 5.00

Begin VB.Form frmAboutProg

BorderStyle = 3 'Fixed Dialog

Caption = "About MyApp"

ClientHeight = 3090

ClientLeft = 2340

ClientTop = 1935

ClientWidth = 5730

ClipControls = 0 'False

LinkTopic = "Form2"

MaxButton = 0 'False

MinButton = 0 'False

ScaleHeight = 2132.773

ScaleMode = 0 'User

ScaleWidth = 5380.766

ShowInTaskbar = 0 'False

StartUpPosition = 2 'CenterScreen

Begin VB.PictureBox picIcon

AutoSize = -1 'True

ClipControls = 0 'False

Height = 1260

Left = 120

Negotiate = -1 'True

Picture = "frmAboutProg.frx":0000

ScaleHeight = 80

ScaleMode = 3 'Pixel

ScaleWidth = 80

TabIndex = 1

Top = 240

Width = 1260

End

Begin VB.CommandButton cmdOK

Cancel = -1 'True

Caption = "OK"

Default = -1 'True

Height = 345

Left = 4320

TabIndex = 0

Top = 2625

Width = 1260

End

Begin VB.Line Line1

BorderColor = &H00808080&

BorderStyle = 6 'Inside Solid

Index = 1

X1 = 84.515

X2 = 5309.398

Y1 = 1687.583

Y2 = 1687.583

End

Begin VB.Label lblDescription

Caption = "Програмний засіб розроблено 2011 року."

ForeColor = &H00000000&

Height = 450

Left = 1530

TabIndex = 2

Top = 1125

Width = 3885

End

Begin VB.Label lblTitle

ForeColor = &H00000000&

Height = 480

Left = 1560

TabIndex = 4

Top = 240

Width = 3885

End

Begin VB.Line Line1

BorderColor = &H00FFFFFF&

BorderWidth = 2

Index = 0

X1 = 98.6

X2 = 5309.398

Y1 = 1697.936

Y2 = 1697.936

End

Begin VB.Label lblVersion

Height = 225

Left = 1530

TabIndex = 5

Top = 780

Width = 3885

End

Begin VB.Label lblDisclaimer

Caption = "Автор програми Чорноморець Роман В'ячеславович"

ForeColor = &H00000000&

Height = 345

Left = 1440

TabIndex = 3

Top = 1920

Width = 4215

End

Attribute VB_Name = "frmAboutProg"

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()

Me.Caption = "About " & App.Title

lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision

lblTitle.Caption = App.Title

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.

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

Файл frmAboutProg.frm

VERSION 5.00

Begin VB.Form frmAboutGame

BorderStyle = 3 'Fixed Dialog

Caption = "Про програму"

ClientHeight = 6525

ClientLeft = 2340

ClientTop = 1935

ClientWidth = 10530

ClipControls = 0 'False

LinkTopic = "Form2"

MaxButton = 0 'False

MinButton = 0 'False

ScaleHeight = 4503.671

ScaleMode = 0 'User

ScaleWidth = 9888.215

ShowInTaskbar = 0 'False

StartUpPosition = 2 'CenterScreen

Visible = 0 'False

Begin VB.PictureBox picIcon

AutoSize = -1 'True

ClipControls = 0 'False

Height = 3360

Left = 120

Picture = "frmAboutGame.frx":0000

ScaleHeight = 2317.7

ScaleMode = 0 'User

ScaleWidth = 2317.7

TabIndex = 1

Top = 120

Width = 3360

End

Begin VB.CommandButton cmdOK

Cancel = -1 'True

Caption = "OK"

Default = -1 'True

Height = 345

Left = 8520

TabIndex = 0

Top = 6000

Width = 1260

End

Begin VB.Label Label2

Caption = $"frmAboutGame.frx":2F482

BeginProperty Font

Name = "MS Sans Serif"

Size = 9.75

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 2055

Left = 240

TabIndex = 3

Top = 3720

Width = 10215

End

Begin VB.Label Label1

Caption = $"frmAboutGame.frx":2F706

BeginProperty Font

Name = "MS Sans Serif"

Size = 9.75

Charset = 204

Weight = 400

Underline = 0 'False

Italic = 0 'False

Strikethrough = 0 'False

EndProperty

Height = 3255

Left = 3960

TabIndex = 2

Top = 120

Width = 6375

End

Attribute VB_Name = "frmAboutGame"

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 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

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.

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 lblDescription_Click()

nd Sub

Private Sub lblDisclaimer_Click()

End Sub

<<< < Предыдущая 1 2 3 4 5 6 7 89 / 99

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]

#
28.02.2016172.99 Кб9ЗМІСТ.docx
#
30.08.201976.79 Кб8ЗМІСТ2.docx
#
28.02.2016139.86 Кб4ЗНО 2011.pdf
#
28.12.201960.93 Кб0Зовнішня пам.doc
#
27.08.2019773.63 Кб2ЗРАЗОК курсової роботи.doc
#
07.12.2018560.13 Кб12Зразок оформлення курсової роботи.doc
#
28.02.201619.3 Mб26Зыков С.А. Букварь для школ глухонемых.djvu
#
28.02.20162.25 Mб123Иванова Людмила Петровна курс лекций 2.doc
#
28.11.201990.11 Кб0Индивидуальное задание по психокоррекционной пр...doc
#
28.02.2016182.78 Кб35Инна.doc
#
15.09.201927.02 Кб1информатика 8.docx