国产一级a片免费看高清,亚洲熟女中文字幕在线视频,黄三级高清在线播放,免费黄色视频在线看

有兩種方法，1是注冊表方式

模塊代碼

Option Explicit

Public 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

Public Declare Function RegCreateKey Lib "advapi32.dll" Alias "RegCreateKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

Public Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long

Public Declare Function RegDeleteValue Lib "advapi32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long

Public Const REG_SZ = 1

Public Const HKEY_LOCAL_MACHINE = &H80000002

‘*************************************************************************
‘**函 數(shù) 名： SetAutoRun
‘**輸    入： ByVal Autorun(Boolean) -
‘**輸    出： 無
‘**功能描述： 隨WINDOWS自動(dòng)啟動(dòng)/取消啟動(dòng)模塊
‘**全局變量：
‘**調(diào)用方法： Call SetAutoRun(True/False)
‘**作    者： Mr.David
‘**日    期： 2006-09-05 09:07:25
‘**修 改 人：
‘**日    期：
‘**版    本： V1.0.0
‘*************************************************************************

Public Sub SetAutoRun(ByVal Autorun As Boolean)

    Dim KeyId As Long
    Dim MyexePath As String
    Dim regkey As String
   
    MyexePath = App.Path & "\" & App.EXEName & ".exe" ‘獲取程序位置

    regkey = "Software\Microsoft\Windows\CurrentVersion\Run" ‘鍵值位置變量

    Call RegCreateKey(HKEY_LOCAL_MACHINE, regkey, KeyId) ‘建立
   
    If Autorun Then

        RegSetValueEx KeyId, "MySoftware", 0&, REG_SZ, ByVal MyexePath, LenB(MyexePath)

    Else

        RegDeleteValue KeyId, "MySoftware"

    End If

    RegCloseKey KeyId

End Sub

調(diào)用方法

SetAutoRun(ByVal Autorun As Boolean) 

2是利用Vb5stkit.dll里面的函數(shù)

窗體部分代碼,加入6個(gè)按鈕

Option Explicit

Private Sub CmdAddStartup_Click()       ‘在開始菜單的啟動(dòng)程序組下創(chuàng)建記事本的快捷方式

    Call OSfCreateShellLink("\啟動(dòng)", "記事本", GetWindowsPath & "\Notepad.exe", "")

End Sub

Private Sub CmdAddDeskTop_Click()       ‘在桌面創(chuàng)建記事本的快捷方式

    Call OSfCreateShellLink("..\..\桌面", "記事本", GetWindowsPath & "\Notepad.exe", "")

End Sub

Private Sub CmdAddProgram_Click()       ‘在程序菜單的Notepad程序組下創(chuàng)建記事本的快捷方式

    Call OSfCreateShellGroup("Notepad") ‘先建立程序組

    Call OSfCreateShellLink("Notepad", "記事本", GetWindowsPath & "\Notepad.exe", "")

End Sub

Private Sub CmdAddStartMenu_Click()

    Dim i As Long

    For i = 1 To 5                     ‘在開始菜單創(chuàng)建記事本的快捷方式,必須用循環(huán)才能創(chuàng)建?
        
        Call OSfCreateShellLink("..\..\「開始」菜單", "記事本", GetWindowsPath & "\Notepad.exe", "")

    Next

End Sub
   
Private Sub CmdQuickLaunch_Click()     ‘在快捷工具欄下創(chuàng)建記事本的快捷方式

    Call OSfCreateShellLink("..\..\Application Data\Microsoft\Internet Explorer\Quick Launch", "記事本", GetWindowsPath & "\Notepad.exe", "")

End Sub

Private Sub CmdDelAllLink_Click()

    Call OSfRemoveShellLink("..\..\「開始」菜單", "記事本")         ‘刪除開始菜單上的快捷方式

    Call OSfRemoveShellLink("..\..\桌面", "記事本")                 ‘刪除桌面上的快捷方式

    ‘Call OSfRemoveShellLink("Notepad", "記事本")                   ‘刪除Notepad程序組下的快捷方式,這樣不能刪除程序組
   
    Call RemoveShellGroup                                           ‘刪除Notepad程序組下的快捷方式

    Call OSfRemoveShellLink("\啟動(dòng)", "記事本")                      ‘刪除啟動(dòng)菜單下的快捷方式

    Call OSfRemoveShellLink("..\..\Application Data\Microsoft\Internet Explorer\Quick Launch", "記事本")     ‘刪除快捷工具欄下的快捷方式

End Sub

Private Sub RemoveShellGroup()

    On Error GoTo ToExit ‘打開錯(cuò)誤陷阱

    ‘------------------------------------------------

    ‘RmDir刪除一個(gè)存在的目錄或文件夾。語法RmDir Path
    ‘必要的 path 參數(shù)是一個(gè)字符串表達(dá)式，用來指定要?jiǎng)h除的目錄或文件夾。path 可以包含驅(qū)動(dòng)器。如果沒有指定驅(qū)動(dòng)器，則 RmDir 會(huì)在當(dāng)前驅(qū)動(dòng)器上刪除目錄或文件夾。
    ‘說明如果想要使用 RmDir 來刪除一個(gè)含有文件的目錄或文件夾，則會(huì)發(fā)生錯(cuò)誤。在試圖刪除目錄或文件夾之前，先使用 Kill 語句來刪除所有文件。

    Kill (GetProgarmPath(Me.hWnd) & "\Notepad\記事本.lnk")
    RmDir (GetProgarmPath(Me.hWnd) & "\Notepad")

    ‘------------------------------------------------

    Exit Sub

    ‘----------------

