Abundant Technologies - IT Consulting Experts

 Source Code Library

 Code Details

 
Option Explicit 'local variable(s) to hold property value(s) Private m_FileName As String Private m_Buffer As String Private m_Length As Long Private m_Path As String Private m_FileNameOnly As String Private m_TimeStamp As String 'Buffer contains the text written/read tp/from a file 'This property is read and write Public Property Let Buffer(ByVal vData As String) m_Buffer = vData End Property Public Property Get Buffer() As String Buffer = m_Buffer End Property 'FileName contains the full path of the file to be written/read 'This property is read and write Public Property Let FileName(ByVal vData As String) m_FileName = vData End Property Public Property Get FileName() As String FileName = m_FileName End Property 'Length contains the file length in bytes of the file written/read 'This property is read only Public Property Get Length() As Long Length = m_Length End Property 'Path contains the path of the file to be written/read 'This property is read only Public Property Get Path() As String Path = m_Path End Property 'FileNameOnly contains the file name of the file to be written/read 'This property is read only Public Property Get FileNameOnly() As String FileNameOnly = m_FileNameOnly End Property 'TimeStamp contains the last modified date and time of the file written/read 'This property is read only Public Property Get TimeStamp() As String TimeStamp = m_TimeStamp End Property 'Writefile will create or modify the file as defined by m_FileName ' with the contents of m_Buffer Public Function WriteFile(iErr As Long, strErr As String) As Boolean Dim fso As New FileSystemObject Dim fFile As File Dim tsBuffer As TextStream On Error GoTo Error_WriteFile Set tsBuffer = fso.CreateTextFile(m_FileName) tsBuffer.Write m_Buffer tsBuffer.Close Set fFile = fso.GetFile(m_FileName) m_Length = FileLen(m_FileName) m_Path = fso.GetParentFolderName(m_FileName) m_FileNameOnly = fso.GetFileName(m_FileName) m_TimeStamp = fFile.DateLastModified Set fFile = Nothing Set tsBuffer = Nothing WriteFile = True Exit Function Error_WriteFile: iErr = Err.Number strErr = Err.Description WriteFile = False End Function 'Readfile will fill m_Buffer with the contents of the file as defined by m_FileName Public Function ReadFile(iErr As Long, strErr As String) As Boolean Dim fso As New FileSystemObject Dim fFile As File Dim tsBuffer As TextStream On Error GoTo Error_ReadFile Set fFile = fso.GetFile(m_FileName) Set tsBuffer = fFile.OpenAsTextStream m_Buffer = tsBuffer.ReadAll tsBuffer.Close m_Length = FileLen(m_FileName) m_Path = fso.GetParentFolderName(m_FileName) m_FileNameOnly = fso.GetFileName(m_FileName) m_TimeStamp = fFile.DateLastModified Set tsBuffer = Nothing Set fFile = Nothing ReadFile = True Exit Function Error_ReadFile: iErr = Err.Number strErr = Err.Description ReadFile = False End Function Public Function Rename(iErr As Long, strErr As String, ByVal NewName As String) As Boolean Dim fso As New FileSystemObject Dim fFile As File Dim tsBuffer As TextStream Dim Response As Integer On Error GoTo Error_Rename If fso.FileExists(fso.GetParentFolderName(m_FileName) & "\" & NewName) Then Response = MsgBox(NewName & " already exists, would you like to replace the existing file?", vbQuestion + vbYesNoCancel) If Response = vbYes Then fso.CopyFile m_FileName, fso.GetParentFolderName(m_FileName) & "\" & NewName m_FileName = fso.GetParentFolderName(m_FileName) & "\" & NewName Set fFile = fso.GetFile(m_FileName) m_Length = FileLen(m_FileName) m_Path = fso.GetParentFolderName(m_FileName) m_FileNameOnly = fso.GetFileName(m_FileName) m_TimeStamp = fFile.DateLastModified Set fFile = Nothing End If Else Set fFile = fso.GetFile(m_FileName) fFile.Name = NewName m_FileName = fso.GetParentFolderName(m_FileName) & "\" & NewName Set fFile = fso.GetFile(m_FileName) m_Length = FileLen(m_FileName) m_Path = fso.GetParentFolderName(m_FileName) m_FileNameOnly = fso.GetFileName(m_FileName) m_TimeStamp = fFile.DateLastModified Set fFile = Nothing End If Rename = True Exit Function Error_Rename: iErr = Err.Number strErr = Err.Description Rename = False End Function Public Function Delete(iErr As Long, strErr As String) As Boolean Dim fso As New FileSystemObject Dim Response As Integer On Error GoTo Error_Delete Response = MsgBox("Are you sure you want to delete '" & fso.GetBaseName(m_FileName) & "'?", vbQuestion + vbYesNo, "Confirm File Delete") If Response = vbYes Then fso.DeleteFile (m_FileName) End If Delete = True Exit Function Error_Delete: iErr = Err.Number strErr = Err.Description Delete = False End Function

Mail To: info@3pc.com