Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Drag and Drop explorer files/links onto a Window

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • Drag and Drop explorer files/links onto a Window

    Code:
    '________________________________________________________________________________________
    '
    '  Drag/Drop functions
    '  -------------------
    '
    '  Simple demonstration of how to accept "dragged" files on your window of choice.
    '  NEW: Now also allows for right-click "pasting" of files.
    '
    '  By Kevin G. Peel, KGP Software. 2003. Posted: July 2006.
    '  http://www.kgpsoftware.com. 
    '________________________________________________________________________________________
     
    #Compile Exe
    #Dim All
    #Register All
     
    $APPTITLE = "DragDrop Example"
     
    %USEMACROS = 1
    #Include "win32api.inc"
     
    Declare Function Sub1(p1 As Any) As Dword
    Declare Function Sub2(p1 As Any, p2 As Any) As Dword
    Declare Function Sub3(p1 As Any, p2 As Any, p3 As Any) As Dword
    Declare Function Sub5(p1 As Any, p2 As Any, p3 As Any, p4 As Any, p5 As Any) As Dword
     
    '------------------------------------------------------------------------------
    ' Returns details from a link (LNK) file, based on iType.
    ' 1 = link file name, 2 = link path name, 3 = link parameters
    '
    ' Note: parts of the following function were found on PB forum,
    '       so credit goes to the original authors.
    '------------------------------------------------------------------------------
    Function GetLinkInfo(ByVal sLinkPath As String, ByVal nType As Long) As String
     
      Local CLSCTX_INPROC_SERVER As Dword, CLSID_ShellLink As GUIDAPI
      Local FileData As WIN32_FIND_DATA, Flags As Dword
      Local IID_IShellLink As GUIDAPI, IID_Persist As String * 16
      Local lResult As Dword, outvalue As Asciiz * %MAX_PATH, nRet As Long
      Local pp As Dword Ptr, ppf As Dword Ptr, psl As Dword Ptr
      Local TmpAsciiz As Asciiz * %MAX_PATH, TmpWide As Asciiz * (%MAX_PATH*2)
     
      Poke$ VarPtr(CLSID_ShellLink), Mkl$(&H00021401) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
      Poke$ VarPtr(IID_IShellLink), Mkl$(&H000214EE) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
     
      IID_Persist     = Mkl$(&H0000010B) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
      CLSCTX_INPROC_SERVER = 1
     
      nRet = CoCreateInstance(CLSID_ShellLink, ByVal %NULL, CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
      If (nRet = %S_OK) Then
         pp = @psl
         Call Dword @pp Using Sub3(ByVal psl, IID_Persist, ppf) To lResult
         TmpAsciiz = sLinkPath
         MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, -1, ByVal VarPtr(TmpWide), %MAX_PATH
         pp = @ppf + 20
         Call Dword @pp Using Sub3(ByVal ppf, TmpWide, ByVal %True)
         Select Case nType
                Case 2
                     pp = @psl + 32
                     Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
                Case 3
                     pp = @psl + 40
                     Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
                Case Else
                     pp = @psl + 12
                     Call Dword @pp Using Sub5(ByVal psl, outvalue, ByVal %MAX_PATH, FileData, Flags)
         End Select
         ' Release the persistant file
         pp = @ppf + 8
         Call Dword @pp Using Sub1(ByVal ppf)
         ' Unbind the shell link object from the persistent file
         pp = @psl + 8
         Call Dword @pp Using Sub1(ByVal psl)
         Function = outValue
      End If
     
    End Function  
    
     
    '------------------------------------------------------------------------------
    ' Return a list of drag/drop filenames, separated by | (See WM_DROPFILES message)
    ' Note: this function also finishes the specified drag/drop operation.
    '------------------------------------------------------------------------------
    Function GetDropFiles(ByVal hDropParam As Dword) As String
      Local sDropFiles As String, sText As String, i As Long
      For i = 0 To DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
          sText = Space$(DragQueryFile(hDropParam, i, "", 0)+1)
          DragQueryFile hDropParam, i, ByVal StrPtr(sText), Len(sText)
          sText = Left$(sText, Len(sText)-1)
          If UCase$(Right$(sText, 4)) = ".LNK" Then sText = GetLinkInfo(sText, 1)
          sDropFiles = sDropFiles + sText + "|"
      Next i
      DragFinish hDropParam
      Function = RTrim$(sDropFiles, "|")
    End Function
     
    
    '------------------------------------------------------------------------------
    ' Callback prcoedure for main dialog.
    '------------------------------------------------------------------------------
    CallBack Function dlgDropExample
     
      Local sFiles As String, pDrop As Dword
     
      Select Case CbMsg
     
             Case %WM_DROPFILES
                  ' Test for files "dragged" onto window...
                  pDrop = CbWParam
                  sFiles = GetDropFiles(pDrop)
                  If Len(sFiles) Then
                     ' Display list of files "dropped"...
                     Replace "|" With $CrLf In sFiles
                     MessageBox CbHndl, "Files dropped onto the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_ICONINFORMATION
                  End If
                  
             Case %WM_RBUTTONUP
                  ' Test for files on clipboard (paste-like operation)...
                  OpenClipBoard 0
                  pDrop = GetClipboardData(%CF_HDROP)
                  sFiles = GetDropFiles(pDrop)
                  CloseClipboard
                  If Len(sFiles) Then
                     ' Display list of files "dropped"...
                     Replace "|" With $CrLf In sFiles
                     MessageBox CbHndl, "Files pasted into the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_ICONINFORMATION
                  End If
                  
      End Select
     
    End Function
     
    
    '------------------------------------------------------------------------------
    ' Program Start Point
    '------------------------------------------------------------------------------
    Function PBMain
     
      Local hDlg As Dword
     
      Dialog New %HWND_DESKTOP, $APPTITLE, , , 250, 150, %WS_OVERLAPPEDWINDOW To hDlg
      Control Add Label, hDlg, 100, "Drag a file onto this dialog from explorer or right click with some copied files to display them...", 10, 10, 150, 35
      DragAcceptFiles hDlg, %TRUE
      Dialog Show Modal hDlg Call dlgDropExample
     
    End Function
    ------------------
    contact page
    kgpsoftware.com - Home of the Slam Database Manager..

    [This message has been edited by Kev Peel (edited July 27, 2006).]
    kgpsoftware.com | Slam DBMS | PrpT Control | Other Downloads | Contact Me

  • #2
    Amended failing GetLinkInfo() function. Tested and works fine on Windows XP Pro-SP2.

    ------------------
    contact page
    kgpsoftware.com - Home of the Slam Database Manager..
    kgpsoftware.com | Slam DBMS | PrpT Control | Other Downloads | Contact Me

    Comment


    • #3
      Thank you for this - it was just what I needed

      JS
      John,
      --------------------------------
      John Strasser
      Phone: 480 - 273 - 8798

      Comment


      • #4
        error found

        When I insert files via the clipboard, then the program crashes.
        The files must ca 5 to 6 times repeatedly inserted with the right mouse.

        Debugger reports:
        Invalid Address specified to RtlFreeHeap (00150000, 0015FE20 ) <0A>

        Comment


        • #5
          Code:
          '________________________________________________________________________________________
          '
          '  Drag/Drop functions
          '  -------------------
          '
          '  Simple demonstration of how to accept "dragged" files on your window of choice.
          '  NEW: Now also allows for right-click "pasting" of files.
          '
          '  By Kevin G. Peel, KGP Software. 2003.
          '
          '  Posted: July 2006.
          '  Mar 2010: Moved DragFinish() call to WM_DROPFILES to solve memory corruption error.
          '
          '  http://www.kgpsoftware.com.
          '________________________________________________________________________________________
           
          #Compile Exe
          #Dim All
          #Register All
           
          $APPTITLE = "DragDrop Example"
           
          %USEMACROS = 1
          #Include "win32api.inc"
           
          Declare Function Sub1(p1 As Any) As Dword
          Declare Function Sub2(p1 As Any, p2 As Any) As Dword
          Declare Function Sub3(p1 As Any, p2 As Any, p3 As Any) As Dword
          Declare Function Sub5(p1 As Any, p2 As Any, p3 As Any, p4 As Any, p5 As Any) As Dword
           
          '------------------------------------------------------------------------------
          ' Returns details from a link (LNK) file, based on iType.
          ' 1 = link file name, 2 = link path name, 3 = link parameters
          '
          ' Note: parts of the following function were found on PB forum,
          '       so credit goes to the original authors.
          '------------------------------------------------------------------------------
          Function GetLinkInfo(ByVal sLinkPath As String, ByVal nType As Long) As String
           
            Local CLSCTX_INPROC_SERVER As Dword, CLSID_ShellLink As GUIDAPI
            Local FileData As WIN32_FIND_DATA, Flags As Dword
            Local IID_IShellLink As GUIDAPI, IID_Persist As String * 16
            Local lResult As Dword, outvalue As Asciiz * %MAX_PATH, nRet As Long
            Local pp As Dword Ptr, ppf As Dword Ptr, psl As Dword Ptr
            Local TmpAsciiz As Asciiz * %MAX_PATH, TmpWide As Asciiz * (%MAX_PATH*2)
           
            Poke$ VarPtr(CLSID_ShellLink), Mkl$(&H00021401) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
            Poke$ VarPtr(IID_IShellLink), Mkl$(&H000214EE) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
           
            IID_Persist     = Mkl$(&H0000010B) + Chr$(0, 0, 0, 0, &HC0, 0, 0, 0, 0, 0, 0, &H46)
            CLSCTX_INPROC_SERVER = 1
           
            nRet = CoCreateInstance(CLSID_ShellLink, ByVal %NULL, CLSCTX_INPROC_SERVER, IID_IShellLink, psl)
            If (nRet = %S_Ok) Then
               pp = @psl
               Call Dword @pp Using Sub3(ByVal psl, IID_Persist, ppf) To lResult
               TmpAsciiz = sLinkPath
               MultiByteToWideChar %CP_ACP, 0, TmpAsciiz, -1, ByVal VarPtr(TmpWide), %MAX_PATH
               pp = @ppf + 20
               Call Dword @pp Using Sub3(ByVal ppf, TmpWide, ByVal %True)
               Select Case nType
                      Case 2
                           pp = @psl + 32
                           Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
                      Case 3
                           pp = @psl + 40
                           Call Dword @pp Using Sub3(ByVal psl, outvalue, ByVal %MAX_PATH)
                      Case Else
                           pp = @psl + 12
                           Call Dword @pp Using Sub5(ByVal psl, outvalue, ByVal %MAX_PATH, FileData, Flags)
               End Select
               ' Release the persistant file
               pp = @ppf + 8
               Call Dword @pp Using Sub1(ByVal ppf)
               ' Unbind the shell link object from the persistent file
               pp = @psl + 8
               Call Dword @pp Using Sub1(ByVal psl)
               Function = outValue
            End If
           
          End Function
           
          '------------------------------------------------------------------------------
          ' Return a list of drag/drop filenames, separated by | (See WM_DROPFILES message)
          ' Note: this function also finishes the specified drag/drop operation.
          '------------------------------------------------------------------------------
          Function GetDropFiles(ByVal hDropParam As Dword) As String
            Local sDropFiles As String, sFile As String, i As Long
           
            For i = 0 To DragQueryFile(hDropParam, &HFFFFFFFF&, "", 0)-1
           
                sFile = Space$(DragQueryFile(hDropParam, i, "", 0)+1)
                DragQueryFile hDropParam, i, ByVal StrPtr(sFile), Len(sFile)
                sFile = Left$(sFile, Len(sFile)-1)
                If UCase$(Right$(sFile, 4)) = ".LNK" Then sFile = GetLinkInfo(sFile, 1)
                sDropFiles = sDropFiles + sFile + "|"
            Next i
            Function = RTrim$(sDropFiles, "|")
           
          End Function
           
          '------------------------------------------------------------------------------
          ' Callback procedure for main dialog.
          '------------------------------------------------------------------------------
          CallBack Function dlgDropExample
           
            Local sFiles As String, pDrop As Dword
           
            Select Case CbMsg
           
                   Case %WM_DROPFILES
                        ' Test for files "dragged" onto window...
                        pDrop = CbWParam
                        sFiles = GetDropFiles(pDrop)
                        ' Free handle...
                        DragFinish(CbWParam)
                        If Len(sFiles) Then
                           ' Display list of files "dropped"...
                           Replace "|" With $CrLf In sFiles
                           MessageBox CbHndl, "Files dropped onto the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_IconInformation
                        End If
           
                   Case %WM_RButtonUp
                        ' Test for files on clipboard (paste-like operation)...
                        OpenClipBoard 0
                        pDrop = GetClipboardData(%CF_HDrop)
                        sFiles = GetDropFiles(pDrop)
                        CloseClipboard
                        If Len(sFiles) Then
                           ' Display list of files "dropped"...
                           Replace "|" With $CrLf In sFiles
                           MessageBox CbHndl, "Files pasted into the dialog: " + $CrLf + $CrLf + sFiles, $APPTITLE, %MB_IconInformation
                        End If
           
            End Select
           
          End Function
           
          '------------------------------------------------------------------------------
          ' Program Start Point
          '------------------------------------------------------------------------------
          Function PBMain
           
            Local hDlg As Dword
           
            Dialog New %HWND_Desktop, $APPTITLE, , , 250, 150, %WS_OverlappedWindow To hDlg
            Control Add Label, hDlg, 100, "Drag a file onto this dialog from explorer or right click with some copied files to display them...", 10, 10, 150, 35
            DragAcceptFiles hDlg, %TRUE
            Dialog Show Modal hDlg Call dlgDropExample
           
          End Function
          Last edited by Kev Peel; 7 Mar 2010, 07:04 PM.
          kgpsoftware.com | Slam DBMS | PrpT Control | Other Downloads | Contact Me

          Comment


          • #6
            The Code isn`t up to Date!

            To get the TargetPath from a .lnk file use this Method:
            PowerBasic provides the use of Interfaces..
            Declare:
            LOCAL PowerSh AS IWshShell
            PowerSh = NEWCOM "WScript.Shell"
            LOCAL PowerLnk AS IWshShortcut
            LOCAL strLnk, strPath as STRING
            Code:
            strLnk = FullPath of .lnk ' <- in
            PowerrLnk = PowerSh.CreateShortcut(UCODE$(strLnk)
            strPath = RTRIM$(ACODE$(PowerrLnk.TargetPath))

            THAT`S ALL..

            To get other Parameter from Member`s of IWSshShortcut:
            E.g.:
            WorkPath= ACODE$(PowerLnk .WorkingDirectory)
            IconPath=PARSE$(ACODE$(PowerLnk.IconLocation),1)

            Regasrd`s

            Comment


            • #7
              Hi Jurgen,

              I'm playing with your code this evening and get an error "Undefined Type" for IWshShell - PBWin9/10.

              Do you have a short compilable that demonstrates the code?

              Comment


              • #8
                You need to generate it with a COM browser from file wshom.ocx, but be aware that the one generated with the COM browser for PB 9 will be slightly different to the one generated with the browser for PB 10. For unicode strings parameters be had to use UCODE$/ACODE$ and BYVAL STRPTR in PB 9 and with PB 10 we just have to use WSTRINGs.
                Forum: http://www.jose.it-berater.org/smfforum/index.php

                Comment


                • #9
                  Because there is always someone that complains about using Windows Script Host, I have written some wrappers that use the IShellLinkW interface, e.g.

                  Code:
                  ' ========================================================================================
                  ' Gets the path and file name of a Shell link object.
                  ' - wszLinkPath = The path of the link object.
                  ' Example: ? AfxGetLinkTargetPath("C:\Users\Pepe\Desktop\Lynx.lnk")
                  ' ========================================================================================
                  FUNCTION AfxGetLinkTargetPath (BYREF wszLinkPath AS WSTRINGZ) AS WSTRING
                  
                     ' // Create an instance of the IShellLink interface
                     LOCAL pSlk AS IShellLinkW
                     pSlk = NEWCOM CLSID $CLSID_ShellLink
                     IF ISNOTHING (pSlk) THEN EXIT FUNCTION
                  
                     ' // The IShellLink Interface supports the IPersistFile
                     ' // interface. Get an interface pointer to it.
                     LOCAL ppf AS IPersistFile
                     ppf = pSlk
                     IF ISNOTHING(ppf) THEN EXIT FUNCTION
                  
                     ' // Load the file
                     LOCAL hr AS LONG
                     ppf.Load(wszLinkPath, %STGM_READ)
                     IF SUCCEEDED(hr) THEN
                        ' // Resolve the link by calling the Resolve method.
                        ' // This enables us to find the file the link points to even if
                        ' // it has been moved or renamed.
                        pSlk.Resolve(0, %SLR_ANY_MATCH OR %SLR_NO_UI)
                        ' // Get the path of the file the link points to.
                        LOCAL wszPath AS WSTRINGZ * %MAX_PATH
                        LOCAL wfd AS WIN32_FIND_DATAW
                        hr = pSlk.GetPath(wszPath, %MAX_PATH, wfd, %SLGP_UNCPRIORITY)
                        IF SUCCEEDED(hr) THEN FUNCTION = wszPath
                     END IF
                  
                  END FUNCTION
                  ' ========================================================================================
                  But require the use of my headers, since you can't generate interface definitions for IShellLinkW and IPersistFile with a COM browser.

                  It does the same that the GetLinkInfo function in your post, but in a more human readable way.
                  Last edited by José Roca; 2 Oct 2011, 01:58 AM. Reason: Spelling correction.
                  Forum: http://www.jose.it-berater.org/smfforum/index.php

                  Comment


                  • #10
                    Hi Jose,
                    Regarding your comment:
                    ... complains about using Windows Script Host...
                    I was thinking just the opposite this morning - that WSH seems to be a vastly underutilized, but potentially very useful, coding option. It's on my list to learn more about!

                    Comment


                    • #11
                      Originally posted by Gary Beene View Post
                      Hi Jose,
                      Regarding your comment:
                      I was thinking just the opposite this morning - that WSH seems to be a vastly underutilized, but potentially very useful, coding option. It's on my list to learn more about!
                      During many years I have provided examples. 99,99% of the questions that I have received have been "What if WSH is not installed?". My replies were always the same: "Install it".

                      So far, I have translated the VBScript Regular Expressions Examples to PB 10. See: http://www.jose.it-berater.org/smffo...p?topic=4384.0

                      And I'm working in traslating the Windows Script Runtime, Windows Script Host and Microsoft Script Control examples to PB 10. Currently, they are available in the version for PB 9: http://www.jose.it-berater.org/smffo...hp?board=251.0

                      I'm also writing an help file documenting all the M$ Scripting technologies usable with PB. It is almost finished and updated to PB 10 (I have to revise it to see if it needs some changes). See attached file.

                      I have also an example, updated to PB 10, to demonstrate how to host VBScript in a PB application: http://www.jose.it-berater.org/smffo...p?topic=4383.0

                      I also have a class, CDictionary.inc, that eases the use of the Dictionary object.

                      What else do you need?
                      Attached Files
                      Last edited by José Roca; 1 Oct 2011, 12:36 PM. Reason: Spelling correction
                      Forum: http://www.jose.it-berater.org/smfforum/index.php

                      Comment


                      • #12
                        Hi Jose,

                        What else do you need?
                        Just in case you mis-understood my comment, let me clarify. I am quite pleased with your work and am looking forward to using it. You've created plenty of material to enable the use of WSH in apps.

                        My comment was that I was surprised to see that programmers in the forums are not using the WSH capabilities, an enabled by your efforts, in their applications, i.e., I don't see a prevalence of WSH code examples by most programmers. It seems to me that WSH represents another set of API to use to our benefit.

                        Comment


                        • #13
                          And dozens, and dozens, and dozens of other technologies that your inquiring mind will discover little by little. Currently, about two thirds of what the Windows API provides are in the form of low-level COM servers. This probably will incrase greatly with Windows 8, since I have heard that M$ is working in a Windows Runtime implemented as low-level COM servers to ease its use with .NET and other languages and technologies. The underlying Windows API will continue to exist, otherwise they will break all existing applications, but the new APIs will be easier to use to those that know low-level COM programming. Apparently, they want to put some order in the uncontrolled old Windows API.

                          PB 10 is an almost perfect compiler to use low-level COM, yet I'm only seeing attempts to use it to do OOP. Why? I don't know.
                          Last edited by José Roca; 1 Oct 2011, 03:44 PM.
                          Forum: http://www.jose.it-berater.org/smfforum/index.php

                          Comment


                          • #14
                            Originally posted by José Roca View Post
                            PB 10 is an almost perfect compiler to use low-level COM, yet I'm only seeing attempts to use it to do OOP. Why? I don't know.
                            Probably because it isn't free.

                            Also it works pretty well for creating simple COM servers, so what's to tell? I don know about complex ones - not my waters.

                            Comment

                            Working...
                            X