VB创建自定义文件后缀名并改变其默认图标及打开方式

1、VB创建自定义文件后缀名，并改变其默认图标及打开方式VB创建自定义文件后缀名，并改变其默认图标及打开方式2010-11-30 11：43网上下的一个程序，可以用它来打造自己的工程品牌！这里我把原代码贴出，希望对大家有所帮助！标准模块：General.bas Attribute VB_Name="General"Public Const REG_SZ=1 Global Const HKEY_CLASSES_ROOT=&H 80000000 Public Declare Function RegCreateKey Lib"advapi32.dll"A

2、lias"RegCreateKeyA"(ByVal hKey As Long,ByVal lpSubKey As String,phkResult As Long)As Long Declare Function RegQueryValueEx Lib"advapi32"Alias"RegQueryValueExA"(ByVal hKey As Long,ByVal lpszValueName As String,ByVal dwReserved As Long,lpdwType As Long,lpbData As Any,cbDa

3、ta As Long)As Long Declare Function RegOpenKey Lib"advapi32"Alias"RegOpenKeyA"(ByVal hKey As Long,ByVal lpszSubKey As String,phkResult As Long)As Long Declare Function RegSetValueEx Lib"advapi32.dll"Alias"RegSetValueExA"(ByVal hKey As Long,ByVal lpValueName As

4、 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 mu st pass it By Value.Declare Function RegCloseKey Lib"advapi32"(ByVal hKey As Long)As Long Public Declare Function GetSystemDirec

5、tory Lib"kernel32"Alias"GetSystemDirectoryA"(ByVal lpBuffer As String,ByVal nSize As Long)As Long Public Function RegSetStringValue(ByVal hKey As Long,ByVal strValueName As String,_ ByVal strData As String,Optional ByVal fLog)As Boolean Dim lResult As Long On Error GoTo 0lResult=

6、RegSetValueEx(hKey,strValueName,0&,REG_SZ,ByVal strData,_ LenB(StrConv(strData,vbFromUnicode)+1)If lResult=0 Then RegSetStringValue=True Else RegSetStringValue=False End If End Function Public Function StripTerminator(ByVal strString As String)As String Dim intZeroPos As Integer intZeroPos=InStr

7、(strString,Chr$(0)If intZeroPos 0Then StripTerminator=Left$(strString,intZeroPos-1)Else StripTerminator=strString End If End Function Public Function RegQueryStringValue(B yVal hKey As Long,ByVal strValueName As String,_ strData As String)As Boolean Dim lResult As Long Dim lValueType As Long Dim str

8、Buf As String Dim lDataBufSize As Long RegQueryStringValue=False On Error GoTo 0lResult=RegQueryValueEx(hKey,strValueName,0&,lValueType,ByVal 0&,_ lDataBufSize)If lResult=ERROR_SUCCESS Then If lValueType=REG_SZ Then strBuf=String(lDataBufSize,"")lResult=RegQueryValueEx(hKey,strValu

9、eName,0&,0&,ByVal strBuf,_ lDataBufSize)If lResult=ERROR_SUCCESS Then RegQueryStringValue=True strData=StripTerminator(strBuf)End If End If End If End Function窗体模块：FrmMain.frm VERSION 5.00 Begin VB.Form FrmMain Caption="Form1"ClientHeight=3195 Clien tLeft=60 ClientTop=345 ClientWid

10、th=4680 LinkTopic="Form1"ScaleHeight=3195 ScaleWidth=4680 StartUpPosition=3'窗口缺省Begin VB.CommandButton Command1 Caption="Command1"Height=375 Left=1800 TabIndex=0 Top=2400 Width=1215 End Begin VB.Label Label1 Caption="启动时，在注册表里产生名为mjf的后缀类型。点击command1按钮，如果成功，其打开方式将变为使用note

11、pad.exe打开，图标也发生改变。"Height=810 Left=855 TabIndex=1 Top=435 Width=2940 End End Attribute VB_Name="FrmMain"Attribute VB_GlobalNameSpace=False Attribute VB_Creatable=False Attribute VB_PredeclaredId=True Attribute VB_Exposed=False Dim mSysPath As String Private Sub Command1_Click()Dim hKe

12、y As Long Dim MyReturn As Long Dim MyData As String MyReturn=RegOpenKey(HKEY_CLASSES_ROOT,".mjf",hKey)MyReturn=RegQueryStringValue(hKey,"",MyData)MyReturn=RegOpenKey(HKEY_CLASSES_ROOT,MyData+"shellopencommand",hKey)MyReturn=RegSetStringValue(hKey,"",mSysPath&a

13、mp;"notepad.exe%1",False)If MyReturn Then MsgBox"改变文件打开方式成功！",vbInformation,"请注意"Else MsgBox"改变文件打开方式失败！",vbExclamation,"请注意"End If MyReturn=RegOpenKey(HKEY_CLASSES_ROOT,MyData+"DefaultIcon",hKey)MyReturn=RegSetStringValue(hKey,""

14、,mSysPath&"shell32.dll,-151",False)If MyReturn Then MsgBox"改变图标成功",vbInformation,"提示"Else MsgBox"改变图标失败",vbExclamation,"提示"End If RegCloseKey(hKey)End Sub Private Sub Form_Load()Dim Length As Integer mSysPath=Space$(125)Call GetSystemDirectory(mS

15、ysPath,125)mSysPath=StripTerminator(mSysPath)Dim KeyId As Long Call RegCreateKey(HKEY_CLASSES_ROOT,".mjf",KeyId)Call RegSetValueEx(KeyId,"",0&,REG_SZ,ByVal"mjffile",Len("mjffile")+1)Dim KeyId1 As Long Call RegCreateKey(HKEY_CLASSES_ROOT,"mjffile"

16、,KeyId1)Call RegSetValueEx(KeyId1,"",0&,REG_SZ,ByVal"自定义类型",LenB("自定义类型")+1)Dim KeyId2 As Long Call RegCreateKey(KeyId1,"DefaultIcon",KeyId2)Call RegSetValueEx(KeyId2,"",0&,REG_SZ,ByVal mSysPath&"shell32.dll-5",Len(mSysPath&"shell32.dll-5")+1)Dim KeyId3 As Long Call RegCreateKey(KeyId1,"Shell",KeyId3)Dim KeyId4 As Long Call RegCreateKey(KeyId3,"Open",KeyId4)Dim KeyId5 As Long Cal