请问怎么用API获取当前程序文件的全路径名

时间:2023-02-20 20:17:33
如题,需要支持UNICODE,最好还能分别获得所在目录的全路径名和文件名(不含路径)

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