shorty.bas

来自「常用基本函数库,也许你需要的正在其中！如果不做程序」· BAS 代码 · 共 68 行

Attribute VB_Name = "ModShorty"
Option Explicit
    'API calls for long filename support
    Declare Function LoadLibraryEx32W Lib "Kernel" (ByVal lpszFile As String, ByVal hFile As Long, ByVal dwFlags As Long) As Long
    Declare Function FreeLibrary32W Lib "Kernel" (ByVal hDllModule As Long) As Long
    Declare Function GetProcAddress32W Lib "Kernel" (ByVal hInstance As Long, ByVal FunctionName As String) As Long
    Declare Function FindFirstFileA Lib "Kernel" Alias "CallProc32W" (ByVal lpszFile As String, aFindFirst As WIN32_FIND_DATA, ByVal lpfnFunction As Long, ByVal fAddressConvert As Long, ByVal dwParams As Long) As Long
    Declare Function GetShortPathNameA Lib "Kernel" Alias "CallProc32W" (ByVal lpszLongFile As String, ByVal lpszShortFile As String, ByVal lBuffer As Long, ByVal lpfnFunction As Long, ByVal fAddressConvert As Long, ByVal dwParams As Long) As Long
    Declare Function lcreat Lib "Kernel" Alias "_lcreat" (ByVal lpPathName As String, ByVal iAttribute As Integer) As Integer

    Private hInstKernel As Long
    Private lpGetShortPathNameA As Long
    Private lpFindFirstFileA As Long

    'Define structures for api calls

    Type FILETIME
       dwLowDateTime As Long
       dwHighDateTime As Long
    End Type

    Const MAX_PATH = 260

    Type WIN32_FIND_DATA
       dwFileAttributes As Long
       ftCreationTime As FILETIME
       ftLastAccessTime As FILETIME
       ftLastWriteTime As FILETIME
       nFileSizeHigh As Long
       nFileSizeLow As Long
       dwReserved0 As Long
       dwReserved1 As Long
       cFileName As String * MAX_PATH
       cAlternate As String * 14
    End Type

Function GetShortFilename(Filename As String) As String
    '=========================================================
    'Returns the ShortFileName of a file if in a 32 bit system
    'Else returns Filename. You MUST check the validity of the
    'filename after this function. If this function fails, it
    'will return the long filename it was passed.
    '=========================================================
   On Error GoTo GetShortFilename_Error
   Dim sFF As WIN32_FIND_DATA
   Dim a As Long
   Dim szShortFilename As String * 256
   Dim p As Integer
   'Load Kernel32 DLL - if you are on a 16 bit system this is where it would fail
   hInstKernel = LoadLibraryEx32W("Kernel32.dll", 0&, 0&)
   'Addresses of the long filename functions
   lpGetShortPathNameA = GetProcAddress32W(hInstKernel, "GetShortPathNameA")
   'Get the short name for the directory
   a = GetShortPathNameA(Filename, szShortFilename, 256&, lpGetShortPathNameA, 6&, 3&)
   p = InStr(szShortFilename, Chr$(0))
   Filename = LCase$(Left$(szShortFilename, p - 1))
   GetShortFilename = Filename
   'Release the Kernel if necessary
   a = FreeLibrary32W(hInstKernel)
   Exit Function
GetShortFilename_Error:
   ' must be no Win32 support, so just return the passed in filename
   GetShortFilename = Filename
   Exit Function
End Function