From: erewhon@nowhere.uk
On Sat, 25 Feb 2006 20:57:16 +1000, "D & J G"
wrote:
>Is there a way to instruct Windows file-handling - 'Opens with:' - from
>within VB6? I want to ensure that files with the .rtf (rich text) extension
>always go to Word Pad, no matter which future computer uses my program.
Yes
You set up the file association for RTF in the registry
Here is some code, you would be wise to check the API error results,
as it is likely that 'permissions' will not be set up on some
machines.
Form code, followed by Class code
Option Explicit
Private Sub Command1_Click()
Dim C As New cFleAssn
Dim Ext$
Dim Handler$
Dim FileType$, ContentType$, ExeName$
Me.AutoRedraw = True
Me.Cls
Ext$ = "jpg"
Call C.GetExtAssociations(Ext$, _
Handler$, _
FileType$, _
ContentType$, _
ExeName$)
Me.Print Ext$
Me.Print Handler$
Me.Print FileType$
Me.Print ContentType$
Me.Print ExeName$
' ' --- Register
' Ext$ = "FRED"
' Handler$ = "fred:" + Handler$
' Call C.RegisterExt(Ext$, _
' Handler$, _
' FileType$, _
' ContentType$, _
' ExeName$)
'
' ' --- Check
' Call C.GetExtAssociations(Ext$, _
' Handler$, _
' FileType$, _
' ContentType$, _
' ExeName$)
' Me.Print ""
' Me.Print Ext$
' Me.Print Handler$
' Me.Print FileType$
' Me.Print ContentType$
' Me.Print ExeName$
'
' ' Unregister
' Call C.UnRegisterExt(Ext$)
End Sub
======== Start of cFileAssn.cls ========
Option Explicit: DefObj A-Z
'
' HANDLER .Zip : WinZip
' CONTENT TYPE "Content Type" : Application-Zip-Compressed
' FILE TYPE WinZip : WinZip File
' OPEN COMMAND WinZip + "\shell\open\command" : "C:\xxx\WinZip" "%1"
'
' V.Handler = "BinMgr"
' V.FileType = "BIN Download File"
' V.OpenCmd = " + AppPath(App.EXEName) + ".exe" + " %1"
' V.ContentType = "application/download document"
Private Const CONTENT_TYPE$ = "Content Type"
Private Const SHELL_OPEN_COMMAND$ = "\shell\open\command"
Const REG_SZ = 1 ' Unicode nul terminated string
Const REG_BINARY = 3 ' Free form binary
Const HKEY_CURRENT_USER = &H80000001
Const HKEY_CLASSES_ROOT = &H80000000
Private Declare Function RegOpenKey _
Lib "advapi32.dll" _
Alias "RegOpenKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String, _
phkResult As Long) As Long
Private Declare Function RegCloseKey _
Lib "advapi32.dll" _
(ByVal hKey As Long) As Long
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 RegDeleteValue _
Lib "advapi32.dll" _
Alias "RegDeleteValueA" _
(ByVal hKey As Long, _
ByVal lpValueName As String) As Long
Private Declare Function RegDeleteKey _
Lib "advapi32.dll" _
Alias "RegDeleteKeyA" _
(ByVal hKey As Long, _
ByVal lpSubKey As String) As Long
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
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
Private Type TPACKET
Ext As String
Handler As String
FileType As String
ContentType As String
OpenCommand As String
End Type
' #############################################################
'
' AllAPI - utils
'
Private Function RegQueryStringValue(ByVal hKey As Long, _
ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String,
lDataBufSize As Long
'retrieve information about the key
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal
0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
'Create a buffer
strBuf = String(lDataBufSize, Chr$(0))
'retrieve the key's content
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal
strBuf, lDataBufSize)
If lResult = 0 Then
'Remove the unnecessary chr$(0)'s
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf,
Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
'retrieve the key's value
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData,
lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
Private Function LF_GetString$(hKey As Long, strPath As String, _
strValue As String)
Dim Ret&
'Open the key
RegOpenKey hKey, strPath, Ret
'Get the key's content
LF_GetString = RegQueryStringValue(Ret, strValue)
'Close the key
RegCloseKey Ret
End Function
Private Sub LS_SaveString(hKey As Long, _
strPath As String, _
strValue As String, _
strData As String)
Dim Ret&
'Create a new key
RegCreateKey hKey, strPath, Ret
'Save a string to the key
RegSetValueEx Ret, strValue, 0, REG_SZ, _
ByVal strData, Len(strData)
'close the key
RegCloseKey Ret
End Sub
Private Sub LS_DelSetting(hKey As Long, strPath As String, strValue As
String)
Dim Ret&
'Create a new key
RegCreateKey hKey, strPath, Ret
'Delete the key's value
RegDeleteValue Ret, strValue
'close the key
RegCloseKey Ret
End Sub
' #############################################################
'
'
'
'
'
' #############################################################
' #############################################################
'
' Lower Case - starting with '.'
'
[continued in next message]
--- SoupGate-Win32 v1.05
* Origin: you cannot sedate... all the things you hate (1:229/2)
|
