faux file extention

[jmpatrick]

I'm using ShellExecute API to run an outside application(Acrobat Reader). Is there a way to put a faux file extention on my (.pdf) files to have my outside application (Acrobat Reader) to execute.

I have several reasons to do this, one of which is that if someone has Acrobat Exchange loaded, the (.pdf) files will open in that app. -You get the picture- I want to change my (.pdf)s to another extention name and have them be mapped to my outside app (Reader).

Any suggestions??

[Jop]

You mean like changing the file extension?
Or making your own extension and if a person dubble-clicks that your app fires up with the clicked file?

[jmpatrick]

Yea, I would like to have my (.pdf) files saved as, say, (.jop) files. While you go through the VB program, the (.jop) files are opened by Adobe Acrobat Reader.

-jp

[Jop]

So your program is a sort of filter for files?
Like opening the file, do things you want, then redirect it to Acrobat Reader?

Here's how to make a file association with Icon:

'[begin of code]
'Author: Unknown
'Origin: About.com
'Purpose: Create a file association
'Version: VB5+
'// You may use this code all you want on the condition you keep this simple comment
'// Anyone who improves the code please let me know.
'// Date     : 21/1/2000
'// Author   : Damien McGivern
'// E-Mail   : [email protected]
'// Web Site : http://www.dingo-delights.co.uk
'// Purpose  : To create file associations with default icons

'// Improved 23/1/200 - New parameters 'Switch', 'PromptOnError', better error handling

'// Parameters
'// Required    Extension       (Str) ie ".exe"
'// Required    FileType        (Str) ie "VB.Form"
'// Required    FileTYpeName    (Str) ie. "Visual Basic Form"
'// Required    Action          (Str) ie. "Open" or "Edit"
'// Required    AppPath         (Str) ie. "C:\Myapp"
'// Optional    Switch          (Str) ie. "/u"                  Default = ""
'// Optional    SetIcon         (Bol)                           Default = False
'// Optional    DefaultIcon     (Str) ie. "C:\Myapp,0"
'// Optional    PromptOnError   (Bol)                           Default = False

'// HOW IT WORKS
'// Extension(Str)   Default = FileType(Str)

'// FileType(Str)    Default = FileTypeName(Str)
'// "DefaultIcon"     Default = DefaultIcon(Str)
'// "shell"
'// Action(Str)
'// "command"   Default = AppPath(Str) & switch(Str) & " %1"

Option Explicit

Private Const REG_SZ As Long = 1

Private Const HKEY_CLASSES_ROOT = &H80000000
Private Const ERROR_SUCCESS = 0
Private Const KEY_ALL_ACCESS = &H3F
Private Const REG_OPTION_NON_VOLATILE = 0
Private PromptOnErr As Boolean

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

Private Declare Function RegCreateKeyEx Lib "advapi32.dll" _
                                    Alias "RegCreateKeyExA" _ 
                                    (ByVal hKey As Long, _ 
                                    ByVal lpSubKey As String, _
                                    ByVal Reserved As Long, _ 
                                    ByVal lpClass As String, _ 
                                    ByVal dwOptions As Long, _ 
                                    ByVal samDesired As Long, _ 
                                    ByVal lpSecurityAttributes As Long, _ 
                                    phkResult As Long, _ 
                                    lpdwDisposition As Long) As Long

Private Declare Function RegOpenKeyEx Lib "advapi32.dll" _
                                    Alias "RegOpenKeyExA" _
                                    (ByVal hKey As Long, _ 
                                    ByVal lpSubKey As String, _ 
                                    ByVal ulOptions As Long, _ 
                                    ByVal samDesired As Long, _ 
                                    phkResult As Long) As Long

Private Declare Function RegSetValueExString Lib "advapi32.dll" _
                                    Alias "RegSetValueExA" _ 
                                    (ByVal hKey As Long, _ 
                                    ByVal lpValueName As String, _ 
                                    ByVal Reserved As Long, _ 
                                    ByVal dwType As Long, _ 
                                    ByVal lpValue As String, _ 
                                    ByVal cbData As Long) As Long


