VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 7176|回复: 15

获取windwos中的所有可见目录

[复制链接]
 楼主| 发表于 2007-12-27 08:28:03 | 显示全部楼层 |阅读模式
'**************************************************************************
'**模 块 名:工程1 - Form1
'**说    明:魔灵圣域 版权所有2007 - 2008(C)
'**创 建 人:郭卫(魔灵)
'**日    期:2007-12-27 01:08:17
'**修 改 人:郭卫
'**日    期:
'**描    述:郭卫制作
'**版    本:V1.0.0    http://icecept.blog.sohu.com
'*************************************************************************
Option Explicit
'获取系统路径的API函数
Private Declare Function GetSystemDirectory Lib "kernel32" Alias "GetSystemDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'获取TEMP临时文件路径的API函数
Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
'获取WINDOWS路径
Private Declare Function GetWindowsDirectory Lib "kernel32" Alias "GetWindowsDirectoryA" (ByVal lpBuffer As String, ByVal nSize As Long) As Long
'获取文件夹路径S路径
Private Declare Function SHGetSpecialFolderLocation Lib "Shell32" (ByVal hwndOwner As Long, ByVal nFolder As Integer, ppidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "Shell32" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal szPath As String) As Long
Const DESKTOP = &H0& '桌面
Const PROGRAMS = &H2& '程序集
Const MYDOCUMENTS = &H5& '我的文档
Const MYFAVORITES = &H6& '收藏夹
Const STARTUP = &H7& '启动
Const RECENT = &H8& '最近打开的文件
Const SENDTO = &H9& '发送
Const STARTMENU = &HB& '开始菜单
Const NETHOOD = &H13& '网上邻居
Const FONTS = &H14& '字体
Const SHELLNEW = &H15& 'ShellNew
Const APPDATA = &H1A& 'Application Data
Const PrnHood = &H1B& 'PrintHood
Const PAGETMP = &H20& '网页临时文件
Const COOKIES = &H21& 'Cookies目录|
Const HISTORY = &H22& '历史
Private Sub command1_Click()
    Me.Caption = "获取系统路径"
    Me.Cls
    '也可以用 MsgBox Environ("windir")  & "\system32" 来实现
    Label1.Caption = GetWinSys()
End Sub
Private Sub Command10_Click()
    Me.Caption = "获取收藏夹路径"
    Me.Cls
    Label1.Caption = GetMyFavorites
End Sub
Private Sub Command11_Click()
    Me.Caption = "获取最后打开的文件路径"
    Me.Cls
    Label1.Caption = GetRecent
End Sub
Private Sub Command12_Click()
    Me.Caption = "获取网上邻居路径"
    Me.Cls
    Label1.Caption = GetNetHood
End Sub
Private Sub Command13_Click()
End Sub
Private Sub Command14_Click()
    Me.Caption = "获取字体路径"
    Me.Cls
    Label1.Caption = GetFonts
End Sub
Private Sub Command15_Click()
    Me.Caption = "获取cook路径"
    Me.Cls
    Label1.Caption = GetCookies
End Sub
Private Sub Command16_Click()
    Me.Caption = "获得历史路径"
    Me.Cls
    Label1.Caption = GetHistory
End Sub
Private Sub Command17_Click()
    Me.Caption = "获取网络临时文件路径"
    Me.Cls
    Label1.Caption = GetPageTemp
End Sub
Private Sub Command18_Click()
    Me.Caption = "获取ShellNew路径"
    Me.Cls
    Label1.Caption = GetShellNew
End Sub
Private Sub Command19_Click()
    Me.Caption = "获取Application Data路径"
    Me.Cls
    Label1.Caption = GetAppData
End Sub
Private Sub command2_click()
    Me.Caption = "获取TEMP路径"
    Me.Cls
    '也可以用 MsgBox Environ("temp") 来实现
    Label1.Caption = GetTemp()
End Sub
Private Sub Command20_Click()
    Me.Caption = "获取PrintHood路径"
    Me.Cls
    Label1.Caption = PrintHood
