قرار دادن برنامه در startup

سلام دوستان
قبلا هم در اين موضوع بحث شده ولي بدرد من نخورد
سوال من اينه كه با چه كدي يك فايل exe را در startup قرار بدم
البته اگه راه بهتري هم هست كه با اون ، برنامه بعد از بالا اومدن ويندوز به صورت خودكار اجرا بشه، اون راه رو هم بگيد ممنون مي شم.

یکم بگردی پیدا می کنی خدا گوگل را برای اینکار آفرید .

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("SoftwareMicrosoftWindowsCurrentVersion  Run", ProgramName, FileToRun)

End Sub



Private Sub RemoveFromRun(ProgramName As String)

    Call DeleteValue("SoftwareMicrosoftWindowsCurrentVersio  nRun", 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

این تابع رو یک بار صدا بزنید.

کد HTML:

---

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

---

ميشه توضيح بدين؟
نمي خوام خود برنامه وارد startup بشه.
مي خوام برنامم آدرس يك برنامه ديگه رو بگيره بعد اونو برنامه رو تو startup قرار بده.

نقل قول:

---

نوشته شده توسط shahab.f.c

ميشه توضيح بدين؟
نمي خوام خود برنامه وارد 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\CURR  ENTVERSION\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

موفق باشید