Public Function CreateFileAss(Extension As String, _ 
                              FileType As String, _
                              FileTypeName As String, _ 
                              Action As String, _ 
                              AppPath As String, _ 
                              Optional Switch As String = "", _
                              Optional SetIcon As Boolean = False, _ 
                              Optional DefaultIcon As String, _ 
                              Optional PromptOnError As Boolean = False) _ 
                              As Boolean

    On Error GoTo ErrorHandler:

    PromptOnErr = PromptOnError

    '// Check that AppPath exists.
    If Dir(AppPath, vbNormal) = "" Then
        If PromptOnError Then MsgBox "The application path '" & _ 
            AppPath & "' cannot be found.", _ 
            vbCritical + vbOKOnly, "DLL/OCX Register"

        CreateFileAss = False
        Exit Function
    End If

    Dim ERROR_CHARS As String: ERROR_CHARS = "\/:*?<>|" & Chr(34)
    Dim i As Integer

    If Asc(Extension) <> 46 Then Extension = "." & Extension    
    '// Check extension has "." at front

    '// Check for invalid chars within extension
    For i = 1 To Len(Extension)
        If InStr(1, ERROR_CHARS, Mid(Extension, i, 1), vbTextCompare) Then
            If PromptOnError Then MsgBox "The file extension '" _ 
                  & Extension & "' contains an illegal char (\/:*?<>|" _ 
                  & Chr(34) & ").", vbCritical + vbOKOnly, "DLL/OCX Register"

            CreateFileAss = False
            Exit Function
        End If
    Next

    If Switch <> "" Then Switch = " " & Trim(Switch
   Action = FileType & "\shell\" & Action & "\command"

    Call CreateSubKey(HKEY_CLASSES_ROOT, Extension)        '// Create .xxx key
    Call CreateSubKey(HKEY_CLASSES_ROOT, Action)           '// Create action key

    If SetIcon Then
        Call CreateSubKey(HKEY_CLASSES_ROOT, (FileType _
            & "\DefaultIcon"))    '// Create default icon key

        If DefaultIcon = "" Then
            '// This line of code sets the application's own icon as the _
             default file icon

            Call SetKeyDefault(HKEY_CLASSES_ROOT, _ 
               FileType & "\DefaultIcon", Trim(AppPath & ",0"))

        Else
            Call SetKeyDefault(HKEY_CLASSES_ROOT, FileType _ 
                 & "\DefaultIcon", Trim(DefaultIcon))

        End If
    End I
   Call SetKeyDefault(HKEY_CLASSES_ROOT, Extension, _
                FileType)                  '// Set .xxx key default

    Call SetKeyDefault(HKEY_CLASSES_ROOT, FileType, _
                FileTypeName)               '// Set file type default

    Call SetKeyDefault(HKEY_CLASSES_ROOT, Action, _ 
                AppPath & Switch & " %1")     '// Set Command line

    CreateFileAss = True
    Exit Function

ErrorHandler:

    If PromptOnError Then MsgBox "An error occured while _ 
          attempting to create the file extension '" _ 
          & Extension & "'.", vbCritical + vbOKOnly, "DLL/OCX Register"

    CreateFileAss = False

End Function

Private Function CreateSubKey(RootKey As Long, NewKey As String) As Boolean
    '// This function creates a new sub key
    Dim hKey As Long, regReply As Long
    regReply = RegCreateKeyEx(RootKey, NewKey, _ 
         0&, "", REG_OPTION_NON_VOLATILE, KEY_ALL_ACCESS, 0&, hKey, 0&)

    If regReply <> ERROR_SUCCESS Then
        If PromptOnErr Then MsgBox "An error occured _ 
         while attempting to to create a registery key.", vbCritical + _
         vbOKOnly, "DLL/OCX Register"

        CreateSubKey = False
    Else
        CreateSubKey = True
    End If

    Call RegCloseKey(hKey)
End Function


Private Function SetKeyDefault(RootKey As Long, Address As String, Value As String) As Boolean
    '// This function sets the default vaule of the key which is always a string
    Dim regReply As Long, hKey As Long
    regReply = RegOpenKeyEx(RootKey, Address, 0, KEY_ALL_ACCESS, hKey)

    If regReply <> ERROR_SUCCESS Then
        If PromptOnErr Then MsgBox "An error occured while attempting _ 
          to access the registery.", vbCritical + vbOKOnly, "DLL/OCX Register"
        SetKeyDefault = False
        Exit Function
    End If

    Value = Value & Chr(0)

    regReply = RegSetValueExString(hKey, "", 0&, REG_SZ, Value, Len(Value))

    If regReply <> ERROR_SUCCESS Then
        If PromptOnErr Then MsgBox "An error occured while _ 
           attempting to set key default value.", vbCritical + _
           vbOKOnly, "DLL/OCX Register"

        SetKeyDefault = False
    Else
        SetKeyDefault = True
    End If

    Call RegCloseKey(hKey)
End Function


'[end of code]

for getting the file in your prog:

Private Sub Form_Load()
msgBox Command()
End Sub

[jmpatrick]

Thanks Jop, I'll try it!

[jmpatrick]

I'm still not getting this to work, and getting frustrated. Perhaps it's because I'm such a novice that I'm doing something stupid. Can anyone take me through this step-by-step??

jp