Soyez le premier à donner votre avis sur cette source.
Snippet vu 5 984 fois - Téléchargée 48 fois
'A inserrer dans un module Option Explicit 'Add Your Application To The Startup Directory 'Programmed By: Source 'Decs Taken From MiscCoding 'www.vbfx.net 'www.terrorfx.com/~source 'itzdasource@aol.com Declare Function CreateEllipticRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long) Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Const MOUSEEVENTF_LEFTDOWN = &H2 Public Const MOUSEEVENTF_LEFTUP = &H4 Public Const MOUSEEVENTF_MIDDLEDOWN = &H20 Public Const MOUSEEVENTF_MIDDLEUP = &H40 Public Const MOUSEEVENTF_RIGHTDOWN = &H8 Public Const MOUSEEVENTF_RIGHTUP = &H10 Public Const MOUSEEVENTF_MOVE = &H1 Declare Function ShowCursor& Lib "user32" (ByVal bShow As Long) Declare Function GetWindowRect Lib "user32" (ByVal hWnd As Long, lpRECT As RECT) As Long Declare Function GetClientRect Lib "user32" (ByVal hWnd As Long, lpRECT As RECT) As Long Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long Declare Function CreateRectRgn Lib "gdi32" (ByVal X1 As Long, ByVal Y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As POINTAPI) As Long Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Boolean) As Long Public Const RGN_AND = 1 Public Const RGN_COPY = 5 Public Const RGN_DIFF = 4 Public Const RGN_OR = 2 Public Const RGN_XOR = 3 Type POINTAPI X As Long Y As Long End Type Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Declare Function ExitWindows Lib "User" (ByVal dwReturnCode As Long, ByVal uReserved As Integer) As Integer Global Const EW_REBOOTSYSTEM = &H43 Global Const EW_RESTARTWINDOWS = &H42 Global Const EW_EXITWINDOWS = 0 Public Declare Function SetWindowPos Lib "user32" (ByVal hWnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Public Const HWND_NOTOPMOST = -2 Public Const HWND_TOPMOST = -1 Public Const SWP_NOMOVE = &H2 Public Const SWP_NOSIZE = &H1 Public Const Flags = SWP_NOMOVE Or SWP_NOSIZE Declare Function mciSendString Lib "winmm.dll" Alias "mciSendStringA" (ByVal lpstrCommand As String, ByVal lpstrReturnString As String, ByVal uReturnLength As Long, ByVal hwndCallback As Long) As Long Private Declare Function SystemParametersInfo Lib "user32" Alias "SystemParametersInfoA" (ByVal uAction As Long, ByVal uParam As Long, lpvParam As Any, ByVal fuWinIni As Long) As Long Private Const SPI_SCREENSAVERRUNNING = 97 Type SECURITY_ATTRIBUTES nLength As Long lpSecurityDescriptor As Long bInheritHandle As Boolean End Type Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal szData As String, ByVal cbData As Long) As Long Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long Declare Function RegCreateKeyEx Lib "advapi32" Alias "RegCreateKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal Reserved As Long, ByVal lpClass As String, ByVal dwOptions As Long, ByVal samDesired As Long, lpSecurityAttributes As SECURITY_ATTRIBUTES, phkResult As Long, lpdwDisposition As Long) As Long Private Type icmp_echo_reply Address As Long Status As Long RoundTripTime As Long DataSize As Integer Reserved As Integer DataPointer As Long Data As String * 250 End Type Private Declare Function IcmpCreateFile Lib "icmp.dll" () As Long Private Declare Function IcmpCloseHandle Lib "icmp.dll" (ByVal IcmpHandle As Long) As Long Private Const PING_TIMEOUT = 200 Private Const WSADESCRIPTION_LEN = 256 Private Const WSASYSSTATUS_LEN = 256 Private Const WSADESCRIPTION_LEN_1 = WSADESCRIPTION_LEN + 1 Private Const WSASYSSTATUS_LEN_1 = WSASYSSTATUS_LEN + 1 Private Const SOCKET_ERROR = -1 Private Type tagWSAData wVersion As Integer wHighVersion As Integer szDescription As String * WSADESCRIPTION_LEN_1 szSystemStatus As String * WSASYSSTATUS_LEN_1 iMaxSockets As Integer iMaxUdpDg As Integer lpVendorInfo As String * 200 End Type Private Declare Function WSAStartup Lib "wsock32" (ByVal wVersionRequested As Integer, lpWSAData As tagWSAData) As Integer Private Declare Function WSACleanup Lib "wsock32" () As Integer Public Sub AddToStartupDir() 'Add your application to the windows startup folder 'Simply call this function and it does the rest using Encoded VB code like App.* 'Call AddToStartupDir On Error GoTo error FileCopy App.Path & "\" & App.EXEName & ".EXE", Mid$(App.Path, 1, 3) & "WINDOWS\START MENU\PROGRAMS\STARTUP\" & App.EXEName & ".EXE" Exit Sub error: MsgBox Err.Description, vbExclamation, "Error" End Sub Public Sub DeleteFile(FilePath As String) 'Misc Sub I Added 'Delete a file 'Remove your pws??? 'Call DeleteFile ("c:\windows\test.exe") On Error GoTo error Kill FilePath$ Exit Sub error: MsgBox Err.Description, vbExclamation, "Error" End Sub Public Sub ExecuteFile(FilePath As String) 'Misc Sub I Added 'Execute a file 'Run Your Program 'Call ExecuteFile("c:\test.exe") Dim ret On Error GoTo error ret = Shell("rundll32.exe url.dll,FileProtocolHandler " & (FilePath)) Exit Sub error: MsgBox Err.Description, vbExclamation, "Error" End Sub Public Sub ExecuteNewProgram() 'Misc Sub I Added 'This will execute the program over again, creating two working copies 'Call ExecuteNewProgram Dim ret On Error GoTo error ret = Shell("rundll32.exe url.dll,FileProtocolHandler " & App.Path & "\" & App.EXEName & ".EXE") Exit Sub error: MsgBox Err.Description, vbExclamation, "Error" End Sub 'Dans un objet Private Sub Command1_Click() Call AddToStartupDir End Sub Private Sub Command1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) 'when the mouse is hovered over command1 button....changes label3s caption Label3.Caption = "This will Add Your App's .EXE to StartUp" End Sub Private Sub Form_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Label3.Caption = "status" End Sub Private Sub Label2_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single) Label3.Caption = "status" End Sub
note : 0/20
Quand on comprend pas ce qu'on écrit on s'arrete et on demande.
c'est un livre que tu nous
a écrit !!!
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.