D Conversion
Sprache: English
Programmiersprache: Visual Basic
Veröffentlicht von: dishil [nicht registriert]
Letzte Änderung: 15.05.2006
Aufrufe: 1145
Beschreibung
This program converts Binary to Number and Number to Binary. And it has very good help artical by Snals! Also it looks for the .wav file in same fold as .exe file is stored and it plays the .wav file upon calling about box.
Code
1 Option Explicit
2 Private DX As New DirectX7
3 Private DSOUND As DirectSound
4 Private SoundBuffer As DirectSoundBuffer
5 Private SoundDesc As DSBUFFERDESC
6 Private WavFormat As WAVEFORMATEX
7 Public strFilePath As String
8
9 ' Reg Key Security Options...
10 Const READ_CONTROL = &H20000
11 Const KEY_QUERY_VALUE = &H1
12 Const KEY_SET_VALUE = &H2
13 Const KEY_CREATE_SUB_KEY = &H4
14 Const KEY_ENUMERATE_SUB_KEYS = &H8
15 Const KEY_NOTIFY = &H10
16 Const KEY_CREATE_LINK = &H20
17 Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
18 KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
19 KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
20
21 ' Reg Key ROOT Types...
22 Const HKEY_LOCAL_MACHINE = &H80000002
23 Const ERROR_SUCCESS = 0
24 Const REG_SZ = 1 ' Unicode nul terminated string
25 Const REG_DWORD = 4 ' 32-bit number
26
27 Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
28 Const gREGVALSYSINFOLOC = "MSINFO"
29 Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
30 Const gREGVALSYSINFO = "PATH"
31
32 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
33 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
34 Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
35
36
37 Private Sub cmdSysInfo_Click()
38 Call StartSysInfo
39 End Sub
40
41 Private Sub cmdOK_Click()
42 Unload Me
43 End Sub
44
45 Private Sub Form_Load()
46 strFilePath = App.Path & "\Start.wav"
47 Call CheckFile(strFilePath)
48
49 Me.Caption = "About " & App.Title
50 lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
51 lblTitle.Caption = App.Title
52 End Sub
53 Private Sub CheckFile(ByVal FilePath As String)
54 Dim FileSearch As Object
55 If IsNull(FilePath) Then
56 Exit Sub
57 Else
58 Set FileSearch = CreateObject("Scripting.FileSystemObject")
59 If (FileSearch.FileExists(FilePath)) = True Then
60 Call PlaySound
61 Else
62 Exit Sub
63 End If
64 End If
65 Set FileSearch = Nothing
66 End Sub
67 Private Sub PlaySound()
68 Set DSOUND = DX.DirectSoundCreate("")
69 DSOUND.SetCooperativeLevel hWnd, DSSCL_NORMAL
70 Set SoundBuffer = DSOUND.CreateSoundBufferFromFile(App.Path & "\Start.wav", SoundDesc, WavFormat)
71 SoundBuffer.SetCurrentPosition 0
72 SoundBuffer.Play DSBPLAY_DEFAULT
73 End Sub
74 Public Sub StartSysInfo()
75 On Error GoTo SysInfoErr
76
77 Dim rc As Long
78 Dim SysInfoPath As String
79
80 ' Try To Get System Info Program Path\Name From Registry...
81 If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
82 ' Try To Get System Info Program Path Only From Registry...
83 ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
84 ' Validate Existance Of Known 32 Bit File Version
85 If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
86 SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
87
88 ' Error - File Can Not Be Found...
89 Else
90 GoTo SysInfoErr
91 End If
92 ' Error - Registry Entry Can Not Be Found...
93 Else
94 GoTo SysInfoErr
95 End If
96
97 Call Shell(SysInfoPath, vbNormalFocus)
98
99 Exit Sub
100 SysInfoErr:
101 MsgBox "System Information Is Unavailable At This Time", vbOKOnly
102 End Sub
103
104 Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
105 Dim i As Long ' Loop Counter
106 Dim rc As Long ' Return Code
107 Dim hKey As Long ' Handle To An Open Registry Key
108 Dim hDepth As Long '
109 Dim KeyValType As Long ' Data Type Of A Registry Key
110 Dim tmpVal As String ' Tempory Storage For A Registry Key Value
111 Dim KeyValSize As Long ' Size Of Registry Key Variable
112 '------------------------------------------------------------
113 ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
114 '------------------------------------------------------------
115 rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
116
117 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Error...
118
119 tmpVal = String$(1024, 0) ' Allocate Variable Space
120 KeyValSize = 1024 ' Mark Variable Size
121
122 '------------------------------------------------------------
123 ' Retrieve Registry Key Value...
124 '------------------------------------------------------------
125 rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
126 KeyValType, tmpVal, KeyValSize) ' Get/Create Key Value
127
128 If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError ' Handle Errors
129
130 If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then ' Win95 Adds Null Terminated String...
131 tmpVal = Left(tmpVal, KeyValSize - 1) ' Null Found, Extract From String
132 Else ' WinNT Does NOT Null Terminate String...
133 tmpVal = Left(tmpVal, KeyValSize) ' Null Not Found, Extract String Only
134 End If
135 '------------------------------------------------------------
136 ' Determine Key Value Type For Conversion...
137 '------------------------------------------------------------
138 Select Case KeyValType ' Search Data Types...
139 Case REG_SZ ' String Registry Key Data Type
140 KeyVal = tmpVal ' Copy String Value
141 Case REG_DWORD ' Double Word Registry Key Data Type
142 For i = Len(tmpVal) To 1 Step -1 ' Convert Each Bit
143 KeyVal = KeyVal + Hex(Asc(Mid(tmpVal, i, 1))) ' Build Value Char. By Char.
144 Next
145 KeyVal = Format$("&h" + KeyVal) ' Convert Double Word To String
146 End Select
147
148 GetKeyValue = True ' Return Success
149 rc = RegCloseKey(hKey) ' Close Registry Key
150 Exit Function ' Exit
151
152 GetKeyError: ' Cleanup After An Error Has Occured...
153 KeyVal = "" ' Set Return Val To Empty String
154 GetKeyValue = False ' Return Failure
155 rc = RegCloseKey(hKey) ' Close Registry Key
156 End Function
157
158
Noch kein Kommentar vorhanden
Dieses Snippet kommentieren
Name *
E-Mail (wird nicht angezeigt) *
Website
Kommentar *
Sicherheitscode *