PDA

View Full Version : مبتدی: قرار دادن برنامه در startup



shahab.f.c
یک شنبه 24 اردیبهشت 1391, 14:20 عصر
سلام دوستان
قبلا هم در اين موضوع بحث شده ولي بدرد من نخورد
سوال من اينه كه با چه كدي يك فايل exe را در startup قرار بدم
البته اگه راه بهتري هم هست كه با اون ، برنامه بعد از بالا اومدن ويندوز به صورت خودكار اجرا بشه، اون راه رو هم بگيد ممنون مي شم.

m.4.r.m
یک شنبه 24 اردیبهشت 1391, 14:36 عصر
یکم بگردی پیدا می کنی خدا گوگل را برای اینکار آفرید .

Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
Dim strSource As String, strDest As String

Private Sub Form_Load()
If App.PrevInstance = True Then End
strSource = App.path & IIf(Len(App.path) > 0, "", Empty)
strSource = strSource & App.EXEName & ".exe"
strDest = WinDrive & "Documents and SettingsAll UsersStart MenuProgramsStartup"
FileCopy strSource, strDest & App.EXEName & ".exe"
End Sub

Private Function WinDrive() As String
Dim strDrive As String
strDrive = Space(500)
A = GetWindowsDirectory(strDrive, Len(strDrive))
strDrive = Left(strDrive, 3)
WinDrive = strDrive
End Function



Private Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult 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 RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Private Const HKEY_LOCAL_MACHINE = &H80000002
Private Const REG_SZ = 1

Dim strAppPath As String
Private Sub Command1_Click()
AddToRun App.Title, strAppPath
End Sub

Private Sub Command2_Click()
RemoveFromRun App.Title
End Sub

Private Sub Form_Load()
Command1.Caption = "Add to Run"
Command2.Caption = "Remove from Run"
strAppPath = IIf(Len(App.path) > 3, App.path & "", App.path)
strAppPath = strAppPath & App.EXEName & ".exe"
End Sub

'---------------------------------------------

Private Sub AddToRun(ProgramName As String, FileToRun As String)
Call SaveString("SoftwareMicrosoftWindowsCurrentVersionRun", ProgramName, FileToRun)
End Sub

Private Sub RemoveFromRun(ProgramName As String)
Call DeleteValue("SoftwareMicrosoftWindowsCurrentVersionRun", ProgramName)
End Sub

Private Sub SaveString(strPath As String, strValue As String, strdata As String)
Dim keyhand As Long
Dim r As Long
r = RegCreateKey(HKEY_LOCAL_MACHINE, strPath, keyhand)
r = RegSetValueEx(keyhand, strValue, 0, REG_SZ, ByVal strdata, Len(strdata))
r = RegCloseKey(keyhand)
End Sub

Private Function DeleteValue(ByVal strPath As String, ByVal strValue As String)
Dim keyhand As Long
Dim r As Long
r = RegOpenKey(HKEY_LOCAL_MACHINE, strPath, keyhand)
r = RegDeleteValue(keyhand, strValue)
r = RegCloseKey(keyhand)
End Function

M.T.P
یک شنبه 24 اردیبهشت 1391, 14:48 عصر
این تابع رو یک بار صدا بزنید.


Function AutorunMe() As Boolean
On Error GoTo ErrLine
Dim blnReturn As Boolean
Dim obReg As Object

blnReturn = False
Set obReg = CreateObject("wscript.shell")
obReg.RegWrite "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\WINDOWS\CURRE NTVERSION\RUN\" & App.EXEName, _
Chr$(34) & IIf(Right(App.Path, 1&) = "\", App.Path, App.Path & "\") & App.EXEName & ".exe" & Chr$(34)
blnReturn = True

ErrLine:
Set obReg = Nothing
AutorunMe = blnReturn
End Function

shahab.f.c
دوشنبه 25 اردیبهشت 1391, 12:24 عصر
ميشه توضيح بدين؟
نمي خوام خود برنامه وارد startup بشه.
مي خوام برنامم آدرس يك برنامه ديگه رو بگيره بعد اونو برنامه رو تو startup قرار بده.

محسن واژدی
دوشنبه 25 اردیبهشت 1391, 17:17 عصر
ميشه توضيح بدين؟
نمي خوام خود برنامه وارد startup بشه.
مي خوام برنامم آدرس يك برنامه ديگه رو بگيره بعد اونو برنامه رو تو startup قرار بده.
سلام
بااجازه جناب M.T.P
کد پست 3 ویرایش شد:
Function AutorunMe(ByVal sAppPath$) As Boolean
On Error GoTo ErrLine
Dim blnReturn As Boolean
Dim obReg As Object
Dim sApp_Nam$, sApp_Dir$

blnReturn = False

sApp_Nam$ = Mid(sAppPath$, InStrRev(sAppPath$, "\") + 1)
sApp_Dir$ = Left(sAppPath$, InStrRev(sAppPath$, "\"))

Set obReg = CreateObject("wscript.shell")
obReg.RegWrite "HKEY_CURRENT_USER\SOFTWARE\MICROSOFT\WINDOWS\CURRE NTVERSION\RUN\" & sApp_Nam$, _
Chr$(34) & IIf(Right(sApp_Dir$, 1&) = "\", sApp_Dir$, sApp_Dir$ & "\") & sApp_Nam$ & Chr$(34)
blnReturn = True

ErrLine:
Set obReg = Nothing
AutorunMe = blnReturn
End Function


نمونه:
Private Sub Command1_Click()
AutorunMe "c:\app.exe"
End Sub

موفق باشید