2017-2-28
14:21

root
root

[程序代码]VB如何重建图标缓存(转载)

VB如何重建图标缓存

缓存, 图标, 重建缓存, 图标, 重建

本人是新手菜鸟,最近写了自娱自乐的对位加密工具,加密后文件为.alo格式。

在网上找了很多资料后,知道关联格式的代码如下:

'这句话是写在模块中,当然也可以写在窗体通用里,但是前面就要加Private了。发这个是希望更多人免除寻找的痛苦

Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long

'下面这个可以写到某个事件中。

    Dim w As Object

    Set w = CreateObject("wscript.shell")

    On Error GoTo FailedGuanLian

    w.RegWrite "HKEY_CLASSES_ROOT\.alo\" & "", "MyCode", "REG_SZ"

    w.RegWrite "HKEY_CLASSES_ROOT\MyCode\DefaultIcon\" & "", App.Path & "\MyPic.ico", "REG_SZ"

    w.RegWrite "HKEY_CLASSES_ROOT\MyCode\shell\open\command\" & "", What, "REG_SZ"

'上面的写入注册表操作,第一行是在HKEY_CLASSES_ROOT主键下新键一个项.alo,然后在默认的数据写入一个值,可以随便写,但是后面紧跟

'的第二个项名字必须和第一个项的值一样

'第二行在主键HKEY_CLASSES_ROOT新建一个项,名字是第一个项的值,然后再在此项下新建一个项DefaultIcon,给里面的默认键写入图标地址

'第三行是在MyCode项下新建shell项,再在shell项下新建open项,再在open项下新建command项,然后在默认键写入需要打开此类格式的程序

总体就是如上,但是我现在需要的是像千千和暴风那样,安装后立刻就关联上图标了,不必注销或者重新启动。

请问下具体函数是什么??能有例子最好!

 

 

 

 

在窗体中:

Option Explicit

Private Sub cmdReBuildIconCache_Click()

    Call UpgradeDesktop(&H1E)   '先修改图标大小为31
    Call UpgradeDesktop(&H20)   '然后还原图标大小为32,默认值

End Sub

在模块中:

Option Explicit

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         ' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const HKEY_CURRENT_USER = &H80000001
Private Const WM_SETTINGCHANGE = &H1A
Private Const HWND_BROADCAST = &HFFFF

'它的原理是这样的,只要程序改变了系统预设图标缓存的大小,然后在广播WM_SETTINGCHANGE消息,系统就会重建系统图标缓存,我们也就达到了更改后立即看到改变后的结果的目的
Public Sub UpgradeDesktop(IcoSize As String)  '更新图标

    Dim hKey As Long

    RegCreateKey HKEY_CURRENT_USER, "Control Panel\Desktop\WindowMetrics", hKey

    RegSetValueEx hKey, "Shell Icon Size", 0, 1, ByVal IcoSize, 2

    'HWND_BROADCAST它代表向所有的窗口发送消息,WM_SETTINGCHANGE消息是告诉应用程序去注册表中更新其相关的信息
    Call SendMessage(HWND_BROADCAST, WM_SETTINGCHANGE, 0, 0)

End Sub

 

 

 

 

 

 

 