End Sub
Private Sub Command3_Click()
    Me.Caption = "获取桌面路径"
    Me.Cls
    Label1.Caption = GetDeskTop
End Sub
Private Sub Command4_Click()
    Me.Caption = "获取发送到路径"
    Me.Cls
    Label1.Caption = GetSendTo
End Sub
Private Sub Command5_Click()
    Me.Caption = "获取Windows路径"
    Me.Cls
    Label1.Caption = GetWinPath
End Sub
Private Sub Command6_Click()
    Me.Caption = "获取我的文档路径"
    Me.Cls
    Label1.Caption = GetMyDocuments
End Sub
Private Sub Command7_Click()
    Me.Caption = "获取程序路径"
    Me.Cls
    Label1.Caption = GetProGrams
End Sub
Private Sub Command8_Click()
    Me.Caption = "获取启动路径"
    Me.Cls
    Label1.Caption = GetStartUp
End Sub
Private Sub Command9_Click()
    Me.Caption = "获取开始菜单路径"
    Me.Cls
    Label1.Caption = GetStartMenu
End Sub
Private Sub form_load()
    Me.Icon = LoadPicture("")
End Sub
'获取系统路径
Function GetWinSys() As String
    Dim Sysdir As String * 80, Length As Long
    Length = GetSystemDirectory(Sysdir, Len(Sysdir))
    GetWinSys = Left(Sysdir, Length)
End Function
'获取Windows路径
Function GetWinPath() As String
    '也可以用 MsgBox Environ("windir")  来实现
    Dim Windir As String * 80, Length As Long
    Length = GetWindowsDirectory(Windir, Len(Windir))
    GetWinPath = Left(Windir, Length)
End Function
'获取Temp路径
Function GetTemp() As String
    Dim Temp As String * 80, Length As Long
    Length = GetTempPath(Len(Temp), Temp)
    GetTemp = Left(Temp, Length)     '返回:盘符:\temp\
    If Right(GetTemp, 1) = "\" Then '
        GetTemp = Left(GetTemp, Length - 1)
    End If
End Function
'获得桌面目录
Function GetDeskTop() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, DESKTOP, pidl
    SHGetPathFromIDList pidl, sTmp
    GetDeskTop = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得发送到目录
Function GetSendTo() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, SENDTO, pidl
    SHGetPathFromIDList pidl, sTmp
    GetSendTo = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得我的文档目录
Function GetMyDocuments() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, MYDOCUMENTS, pidl
    SHGetPathFromIDList pidl, sTmp
    GetMyDocuments = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得程序目录
Function GetProGrams() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, PROGRAMS, pidl
    SHGetPathFromIDList pidl, sTmp
    GetProGrams = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得启动目录
Function GetStartUp() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, STARTUP, pidl
    SHGetPathFromIDList pidl, sTmp
    GetStartUp = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得开始菜单目录
Function GetStartMenu() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, STARTMENU, pidl
    SHGetPathFromIDList pidl, sTmp
    GetStartMenu = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得收藏夹目录
Function GetMyFavorites() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, MYFAVORITES, pidl
    SHGetPathFromIDList pidl, sTmp
    GetMyFavorites = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得最后打开的文件目录
Function GetRecent() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, RECENT, pidl
    SHGetPathFromIDList pidl, sTmp
    GetRecent = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得网上邻居目录
Function GetNetHood() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, NETHOOD, pidl
    SHGetPathFromIDList pidl, sTmp
    GetNetHood = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得字体目录
Function GetFonts() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, FONTS, pidl
    SHGetPathFromIDList pidl, sTmp
    GetFonts = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得Cookies目录
Function GetCookies() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, COOKIES, pidl
    SHGetPathFromIDList pidl, sTmp
    GetCookies = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得历史目录
Function GetHistory() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, HISTORY, pidl
    SHGetPathFromIDList pidl, sTmp
    GetHistory = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得网页临时文件目录
Function GetPageTemp() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, PAGETMP, pidl
    SHGetPathFromIDList pidl, sTmp
    GetPageTemp = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得ShellNew目录
