1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
|
'Dieser Source stammt von [URL]http://www.vb-fun.de[/URL] und kann frei
'in EIGENEN (auch in EIGENEN kommerziellen) Projekten verwendet
'werden. Er darf NICHT auf anderen Webseiten oder Foren ohne
'Quellenangabe veröffentlicht werden (siehe hierzu auch die
'Hinweise unter "Urheber- und Kennzeichenrecht" im Impressum).
'Für eventuelle Schäden wird nicht gehaftet.
'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source-Code !
Option Explicit
Public Declare Function RegQueryValueEx Lib "advapi32.dll" Alias _
"RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal lpReserved As Long, lpType As Long, lpData _
As Any, lpcbData As Any) As Long
Public Declare Function RegOpenKeyEx Lib "advapi32.dll" Alias _
"RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey _
As String, ByVal ulOptions As Long, ByVal samDesired As Long, _
phkResult As Long) As Long
Public Declare Function RegCloseKey Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
Public Declare Function RegSetValueEx_String Lib "advapi32.dll" _
Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName _
As String, ByVal Reserved As Long, ByVal dwType As Long, _
ByVal lpData As String, ByVal cbData As Long) As Long
Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName _
As String) As Long
Private Const HKEY_CURRENT_USER = &H80000001
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const KEY_QUERY_VALUE = &H1
Private Const KEY_SET_VALUE = &H2
Private Const KEY_CREATE_SUB_KEY = &H4
Private Const KEY_ENUMERATE_SUB_KEYS = &H8
Private Const KEY_NOTIFY = &H10
Private Const KEY_CREATE_LINK = &H20
Private Const KEY_ALL_ACCESS = KEY_QUERY_VALUE Or KEY_SET_VALUE _
Or KEY_CREATE_SUB_KEY Or KEY_ENUMERATE_SUB_KEYS Or _
KEY_NOTIFY Or KEY_CREATE_LINK
Private Const KEY_READ = KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS _
Or KEY_NOTIFY
Private Const KEY_WRITE = KEY_SET_VALUE Or KEY_CREATE_SUB_KEY
Private Const KEY_EXECUTE = KEY_READ
Private Const ERROR_SUCCESS = 0&
Private Const REG_NONE = 0
Private Const REG_SZ = 1
Private Const root = HKEY_LOCAL_MACHINE
'Private Const root = HKEY_CURRENT_USER
Private Const key As String = _
"SOFTWARE\Microsoft\Windows\CurrentVersion\Run"
Public Function SetRun() As Boolean
Dim lResult As Long
Dim lKeyHandle As Long
Dim sField As String
Dim sPath As String
sField = App.EXEName
sPath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & _
App.EXEName & ".exe"
lResult = RegOpenKeyEx(root, key, 0, KEY_ALL_ACCESS, lKeyHandle)
If lResult <> ERROR_SUCCESS Then
SetRun = False
Exit Function
End If
lResult = RegSetValueEx_String(lKeyHandle, sField, 0, _
REG_SZ, sPath, Len(sPath) + 1)
RegCloseKey lKeyHandle
SetRun = (lResult = ERROR_SUCCESS)
End Function
Public Function DeleteRun() As Boolean
Dim lResult As Long
Dim lKeyHandle As Long
Dim sField As String
Dim sPath As String
sField = App.EXEName
sPath = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & _
App.EXEName & ".exe"
lResult = RegOpenKeyEx(root, key, 0, KEY_ALL_ACCESS, lKeyHandle)
If lResult <> ERROR_SUCCESS Then
DeleteRun = False
Exit Function
End If
lResult = RegDeleteValue(lKeyHandle, sField)
DeleteRun = (lResult = ERROR_SUCCESS)
RegCloseKey lKeyHandle
End Function
Public Function IsRun() As Boolean
Dim sField As String
Dim Value As Variant
Dim lResult As Long
Dim lKeyHandle As Long
Dim dwType As Long
Dim lBufferSize As Long
Dim sBuffer As String
Dim iPos As Integer
sField = App.EXEName
Value = App.Path & IIf(Right(App.Path, 1) = "\", "", "\") & _
App.EXEName & ".exe"
lResult = RegOpenKeyEx(root, key, 0, KEY_READ, lKeyHandle)
IsRun = (lResult = ERROR_SUCCESS)
If lResult <> ERROR_SUCCESS Then Exit Function ' Key existiert nicht
lResult = RegQueryValueEx(lKeyHandle, sField, 0&, dwType, _
ByVal 0&, lBufferSize)
IsRun = (lResult = ERROR_SUCCESS)
If lResult <> ERROR_SUCCESS Then Exit Function ' Feld existiert nicht
If dwType = REG_SZ Then ' nullterminierter String
sBuffer = Space$(lBufferSize + 1)
lResult = RegQueryValueEx(lKeyHandle, sField, 0&, dwType, _
ByVal sBuffer, lBufferSize)
IsRun = (lResult = ERROR_SUCCESS)
If lResult <> ERROR_SUCCESS Then Exit Function ' Fehler beim auslesen des Feldes
'bis zum Nullbyte auslesen
iPos = InStr(sBuffer, Chr$(0))
If iPos Then Value = Left(sBuffer, iPos - 1)
End If
If lResult = ERROR_SUCCESS Then RegCloseKey lKeyHandle
IsRun = True
End Function
|