ToExit:

    Resume Next

End Sub 

‘模塊代碼

Option Explicit

‘-----------------------------------------------------
‘               創(chuàng)建和刪除快捷方式
‘-----------------------------------------------------
‘               洪恩在線  求知無限
‘-----------------------------------------------------
‘------名稱-------------------作用--------------------
‘       CmdAddStartup             "創(chuàng)建啟動(dòng)程序組快捷方式"
‘       CmdAddDeskTop             "創(chuàng)建桌面快捷方式"
‘       CmdAddStartMenu           "創(chuàng)建開始菜單快捷方式"
‘       CmdAddProgram             "創(chuàng)建程序組下的快捷方式"
‘       CmdQuickLaunch            "創(chuàng)建快捷工具欄的快捷方式"
‘       CmdDelAllLink             "刪除所有快捷方式"
‘-----------------------------------------------------
‘要在VB中創(chuàng)建Windows的快捷方式，需要用到VB的一個(gè)動(dòng)態(tài)鏈接庫
‘Vb5stkit.dll。在該動(dòng)態(tài)鏈接庫中提供了三個(gè)函數(shù)
‘OSfCreateShellGroup、OSfCreateShellLink、OSfRemoveShellLink
‘分別用于創(chuàng)建快捷方式程序組、創(chuàng)建快捷方式和刪除快捷方式。
‘-----------------------------------------------------

Declare Function OSfCreateShellGroup Lib "Vb5stkit.dll" _
        Alias "fCreateShellFolder" (ByVal lpstrDirName As String) As Long
        
‘lpstrDirName指定了程序組的名稱
‘-----------------------------------------------------

Declare Function OSfCreateShellLink Lib "Vb5stkit.dll" _
        Alias "fCreateShellLink" (ByVal lpstrFolderName As String, _
        ByVal lpstrLinkName As String, ByVal lpstrLinkPath As String, ByVal lpstrLinkArguments As String) As Long
        
‘lpstrfoldername指定保存快捷方式的文件夾
‘lpstrlinkname指定快捷方式的文件名
‘lpstrLinkpathe指定快捷方式所指向的應(yīng)用程序或文件
‘lpstrLinkArguments是程序運(yùn)行所需的參數(shù)
‘-----------------------------------------------------

Declare Function OSfRemoveShellLink Lib "Vb5stkit.dll" Alias _
        "fRemoveShellLink" (ByVal lpstrFolderName As String, ByVal lpstrLinkName As String) As Long

‘獲取Windows目錄
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias _
                          "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long

‘獲得文件夾路徑
Private Declare Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" (ByVal hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal fCreate As Long) As Long

Private Const Max_Path = 260       ‘緩沖區(qū)大小
Private Const CSIDL_PROGRAMS = &H2 ‘程序組常量

‘*************************************************************************
‘**函 數(shù) 名： GetWindowsPath
‘**輸    入： 無
‘**輸    出： (String) -
‘**功能描述： 得到Windows路徑
‘**全局變量：
‘**調(diào)用模塊：
‘**作    者： Mr.David
‘**日    期： 2006-09-19 19:49:17
‘**修 改 人：
‘**日    期：
‘**版    本： V1.0.0
‘*************************************************************************

Public Function GetWindowsPath() As String

    Dim ChrLen As Long, WinDir As String

    WinDir = Space$(Max_Path)
    ChrLen = GetWindowsDirectory(WinDir, Max_Path)

    WinDir = Left$(WinDir, ChrLen)
    GetWindowsPath = WinDir

End Function

‘*************************************************************************
‘**函 數(shù) 名： GetProgarmPath
‘**輸    入： frmHwnd(Long) -
‘**輸    出： (String) -
‘**功能描述： 獲取開始菜單程序組的路徑
‘**全局變量：
‘**調(diào)用模塊：
‘**作    者： Mr.David
‘**日    期： 2006-09-19 19:48:16
‘**修 改 人：
‘**日    期：
‘**版    本： V1.0.0
‘*************************************************************************

Public Function GetProgarmPath(frmHwnd As Long) As String

    Dim CSILD_NUM As Long, strBouff As String

    strBouff = String$(Max_Path, 0)

    SHGetSpecialFolderPath frmHwnd, strBouff, CSIDL_PROGRAMS, 0
    GetProgarmPath = Left$(strBouff, InStr(1, strBouff, Chr$(0)) - 1)

End Function 

方法3

先引用系統(tǒng)里面都有的WSHom.Ocx

Option Explicit

‘*************************************************************************
‘**函 數(shù) 名： SetAutoRun
‘**輸    入： ByVal Autorun(Boolean) -
‘**輸    出： 無
‘**功能描述： 隨WINDOWS自動(dòng)啟動(dòng)/取消啟動(dòng)模塊
‘**全局變量：
‘**調(diào)用方法： Call SetAutoRun(True/False)
‘**作    者： Mr.David
‘**日    期： 2006-09-05 09:07:25
‘**修 改 人：
‘**日    期：
‘**版    本： V1.0.0
‘*************************************************************************

Public Sub SetAutoRun(ByVal Autorun As Boolean)
   
    ‘WshShell 對象
    ‘ProgId Wscript.Shell
    ‘文件名 WSHom.Ocx
   
    Dim WshShell As WshShell
   
    Set WshShell = Create_Object("Wscript.Shell")
   
    If Autorun Then

        WshShell.RegWrite "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName, App.Path & "\" & App.EXEName & ".exe"

    Else

        WshShell.RegDelete "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName

    End If
   
    Set WshShell = Nothing
   
End Sub