كود لجعل السيرفر يعمل عند بدا تشغيل الجهاز بمفرده

المساهمات : 141 تاريخ التسجيل : 07/03/2008

ضع هذا الكود فى modul و سوف تحصل على ما تريد
بس اهم حاجة انك تكون فاهم فكرة عمل هذا الكود و الا فلن يكون له اى قيمة
و على فكرة الكود محطوط جمب كل سطر فكرة عمل كل كود علشان يبقى الموضوع سهل عليكم و تفهموه بسرعة

كود

Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
Long
Private Declare Function RegSetValueEx Lib "advapi32.dll" Alias _
"RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, _
ByVal Reserved As Long, ByVal dwType As Long, lpData As Any, _
ByVal cbData As Long) As Long

Private Declare Function RegDeleteValue Lib "advapi32.dll" Alias _
"RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private 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
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As _
Long

Const KEY_WRITE = &H20006 '((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or
' KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))

Const REG_SZ = 1
Const REG_BINARY = 3
Const REG_DWORD = 4

Private Enum RunAction
Delete
RunOnce
RunEveryStartUp

End Enum

' Delete a registry value
'
' Return True if successful, False if the value hasn't been found

Private Function DeleteRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String) As Boolean
Dim handle As Long

' Open the key, exit if not found
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then Exit Function

' Delete the value (returns 0 if success)
DeleteRegistryValue = (RegDeleteValue(handle, ValueName) = 0)
' Close the handle
RegCloseKey handle
End Function

Public Sub RunAtStartUp(ByVal Action As RunAction, Optional ByVal AppTitle As String, _
Optional ByVal AppPath As String)

' This is the key under which you must register the apps
' that must execute after every restart
Const HKEY_CURRENT_USER = &H80000001
Const REGKEY = "Software\Microsoft\Windows\CurrentVersion\Run"

' provide a default value for AppTitle
AppTitle = LTrim$(AppTitle)
If Len(AppTitle) = 0 Then AppTitle = App.Title

' this is the complete application path
AppPath = LTrim$(AppPath)
If Len(AppPath) = 0 Then
' if omitted, use the current application executable file
AppPath = App.Path & IIf(Right$(App.Path, 1) <> "\", "\", _
"") & App.EXEName & ".Exe"
End If

Select Case Action
Case 0
' we must delete the key from the registry
DeleteRegistryValue HKEY_CURRENT_USER, REGKEY, AppTitle
Case 1
' we must add a value under the ...\RunOnce key
SetRegistryValue HKEY_CURRENT_USER, REGKEY & "Once", AppTitle, _
AppPath
Case Else
' we must add a value under the ....\Run key
SetRegistryValue HKEY_CURRENT_USER, REGKEY, AppTitle, AppPath
End Select

End Sub

' Write or Create a Registry value
' returns True if successful
'
' Use KeyName = "" for the default value
'
' Value can be an integer value (REG_DWORD), a string (REG_SZ)
' or an array of binary (REG_BINARY). Raises an error otherwise.

Public Function SetRegistryValue(ByVal hKey As Long, ByVal KeyName As String, _
ByVal ValueName As String, value As Variant) As Boolean
Dim handle As Long
Dim lngValue As Long
Dim strValue As String
Dim binValue() As Byte
Dim length As Long
Dim retVal As Long

' Open the key, exit if not found
If RegOpenKeyEx(hKey, KeyName, 0, KEY_WRITE, handle) Then
Exit Function
End If

' three cases, according to the data type in Value
Select Case VarType(value)
Case vbInteger, vbLong
lngValue = value
retVal = RegSetValueEx(handle, ValueName, 0, REG_DWORD, lngValue, 4)
Case vbString
strValue = value
retVal = RegSetValueEx(handle, ValueName, 0, REG_SZ, ByVal strValue, _
Len(strValue))
Case vbArray + vbByte
binValue = value
length = UBound(binValue) - LBound(binValue) + 1
retVal = RegSetValueEx(handle, ValueName, 0, REG_BINARY, _
binValue(LBound(binValue)), length)
Case Else
RegCloseKey handle
Err.Raise 1001, , "Unsupported value type"
End Select

' Close the key and signal success
RegCloseKey handle
' signal success if the value was written correctly
SetRegistryValue = (retVal = 0)
End Function