Function GetShellNew() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, SHELLNEW, pidl
    SHGetPathFromIDList pidl, sTmp
    GetShellNew = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得Application Data目录
Function GetAppData() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, APPDATA, pidl
    SHGetPathFromIDList pidl, sTmp
    GetAppData = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function
'获得PrintHood目录
Function PrintHood() As String
    Dim sTmp As String * 80
    Dim pidl As Long  '某特殊目录|在特殊目录|列表中的位置
    SHGetSpecialFolderLocation 0, PrnHood, pidl
    SHGetPathFromIDList pidl, sTmp
    PrintHood = Left(sTmp, InStr(sTmp, Chr(0)) - 1)
End Function

获取目录.rar

4.2 KB, 下载次数: 499

评分

参与人数 1威望 +7 人气 +3 收起 理由
19900603 + 7 + 3 貌似标题名有错别字。。。

查看全部评分

 楼主| 发表于 2008-1-24 13:03:10 | 显示全部楼层
这个帖子里的附件没有人下吗?
回复 支持 反对

使用道具 举报

发表于 2008-1-24 15:58:37 | 显示全部楼层
不错 顶一个
但是有些目录是跟用户有关的哦
下面是部分csidl 供楼主参考
Const CSIDL_ADMINTOOLS As Long = &H30             '(用户)\开始菜单\程序\系统管理工具
Const CSIDL_ALTSTARTUP As Long = &H1D             '未本地化的启动
Const CSIDL_APPDATA As Long = &H1A                '(用户)\应用程序的数据
Const CSIDL_BITBUCKET As Long = &HA               '(桌面)\回收站
Const CSIDL_CONTROLS As Long = &H3                '我的电脑\控制面板
Const CSIDL_DESKTOP As Long = &H0                 '桌面
Const CSIDL_DESKTOPDIRECTORY As Long = &H10       '(用户)\桌面
Const CSIDL_FAVORITES As Long = &H6               '(用户)\个性化设置
Const CSIDL_FONTS As Long = &H14                  'windows\字体
Const CSIDL_INTERNET As Long = &H1                'IE(桌面上的图标
Const CSIDL_INTERNET_CACHE As Long = &H20         '因特网缓存文件夹
Const CSIDL_LOCAL_APPDATA  As Long = &H1C         '(用户)\本地设置\应用程序数据
Const CSIDL_DRIVES As Long = &H11                 '我的电脑
Const CSIDL_MYPICTURES As Long = &H27             'C:\Program Files\My Pictures
Const CSIDL_NETHOOD As Long = &H13                '(用户)\网上邻居中的元素
Const CSIDL_NETWORK As Long = &H12                '网上邻居
Const CSIDL_PRINTERS As Long = &H4                '我的电脑\打印机
Const CSIDL_PRINTHOOD As Long = &H1B              '(用户)\打印机连接
Const CSIDL_PERSONAL As Long = &H5                '我的文档
Const CSIDL_PROGRAM_FILES As Long = &H26          'C:\Program Files
Const CSIDL_PROGRAM_FILESX86 As Long = &H2A       'x86 apps (Alpha)的程序文件目录
Const CSIDL_PROGRAMS As Long = &H2                '开始菜单\程序
Const CSIDL_PROGRAM_FILES_COMMON As Long = &H2B   'Program Files\Common
Const CSIDL_PROGRAM_FILES_COMMONX86 As Long = &H2C 'RISC上的x86 \Program Files\Common
Const CSIDL_RECENT As Long = &H8                  '(用户)\最近记录目录
Const CSIDL_SENDTO As Long = &H9                  '(用户)\发送到目录
Const CSIDL_STARTMENU As Long = &HB               '(用户)\开始菜单
Const CSIDL_STARTUP As Long = &H7                 '开始菜单\程序\启动
Const CSIDL_SYSTEM As Long = &H25                 'system文件夹
Const CSIDL_SYSTEMX86 As Long = &H29              'x86 apps (Alpha)的system文件夹
Const CSIDL_PROFILE As Long = &H28                '用户概貌文件夹
Const CSIDL_WINDOWS As Long = &H24                'Windows目录或SYSROOT()
Const CSIDL_COMMON_ADMINTOOLS As Long = &H2F      '(所有用户)\开始菜单\程序\系统管理工具
Const CSIDL_COMMON_ALTSTARTUP As Long = &H1E      '未本地化的通用启动
Const CSIDL_COMMON_APPDATA As Long = &H23         '(所有用户)\应用程序数据
Const CSIDL_COMMON_DESKTOPDIRECTORY As Long = &H19 '(所有用户)\桌面
Const CSIDL_COMMON_DOCUMENTS As Long = &H2E       '(所有用户)\文档
Const CSIDL_COMMON_FAVORITES As Long = &H1F       '(所有用户)\设置
Const CSIDL_COMMON_PROGRAMS As Long = &H17        '(所有用户)\程序
Const CSIDL_COMMON_STARTMENU As Long = &H16       '(所有用户)\开始菜单
Const CSIDL_COMMON_STARTUP As Long = &H18         '(所有用户)\启动
Const CSIDL_COMMON_TEMPLATES As Long = &H2D       '(所有用户)\临时

