Листинг 2
Attribute VB_Name = "SDirName"
Option Explicit
Declare Function GetCurrentDirectory Lib "kernel32" _
Alias "GetCurrentDirectoryA" (ByVal nBufferLength _
As Long, ByVal lpBuffer As String) As Long
Declare Function GetTempPath Lib "kernel32" Alias _
"GetTempPathA" (ByVal nBufferLength As Long, ByVal _
lpBuffer As String) As Long
Declare Function GetSystemDirectory Lib "kernel32" _
Alias "GetSystemDirectoryA" (ByVal lpBuffer As _
String, ByVal nSize As Long) As Long
Declare Function GetWindowsDirectory Lib "kernel32" _
Alias "GetWindowsDirectoryA" (ByVal lpBuffer As _
String, ByVal nSize As Long) As Long
Public Static Function StandardDirNameAPI$(Index%)
'
' Определение имен стандартных каталогов Windows
'
' Длина буфера для имени каталога
Const BufferLength& = 256
Dim Result&, Buffer$, DirName$
Buffer$ = Space$(BufferLength)
Select Case Index%
Case 0 ' Текущий каталог
Result& = GetCurrentDirectory(BufferLength&, _
Buffer$)
Case 1 ' Временный каталог
Result& = GetTempPath(BufferLength&, Buffer$)
Case 2 ' Каталог Windows
Result& = GetWindowsDirectory(Buffer$, _
BufferLength&)
Case 3 ' Системный каталог
Result& = GetSystemDirectory(Buffer$, _
BufferLength&)
End Select
'
DirName$ = Left$(Buffer$, Result&)
' Убрать "\" справа в имени каталога
'If Right$(DirName$, 1) = "\" Then DirName$ = _
' Left$(DirName$, Result& - 1)
или наоборот добавить "\"
If Right$(DirName$, 1) <> "\" Then DirName$ = _
DirName$ + "\"
StandardDirNameAPI$ = DirName$
End Function