1 files changed, 143 insertions, 0 deletions
diff --git a/migrationanalysis/src/wizard/Get Directory Dialog.bas b/migrationanalysis/src/wizard/Get Directory Dialog.bas
new file mode 100644
index 000000000000..a4520bda67a0
--- /dev/null
+++ b/migrationanalysis/src/wizard/Get Directory Dialog.bas
@@ -0,0 +1,143 @@
+Attribute VB_Name = "BrowseDirectorysOnly"
+'/*************************************************************************
+' *
+' * DO NOT ALTER OR REMOVE COPYRIGHT NOTICES OR THIS FILE HEADER.
+' * 
+' * Copyright 2000, 2010 Oracle and/or its affiliates.
+' *
+' * OpenOffice.org - a multi-platform office productivity suite
+' *
+' * This file is part of OpenOffice.org.
+' *
+' * OpenOffice.org is free software: you can redistribute it and/or modify
+' * it under the terms of the GNU Lesser General Public License version 3
+' * only, as published by the Free Software Foundation.
+' *
+' * OpenOffice.org is distributed in the hope that it will be useful,
+' * but WITHOUT ANY WARRANTY; without even the implied warranty of
+' * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+' * GNU Lesser General Public License version 3 for more details
+' * (a copy is included in the LICENSE file that accompanied this code).
+' *
+' * You should have received a copy of the GNU Lesser General Public License
+' * version 3 along with OpenOffice.org.  If not, see
+' * <http://www.openoffice.org/license.html>
+' * for a copy of the LGPLv3 License.
+' *
+' ************************************************************************/
+
+' Modified as BIF_STATUSTEXT overflows for nested folders so is no longer
+' shown.
+
+'=====================================================================================
+' Browse for a Folder using SHBrowseForFolder API function with a callback
+' function BrowseCallbackProc.
+'
+' This Extends the functionality that was given in the
+' MSDN Knowledge Base article Q179497 "HOWTO: Select a Directory
+' Without the Common Dialog Control".
+'
+' After reading the MSDN knowledge base article Q179378 "HOWTO: Browse for
+' Folders from the Current Directory", I was able to figure out how to add
+' a callback function that sets the starting directory and displays the
+' currently selected path in the "Browse For Folder" dialog.
+'
+'
+' Stephen Fonnesbeck
+' steev@xmission.com
+' http://www.xmission.com/~steev
+' Feb 20, 2000
+'
+'=====================================================================================
+' Usage:
+'
+'    Dim folder As String
+'    folder = BrowseForFolder(Me, "Select A Directory", "C:\startdir\anywhere")
+'    If Len(folder) = 0 Then Exit Sub  'User Selected Cancel
+'
+'=====================================================================================
+
+Option Explicit
+
+Private Const BIF_STATUSTEXT = &H4&
+Private Const BIF_RETURNONLYFSDIRS = 1
+Private Const BIF_DONTGOBELOWDOMAIN = 2
+Private Const MAX_PATH = 260
+
+Private Const WM_USER = &H400
+Private Const BFFM_INITIALIZED = 1
+Private Const BFFM_SELCHANGED = 2
+Private Const BFFM_SETSELECTION = (WM_USER + 102)
+
+Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As String) As Long
+Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
+Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, ByVal lpBuffer As String) As Long
+Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, ByVal lpString2 As String) As Long
+
+Private Type BrowseInfo
+  hWndOwner      As Long
+  pIDLRoot       As Long
+  pszDisplayName As Long
+  lpszTitle      As Long
+  ulFlags        As Long
+  lpfnCallback   As Long
+  lParam         As Long
+  iImage         As Long
+End Type
+
+Private m_CurrentDirectory As String   'The current directory
+'
+
+Public Function BrowseForFolder(owner As Form, Title As String, StartDir As String) As String
+  'Opens a Treeview control that displays the directories in a computer
+
+  Dim lpIDList As Long
+  Dim szTitle As String
+  Dim sBuffer As String
+  Dim tBrowseInfo As BrowseInfo
+  m_CurrentDirectory = StartDir & vbNullChar
+
+  szTitle = Title
+  With tBrowseInfo
+    .hWndOwner = owner.hWnd
+    .lpszTitle = lstrcat(szTitle, "")
+    .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN '+ BIF_STATUSTEXT
+    .lpfnCallback = GetAddressofFunction(AddressOf BrowseCallbackProc)  'get address of function.
+  End With
+
+  lpIDList = SHBrowseForFolder(tBrowseInfo)
+  If (lpIDList) Then
+    sBuffer = Space(MAX_PATH)
+    SHGetPathFromIDList lpIDList, sBuffer
+    sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
+    BrowseForFolder = sBuffer
+  Else
+    BrowseForFolder = ""
+  End If
+  
+End Function
+ 
+Private Function BrowseCallbackProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal lp As Long, ByVal pData As Long) As Long
+  
+  Dim lpIDList As Long
+  Dim ret As Long
+  Dim sBuffer As String
+  
+  On Error Resume Next  'Sugested by MS to prevent an error from
+                        'propagating back into the calling process.
+     
+  Select Case uMsg
+  
+    Case BFFM_INITIALIZED
+      Call SendMessage(hWnd, BFFM_SETSELECTION, 1, m_CurrentDirectory)
+            
+  End Select
+  
+  BrowseCallbackProc = 0
+  
+End Function
+
+' This function allows you to assign a function pointer to a vaiable.
+Private Function GetAddressofFunction(add As Long) As Long
+  GetAddressofFunction = add
+End Function