AARON YOUNG! Drop Files in Explorer!

[kedaman]

It didn't work, i compiled and registered the activex dll and made that drophandler key in shellex key, and put the clsid put it didn't work!

[Aaron Young]

I just emailed you all my Project files and the files used to make it work, including my test registry entries.

- Aaron.

[kedaman]

Thanks! That worked but I have another Q, how do I drop only a specified filestype on the drop handler?
I have two formats: .mp3 and .kil and I want only .mp3 to be dropped on .kil and vice versa. I know I can avoid the other filetypes in my code after dropping but that's a bit unproffessional. I want the drophandler to react only when the specified filetype is dragged over the file.

[Aaron Young]

The best you can do is to prevent the Drop operation and indicate to the user that it's not a Valid file type, you can do this by changing the "DropEffect" to "NONE", i.e.

Private Function IDropTarget_DragEnter(ByVal pDataObj As shlext.IDataObject, ByVal grfKeyState As Long, ByVal ptX As Long, ByVal pyY As Long) As shlext.DROPEFFECTS
    Dim tFORMAT As FORMATETC
    Dim tMEDIUM As STGMEDIUM
    Dim nIndex As Long
    Dim nFileCount As Long
    Const sFileTypes = ";.mp3;.kil;"
    
    On Error Resume Next
    
    ' Erase the array
    Erase sFiles()
    
    ' Set the Format of the Data to Retrieve
    With tFORMAT
        .cfFormat = CF_HDROP
        .TYMED = TYMED_HGLOBAL
        .dwAspect = DVASPECT_CONTENT
    End With
    
    ' Get the Data
    pDataObj.GetData tFORMAT, tMEDIUM
    
    ' Get No. of Files
    nFileCount = DragQueryFile(tMEDIUM.Data, -1, vbNullString, 0) - 1
    ReDim Preserve sFiles(nFileCount)
    
    ' Get the File Names
    For nIndex = 0 To nFileCount
        sFiles(nIndex) = String$(260, 0)
        DragQueryFile tMEDIUM.Data, nIndex, sFiles(nIndex), Len(sFiles(nIndex))
        If InStr(sFiles(nIndex), vbNullChar) > 0 Then sFiles(nIndex) = Left$(sFiles(nIndex), InStr(sFiles(nIndex), vbNullChar) - 1)
        If InStr(sFileTypes, ";" & LCase(Right(sFiles(nIndex), 4)) & ";") = 0 Then Exit For
        If LCase(Right(sFiles(nIndex), 4)) = LCase(Right(sFilename, 4)) Then Exit For
    Next
    
    If nIndex > nFileCount Then
        IDropTarget_DragEnter = DROPEFFECT_COPY
    Else
        IDropTarget_DragEnter = DROPEFFECT_NONE
    End If
    
    ' Release memory used by the Medium Type
    ReleaseStgMedium tMEDIUM
        
End Function

But it would probably be a better idea to just validate the file when your associated applications starts-up and let the user know if it isn't valid. Otherwise the user would have to make sure any files they wanted to use with your application had the correct extension.

- Aaron.

[kedaman]

well i solved it out my way though, next time i'm going to have a look at what you're actually posting and not ask things blindly, thanks, you've been much help.

Public sFilename As String

'Must be Implemented by Drag/Drop Handlers
Implements IPersistFile
Implements IDropTarget

Private Sub IPersistFile_Load(ByVal pszFileName As Long, ByVal dwMode As Long)
    'Get the name of the File being Dropped on
    sFilename = String(lstrlenW(ByVal pszFileName), 0)
    MoveMemory ByVal StrPtr(sFilename), ByVal pszFileName, LenB(sFilename)
End Sub

Private Function IPersistFile_GetCurFile() As Long
    '
End Function

Private Sub IPersistFile_IsDirty()
    '
End Sub

Private Sub IPersistFile_Save(ByVal pszFileName As Long, ByVal fRemember As Long)
    '
End Sub

Private Sub IPersistFile_SaveCompleted(ByVal pszFileName As Long)
    '
End Sub

Private Function IDropTarget_DragEnter(ByVal pDataObj As shlext.IDataObject, ByVal grfKeyState As Long, ByVal ptX As Long, ByVal pyY As Long) As shlext.DROPEFFECTS
    Dim tFORMAT As FORMATETC
    Dim tMEDIUM As STGMEDIUM
    Dim nIndex As Long
    Dim nFileCount As Long

    On Error Resume Next
    
    ' Erase the array
    Erase sFiles()
    
    ' Set the Format of the Data to Retrieve
    With tFORMAT
        .cfFormat = CF_HDROP
        .TYMED = TYMED_HGLOBAL
        .dwAspect = DVASPECT_CONTENT
    End With
    
    ' Get the Data
    pDataObj.GetData tFORMAT, tMEDIUM
    
    ' Get No. of Files
    nFileCount = DragQueryFile(tMEDIUM.Data, -1, vbNullString, 0) - 1
    ReDim Preserve sFiles(nFileCount)
    
    ' Get the File Names
    For nIndex = 0 To nFileCount
        sFiles(nIndex) = String$(260, 0)
        DragQueryFile tMEDIUM.Data, nIndex, sFiles(nIndex), Len(sFiles(nIndex))
        If InStr(sFiles(nIndex), vbNullChar) > 0 Then sFiles(nIndex) = Left$(sFiles(nIndex), InStr(sFiles(nIndex), vbNullChar) - 1)
    Next
    If LCase(Right(sFilename, 4)) = ".mp3" Then If LCase(Right(sFiles(0), 4)) = ".kil" Then IDropTarget_DragEnter = DROPEFFECT_MOVE
    If LCase(Right(sFilename, 4)) = ".kil" Then If LCase(Right(sFiles(0), 4)) = ".mp3" Then IDropTarget_DragEnter = DROPEFFECT_MOVE
    
    ' Release memory used by the Medium Type
    ReleaseStgMedium tMEDIUM
        
End Function

Private Sub IDropTarget_DragLeave()
    Erase sFiles
End Sub

Private Function IDropTarget_DragOver(ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long) As shlext.DROPEFFECTS
    If LCase(Right(sFilename, 4)) = ".mp3" Then If LCase(Right(sFiles(0), 4)) = ".kil" Then IDropTarget_DragOver = DROPEFFECT_MOVE
    If LCase(Right(sFilename, 4)) = ".kil" Then If LCase(Right(sFiles(0), 4)) = ".mp3" Then IDropTarget_DragOver = DROPEFFECT_MOVE
End Function

Private Function IDropTarget_Drop(ByVal pDataObj As shlext.IDataObject, ByVal grfKeyState As Long, ByVal ptX As Long, ByVal ptY As Long) As shlext.DROPEFFECTS
    Dim nIndex As Long
    Dim sFileList As String
    
    'Do Whatever with the Dropped File(s)
    sFileList = RegVal("HKEY_CURRENT_USER\Software\Kedasus\KILEW\") & "\KILEW.EXE /D " & sFilename
    For nIndex = 0 To UBound(sFiles)
        sFileList = sFileList & " " & sFiles(nIndex)
    Next
    Shell sFileList
    
    IDropTarget_Drop = DROPEFFECT_MOVE
End Function