home *** CD-ROM | disk | FTP | other *** search
- VERSION 1.0 CLASS
- BEGIN
- MultiUse = -1 'True
- END
- Attribute VB_Name = "FileIO"
- Attribute VB_Creatable = True
- Attribute VB_Exposed = True
- ' FileIO class -- FILEIO.CLS
- '
- ' Properties
- ' WindowsDirectory (Read only)
- ' SystemDirectory (Read only)
- '
- ' Methods
- ' TempFileName
- '
- '
- '
- Option Explicit
-
- #If Win16 Then
- Private Declare Function GetWindowsDirectory Lib "Kernel" _
- (ByVal lpBuffer As String, _
- ByVal nSize As Integer) _
- As Integer
- Private Declare Function GetSystemDirectory Lib "Kernel" (ByVal lpBuffer As String, _
- ByVal nSize As Integer) As Integer
- Private Declare Function GetTempDrive Lib "Kernel" _
- (ByVal cDriveLetter As Integer) As Integer
- Private Declare Function GetTempFileName Lib "Kernel" (ByVal cDriveLetter As Integer, _
- ByVal lpPrefixString As String, ByVal wUnique As Integer, _
- ByVal lpTempFileName As String) As Integer
- #Else
- Private Declare Function GetWindowsDirectory Lib "kernel32" _
- Alias "GetWindowsDirectoryA" _
- (ByVal lpBuffer As String, _
- ByVal nSize As Integer) _
- As Integer
- Private Declare Function GetSystemDirectory Lib "kernel32" _
- Alias "GetSystemDirectoryA" _
- (ByVal lpBuffer As String, _
- ByVal nSize As Integer) As Integer
- Private Declare Function GetTempPath Lib "kernel32" Alias "GetTempPathA" _
- (ByVal nBufferLength As Long, ByVal lpBuffer As String) As Long
- Private Declare Function GetTempFileName Lib "kernel32" _
- Alias "GetTempFileNameA" (ByVal lpszPath As String, _
- ByVal lpPrefixString As String, ByVal wUnique As Long, _
- ByVal lpTempFileName As String) As Long
- #End If
-
- Public Function TempFileName(Optional Prefix) As String
- #If Win16 Then
- Dim iWorked As Integer
- #Else
- Dim iWorked As Long
- #End If
- Dim iTempDrive As Integer
- Dim strTempFileName As String, strPrefix As String * 3
- If IsMissing(Prefix) Then
- ' Provide a three-character prefix for the temporary file.
- strPrefix = ""
- Else
- strPrefix = Prefix
- End If
- ' Create a buffer full of spaces for GetTempFileName function.
- strTempFileName = String(255, 32)
- #If Win16 Then
- iWorked = GetTempDrive(iTempDrive)
- If iWorked = 0 Then GoTo errGetOLETempFileName
- iWorked = GetTempFileName(iTempDrive, strPrefix, 0, strTempFileName)
- #Else
- Dim lPath As Long, strPath As String
- lPath = 255
- strPath = String(lPath, 32)
- iWorked = GetTempPath(lPath, strPath)
- If iWorked = 0 Then
- GoTo errGetOLETempFileName
- Else
- strPath = Left(strPath, iWorked)
- End If
- iWorked = GetTempFileName(strPath, strPrefix, 0, strTempFileName)
- #End If
- If iWorked = 0 Then GoTo errGetOLETempFileName
- TempFileName = Trim(strTempFileName)
- Exit Function
- errGetOLETempFileName:
- MsgBox "Temporary file could not be created. "
- TempFileName = ""
- End Function
-
- ' Returns the Windows directory.
- Public Function WindowsDirectory() As String
- Dim strWinDirectory As String
- Dim iWorked As Integer
- ' Allocate space for the returned path string.
- strWinDirectory = Space(144)
- ' Get the Windows directory.
- iWorked = GetWindowsDirectory(strWinDirectory, _
- Len(strWinDirectory))
- ' Trim off the excess space.
- WindowsDirectory = Left(strWinDirectory, iWorked)
- End Function
-
- ' Returns the Windows System directory.
- Public Function SystemDirectory() As String
- Dim iLen As Integer
- Dim lpBuffer As String * 256
- iLen = GetSystemDirectory(lpBuffer, 256)
- If iLen Then
- SystemDirectory = Mid$(lpBuffer, 1, iLen)
- Else
- SystemDirectory = ""
- End If
- End Function
-
-