[ 本帖最后由 jupiter 于 2008-1-24 16:00 编辑 ]

评分

参与人数 1威望 +2 收起 理由
icecept + 2 谢谢了

查看全部评分

回复 支持 反对

使用道具 举报

 楼主| 发表于 2008-1-24 17:35:16 | 显示全部楼层
谢谢了,我的资料有全了,给你加分
回复 支持 反对

使用道具 举报

发表于 2008-1-24 17:42:17 | 显示全部楼层
如果是常用的一些系?相?的特殊目?位置?用WSH十分方便
?先引用 Windows Script Host Object Model (%system%\wshom.ocx)

Sub PrintSpecialFolders()
Dim wsh As New WshShell
Dim i As Integer

For i = wsh.SpecialFolders.Count - 1 To 0 Step -1
Debug.Print wsh.SpecialFolders(i)
Next

Debug.Print wsh.SpecialFolders("Desktop")   '?得桌面目?
  Debug.Print wsh.SpecialFolders("Fonts")   '?得系?字?目?
  Debug.Print wsh.SpecialFolders("Programs")   '?得程序菜?目?
  Debug.Print wsh.SpecialFolders("StartUp")   '?得程序??目?
  Debug.Print wsh.SpecialFolders("Recent")   '?得最近使用文件目?
  Debug.Print wsh.SpecialFolders("FAVORITES")   '?得收藏?目?
  Debug.Print wsh.SpecialFolders("SENDTO")   '?得?送到目?
  Debug.Print wsh.SpecialFolders("NETHOOD")   '?得???居目?
  Debug.Print wsh.SpecialFolders("AppData")   '?得微?程序??目?
end Sub
回复 支持 反对

使用道具 举报

发表于 2008-1-24 17:55:49 | 显示全部楼层
不错 呵呵
回复 支持 反对

使用道具 举报

发表于 2008-2-2 12:03:38 | 显示全部楼层
非常感谢
回复 支持 反对

使用道具 举报

usable 该用户已被删除
发表于 2008-2-3 00:18:28 | 显示全部楼层
提示: 作者被禁止或删除 内容自动屏蔽
回复 支持 反对

使用道具 举报

发表于 2008-2-3 14:14:36 | 显示全部楼层
不错 收藏了
回复 支持 反对

使用道具 举报

 楼主| 发表于 2009-8-25 21:53:04 | 显示全部楼层
本帖最后由 icecept 于 2009-8-25 21:58 编辑

5# kiss-win

在有些系统里会禁止使用脚本和FSO,因我以前就用的Windows Script Host 这种方法,却使程序在一些电脑上不通用,所以才想到了此贴的方法。

Windows Script Host 请参考:http://www.vbgood.com/viewthread.php?tid=59332&page=1#pid258405
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2019-7-23 07:16

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表