|
-
Jul 4th, 2000, 09:39 AM
#1
Trying to create a file association in VB. Everything I'm doing works fine with one slight problem. It doesn't work until I actually go into folder options and edit the open action. I Do not not actually edit anything though, just going in seems to set it to begin working. Does anyone know why I have to do this. I don't want users to have to do this for my program. Re-booting doesn't set the file association either.
-
Jul 4th, 2000, 11:19 AM
#2
_______
< ? >
'bas module code
Option Explicit
Public Type mnuCommands
Captions As New Collection
Commands As New Collection
End Type
Public Type filetype
Commands As mnuCommands
Extension As String
ProperName As String
FullName As String
ContentType As String
IconPath As String
IconIndex As Integer
End Type
Public Const REG_SZ = 1
Public Const HKEY_CLASSES_ROOT = &H80000000
Public Declare Function RegCloseKey Lib _
"advapi32.dll" (ByVal hKey As Long) As Long
Public Declare Function RegCreateKey Lib _
"advapi32" Alias "RegCreateKeyA" (ByVal _
hKey As Long, ByVal lpszSubKey As String, _
phkResult As Long) As Long
Public Declare Function RegSetValueEx Lib _
"advapi32" Alias "RegSetValueExA" (ByVal _
hKey As Long, ByVal lpszValueName As String, _
ByVal dwReserved As Long, ByVal fdwType As _
Long, lpbData As Any, ByVal cbData As Long) As Long
Public Sub CreateExtension(newfiletype As filetype)
Dim IconString As String
Dim Result As Long, Result2 As Long, ResultX As Long
Dim ReturnValue As Long, HKeyX As Long
Dim cmdloop As Integer
IconString = newfiletype.IconPath & "," & _
newfiletype.IconIndex
If Left$(newfiletype.Extension, 1) <> "." Then _
newfiletype.Extension = "." & newfiletype.Extension
RegCreateKey HKEY_CLASSES_ROOT, _
newfiletype.Extension, Result
ReturnValue = RegSetValueEx(Result, "", 0, REG_SZ, _
ByVal newfiletype.ProperName, _
LenB(StrConv(newfiletype.ProperName, vbFromUnicode)))
' Set up content type
If newfiletype.ContentType <> "" Then
ReturnValue = RegSetValueEx(Result, _
"Content Type", 0, REG_SZ, ByVal _
CStr(newfiletype.ContentType), _
LenB(StrConv(newfiletype.ContentType, vbFromUnicode)))
End If
RegCreateKey HKEY_CLASSES_ROOT, _
newfiletype.ProperName, Result
If Not IconString = ",0" Then
RegCreateKey Result, "DefaultIcon", _
Result2 'Create The Key of "ProperName\DefaultIcon"
ReturnValue = RegSetValueEx(Result2, _
"", 0, REG_SZ, ByVal IconString, _
LenB(StrConv(IconString, vbFromUnicode)))
'Set The Default Value for the Key
End If
ReturnValue = RegSetValueEx(Result, _
"", 0, REG_SZ, ByVal newfiletype.FullName, _
LenB(StrConv(newfiletype.FullName, vbFromUnicode)))
RegCreateKey Result, ByVal "Shell", ResultX
' Create neccessary subkeys for each command
For cmdloop = 1 To newfiletype.Commands.Captions.Count
RegCreateKey ResultX, ByVal _
newfiletype.Commands.Captions(cmdloop), Result
RegCreateKey Result, ByVal "Command", Result2
Dim CurrentCommand$
CurrentCommand = newfiletype.Commands.Commands(cmdloop)
ReturnValue = RegSetValueEx(Result2, _
"", 0, REG_SZ, ByVal CurrentCommand$, _
LenB(StrConv(CurrentCommand$, vbFromUnicode)))
RegCloseKey Result
RegCloseKey Result2
Next
RegCloseKey Result2
End Sub
"A myth is not the succession of individual images,
but an integerated meaningful entity,
reflecting a distinct aspect of the real world."
___ Adolf Jensen
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules
|
Click Here to Expand Forum to Full Width
|