|
'**************************************************************************
'**模 块 名:工程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 |
评分
-
查看全部评分
|