2 个解决方案
#1
Option Explicit
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_COOKIES As Long = &H21
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_HISTORY As Long = &H22
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_TEMPLATES As Long = &H15
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 '(所有用户)\临时
'Api函数
Declare Function SHGetFolderPath Lib "shfolder.dll" Alias "SHGetFolderPathA" _
(ByVal hWndOwner As Long, ByVal nFolder As Long, _
ByVal hToken As Long, ByVal dwReserved As Long, _
ByVal lpszPath As String) As Long
'其他常量
Const CSIDL_FLAG_CREATE = &H8000&
Const CSIDL_FLAG_DONT_VERIFY = &H4000
Const CSIDL_FLAG_MASK = &HFF00
Const SHGFP_TYPE_CURRENT = &H0
Const SHGFP_TYPE_DEFAULT = &H1
'自写调用函数
Function GetFolderPath(hWndOwner As Long, CSIDL As Long) As String
Dim sPath As String * 255
If SHGetFolderPath(hWndOwner, CSIDL, 0&, SHGFP_TYPE_CURRENT, sPath) = 0 Then
GetFolderPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End Function
#2
Option Explicit
Private Const MAX_PATH = 255
Private Declare Function GetModuleFileNameW Lib "kernel32" (ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
Private Function GetModuleFileName(ByVal hModule As Long, ByRef lpFileName As String, ByVal nSize As Long) As Long
GetModuleFileName = GetModuleFileNameW(hModule, StrPtr(lpFileName), nSize)
End Function
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim ModuleName As String, FileName As String, hInst As Long
'create a buffer
ModuleName = String$(MAX_PATH, Chr$(0))
'get the hInstance application:
hInst = App.hInstance ' GetWindowLong(Me.hwnd, GWW_HINSTANCE)
'get the ModuleFileName:
'enter the following two lines as one, single line:
ModuleName = Left$(ModuleName, GetModuleFileName(hInst, ModuleName, Len(ModuleName)))
'set graphics mode to persistent
Me.AutoRedraw = True
'show the module filename
Me.Print "Module Filename: " + ModuleName
Me.Print "Dir: " + ExtractFileDir(ModuleName)
Me.Print "FileName: " + ExtractFileName(ModuleName)
End Sub
Private Function ExtractFileDir(ByVal FileName As String) As String
ExtractFileDir = Left$(FileName, InStrRev(FileName, "\") - 1)
End Function
Private Function ExtractFileName(ByVal FileName As String) As String
ExtractFileName = Mid$(FileName, InStrRev(FileName, "\") + 1)
End Function
#1
Option Explicit
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_COOKIES As Long = &H21
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_HISTORY As Long = &H22
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_TEMPLATES As Long = &H15
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 '(所有用户)\临时
'Api函数
Declare Function SHGetFolderPath Lib "shfolder.dll" Alias "SHGetFolderPathA" _
(ByVal hWndOwner As Long, ByVal nFolder As Long, _
ByVal hToken As Long, ByVal dwReserved As Long, _
ByVal lpszPath As String) As Long
'其他常量
Const CSIDL_FLAG_CREATE = &H8000&
Const CSIDL_FLAG_DONT_VERIFY = &H4000
Const CSIDL_FLAG_MASK = &HFF00
Const SHGFP_TYPE_CURRENT = &H0
Const SHGFP_TYPE_DEFAULT = &H1
'自写调用函数
Function GetFolderPath(hWndOwner As Long, CSIDL As Long) As String
Dim sPath As String * 255
If SHGetFolderPath(hWndOwner, CSIDL, 0&, SHGFP_TYPE_CURRENT, sPath) = 0 Then
GetFolderPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
End If
End Function
#2
Option Explicit
Private Const MAX_PATH = 255
Private Declare Function GetModuleFileNameW Lib "kernel32" (ByVal hModule As Long, ByVal lpFileName As Long, ByVal nSize As Long) As Long
Private Function GetModuleFileName(ByVal hModule As Long, ByRef lpFileName As String, ByVal nSize As Long) As Long
GetModuleFileName = GetModuleFileNameW(hModule, StrPtr(lpFileName), nSize)
End Function
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: KPDTeam@Allapi.net
Dim ModuleName As String, FileName As String, hInst As Long
'create a buffer
ModuleName = String$(MAX_PATH, Chr$(0))
'get the hInstance application:
hInst = App.hInstance ' GetWindowLong(Me.hwnd, GWW_HINSTANCE)
'get the ModuleFileName:
'enter the following two lines as one, single line:
ModuleName = Left$(ModuleName, GetModuleFileName(hInst, ModuleName, Len(ModuleName)))
'set graphics mode to persistent
Me.AutoRedraw = True
'show the module filename
Me.Print "Module Filename: " + ModuleName
Me.Print "Dir: " + ExtractFileDir(ModuleName)
Me.Print "FileName: " + ExtractFileName(ModuleName)
End Sub
Private Function ExtractFileDir(ByVal FileName As String) As String
ExtractFileDir = Left$(FileName, InStrRev(FileName, "\") - 1)
End Function
Private Function ExtractFileName(ByVal FileName As String) As String
ExtractFileName = Mid$(FileName, InStrRev(FileName, "\") + 1)
End Function