'**************************************************************************
'**模 块 名:恢复.txt文件的默认关联
'**说    明:魔灵圣域 版权所有2008 - 2009(C)
'**创 建 人:郭卫(魔灵)
'**日    期:2008-04-06 23:31:56
'**修 改 人:郭卫
'**日    期:
'**描    述:郭卫制作
'**版    本:V1.0.0    http://icecept.blog.sohu.com
'*************************************************************************
Option Explicit
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Const HKEY_LOCAL_MACHINE = &H80000002
Public Const REG_SZ = 1
'-注册表 API 声明...
'---------------------------------------------------------------
Public Declare Function RegCloseKey Lib "advapi32" (ByVal hKey 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 RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib "advapi32" Alias "RegSetValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal Reserved As Long, ByVal dwType As Long, ByVal lpData As String, ByVal cbData As Long) As Long
'RegQueryValueEx --读取某Key的特定名称的值(Value)
'Vb声明和参数解释:
'hkey: Key Handle
'lpValueName: Value Name
'lpReserved:保留参数,调用时设置为0即可
'lpType: 返回读取的数据类型
'lpData: 返回读取的数据,如果是REG_SZ类型,前面就必须加ByVal,否则程序崩溃,其它类型不能加ByVal
'lpcbData:传入lpData数据的长度,若成功读取数据,则返回所读取的数据的长度。
'返回值: =0,表示成功;≠0,表示失败。
'说明:
'1、 这一函数除了可读取指定名称的值之外,也可以读取default value。如果要读取default value,只
'需要将参数lpValueName设置为""[空字符串]即可。
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, lpData As Any, lpcbData As Long) As Long
'关闭explorer进程所用到的api
Public Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Public Const WM_QUIT = &H12
Public Sub LinkTxt(ExePathName As String, ExeIco As String)
    On Error Resume Next
    '建立文件类型
    Dim hKey As Long, ret As Long
    '定义 .txt文件
    ret = RegCreateKey(HKEY_CLASSES_ROOT, ".txt", hKey)
    '定义文件的类型,注意最后一个数字,它是 "txtfile"的字节数 + 1
    ret = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "txtfile", LenB(StrConv("txtfile", vbFromUnicode)) + 1)
    '定义"txtfile"
    ret = RegCreateKey(HKEY_CLASSES_ROOT, "txtfile", hKey)
    '定义文件类型文本说明
    ret = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal "文本文档", LenB(StrConv("文本文档", vbFromUnicode)) + 1)
    '注: RegSetValueEx第二项为空时把值填入第一行的默认项,此时,与RegSetValue功能相同
    '定义它的操作
    ret = RegCreateKey(HKEY_CLASSES_ROOT, "txtfile\shell", hKey)
    '具体定义操作的名称
    ret = RegCreateKey(HKEY_CLASSES_ROOT, "txtfile\shell\open", hKey)
    '定义操作的动作
    ret = RegCreateKey(HKEY_CLASSES_ROOT, "txtfile\shell\open\command", hKey)
    '以下是最关键的一步!将 "txtfile" 的打开(open)操作和我们的程序关联起来
    ret = RegSetValueEx(hKey, vbNullString, 0, REG_SZ, ByVal ExePathName, LenB(StrConv(ExePathName, vbFromUnicode)) + 1)
    '改变图标
    ret = RegCreateKey(HKEY_CLASSES_ROOT, "txtfile\DefaultIcon", hKey)
    ret = RegSetValueEx(hKey, vbNullString, 0&, REG_SZ, ByVal ExeIco, LenB(StrConv(ExeIco, vbFromUnicode)) + 1)
    '如果文件里包含两个图标,第一个图标的序号为0,第二个图标的序号为1
    'E:\VB文件夹\图标库\图标ico\记事薄.ico可以换为%SystemRoot%\System32\shell32.dll,-160,其中-160便是shell32.dll中的图标标识.
    '关闭注册表项
    RegCloseKey hKey
    RebootExplorer
End Sub
'重启Explorer.exe
Public Sub RebootExplorer()
    Dim hwndShell As Long, i As Long
    hwndShell = FindWindow("Progman", vbNullString)
    i = PostMessage(hwndShell, WM_QUIT, 0, 0)
    If i = 0 Then Exit Sub
    Do While True '等待原先的Shell结束
        hwndShell = FindWindow("Progman", vbNullString)
        If hwndShell = 0 Then
            Exit Do
        End If
        DoEvents
    Loop
    Shell "Explorer.exe", vbNormalFocus '执行新的Shell
End Sub
Sub Main()
    '建立文件类型
    Dim hKey As Long, ret As Long
    Dim Name As String * 255  '注册表项的默认值
    Dim intname1 As Integer   '文件名所在的位置
    If IsSubKeyName(HKEY_CLASSES_ROOT, "txtfile\shell\open\command", hKey) Then
        '返回command项默认值
        RegQueryValueEx hKey, vbNullString, 0&, REG_SZ, ByVal Name, Len(Name)
        intname1 = InStr(Name, App.EXEName & ".exe %1")
        If intname1 = 0 Then
            LinkTxt "C:\WINDOWS\NOTEPAD" & ".EXE %1", "%SystemRoot%\System32\shell32.dll,-152"
        End If
        '关闭键值
        RegCloseKey hKey
    End If
End Sub
'判断注册项是否存在
Public Function IsSubKeyName(RootKey As Long, SubKeyName As String, Optional hKey As Long) As Boolean
    If RegOpenKey(RootKey, SubKeyName, hKey) = 0& Then
        IsSubKeyName = True
    Else
        IsSubKeyName = False
    End If
End Function

文章如需转载请注明:转载自: 紫灵幽梦
« 上一篇 下一篇 »

相关文章:

vb读取access并且显示  (2017-5-11 9:18:27)

VB 获取CPU温度示例  (2017-5-8 10:35:11)

VB程序逆向反汇编常见的函数   (2017-5-8 10:32:0)

VB内嵌汇编的模块示例  (2017-5-8 10:24:4)

内存数据的读写(PC)   (2017-3-1 17:51:40)

用VB制作外挂   (2017-3-1 16:16:53)

发表留言: