实现目录的浏览

2008-05-27 03:21:47 144 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›

用VB实现目录选择+浏览下面用API实现目录浏览,选择目录，如果有高手能够在选择目录时新建一个，请续，谢谢!Common.bas*************************************************************Option ExplicitPublic Type BrowseInfo hwndOwner As Long pIDLRoot As Lon 阅读详情

VB 6.0 怎么实现,要带新建文件夹的!!

...全文

【Node.js】如何实现浏览本地文件（根目录下包含多个子目录）？如何实现浏览本地文件（根目录下包含多个子目录）？核心步骤 const http = require('http'); const path = require('path'); const url = require('url'); const fs = require('fs'); const hostname = '127.0.0.1'; const port = 8010; var documentRoot = 'D:/projects/node/lessons/servers'; // 自定义本阅读详情

fjend

API 1,488 成员 23,270 内容

+ 关注 + 加入社区

切换为时间正序

fjend 2009-05-07

打赏
举报

谢谢两位

舉杯邀明月 2008-05-27

打赏
举报

楼主试一下这个如何：

Sub SelFolder()

    Dim SelFolder$, spShell, spFolder, spFolderItem

    On Error GoTo Err_Proc

    Set spShell = CreateObject("Shell.Application")

    Set spFolder = spShell.BrowseForFolder(0, "请选择文件夹！", 1, "")

    Set spFolderItem = spFolder.Self

    SelFolder = spFolderItem.Path

    Debug.Print SelFolder

    Exit Sub

Err_Proc:

    If Err > 0 Then Exit Sub

End Sub

vansoft 2008-05-27

打赏
举报

Option Explicit

Private Type BROWSEINFOTYPE
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type

Private Declare Function LocalAlloc Lib "kernel32" (ByVal uFlags As Long, ByVal uBytes As Long) As Long
Private Declare Function LocalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pv As Long)
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (pDest As Any, pSource As Any, ByVal dwLength As Long)
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBROWSEINFOTYPE As BROWSEINFOTYPE) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private Const WM_USER = &H400
Private Const BFFM_SETSELECTIONA As Long = (WM_USER + 102)
Private Const BFFM_SETSELECTIONW As Long = (WM_USER + 103)
Private Const LPTR = (&H0 Or &H40)

Public Enum BROWSETYPE
NONE = 0
PATHTEXT = 16
NEWFOLDER = 64
End Enum

Private Sub BrowseCallbackProcStr(ByVal hwnd As Long, ByVal uMsg As Long, ByVal lParam As Long, ByVal lpData As Long)
If uMsg = 1 Then
Call SendMessage(hwnd, BFFM_SETSELECTIONA, True, ByVal lpData)
End If
End Sub

Private Function FunctionPointer(FunctionAddress As Long) As Long
FunctionPointer = FunctionAddress
End Function

Public Function BrowseForFolder(ByVal hwnd As Long, ByVal strTitle As String, Optional selectedPath As String, Optional ByVal Flag As BROWSETYPE = 0) As String
Dim Browse_for_folder As BROWSEINFOTYPE
Dim itemID As Long
Dim selectedPathPointer As Long
Dim tmpPath As String * 256

If selectedPath = "" Then selectedPath = "" '避免selectedPath未初始化而出错

If Not Right(selectedPath, 1) <> "\" Then
selectedPath = Left(selectedPath, Len(selectedPath) - 1) '如果用户加了 "\" 则删除
End If

With Browse_for_folder
.hOwner = hwnd '所有都窗口之句柄
.lpszTitle = strTitle '对话框的标题
.ulFlags = Flag
.lpfn = FunctionPointer(AddressOf BrowseCallbackProcStr) '用于设置预设文件夹的回调函数
selectedPathPointer = LocalAlloc(LPTR, Len(selectedPath) + 1) '分配一个字符串内存
Call CopyMemory(ByVal selectedPathPointer, ByVal selectedPath, Len(selectedPath) + 1) ' 拷贝那个路径到内存
.lParam = selectedPathPointer ' 预设的文件夹
End With
itemID = SHBrowseForFolder(Browse_for_folder) '执行API函数：BrowseForFolder
If itemID Then
If SHGetPathFromIDList(itemID, tmpPath) Then '取得选定的文件夹
BrowseForFolder = Left(tmpPath, InStr(tmpPath, vbNullChar) - 1) '去掉多余的 null 字符
End If
Call CoTaskMemFree(itemID) '释放内存
End If
Call LocalFree(selectedPathPointer) '释放内存
End Function

实现目录的浏览

相关推荐