VB icon

A Basic Set of File handling controls (updated)

Email
Submitted on: 1/15/2015 10:33:00 PM
By: Sam Truscott (from psc cd)  
Level: Beginner
User Rating: By 21 Users
Compatibility: VB 4.0 (32-bit), VB 5.0, VB 6.0
Views: 1734
 
     FileReal, CloseAllFiles, CopyFile, DeleteFile, GetAttrib, GetFileDate, GetFileExtension, GetFileSize, MakeDIR, RemoveDIR, SetHidden, SetReadOnly, SetSystem, SetNormal, Overwrite
 
code:
Can't Copy and Paste this?
Click here for a copy-and-paste friendly version of this code!
				
'**************************************
' Name: A Basic Set of File handling controls (updated)
' Description:FileReal, CloseAllFiles, CopyFile, DeleteFile, GetAttrib, GetFileDate, GetFileExtension, GetFileSize, MakeDIR, RemoveDIR, SetHidden, SetReadOnly, SetSystem, SetNormal, Overwrite
' By: Sam Truscott (from psc cd)
'
' Inputs:Filename, Path, Source, Destination
'
' Returns:Filesize, File attributes, File Date/Time, File extension
'**************************************

'-------FileSys V1.0-------
'----by Samuel Truscott----
'----www.pezcore.co.uk-----
Public Sub Save(filename as string)
if filereal = true then
 if msgbox("Overwrite File?", vbYesNo) = vbYes then
deletefile(filename)
'save file code
else
'do NOT overwrite the file
end if
end if
End Sub
Public Function FileReal(Filename) As Boolean
On Error goto Error
If Dir(Filename) = Filename Then
FileReal = True
Else
FileReal = False
End If
Exit Function
Error:
Exit Sub
End Function
Public Function GetFileSize(FileName) As String
On Error GoTo Gfserror
Dim TempStr As String
TempStr = FileLen(FileName)
If TempStr >= "1024" Then
'KB
TempStr = CCur(TempStr / 1024) & "KB"
 Else
 If TempStr >= "1048576" Then
 'MB
 TempStr = CCur(TempStr / (1024 * 1024)) & "KB"
 Else
 TempStr = CCur(TempStr) & "B"
 End If
End If
GetFileSize = TempStr
Exit Function
Gfserror:
GetFileSize = "0B"
Resume
End Function
Public Function GetAttrib(FileName) As String
On Error GoTo GAError
Dim TempStr As String
TempStr = GetAttr(FileName)
If TempStr = "64" Then
TempStr = "Alias"
End If
If TempStr = "32" Then
TempStr = "Archive"
End If
If TempStr = "16" Then
TempStr = "Directory"
End If
If TempStr = "2" Then
TempStr = "Hidden"
End If
If TempStr = "0" Then
TempStr = "Normal"
End If
If TempStr = "1" Then
TempStr = "ReadOnly"
End If
If TempStr = "4" Then
TempStr = "System"
End If
If TempStr = "8" Then
TempStr = "Volume"
End If
GetAttrib = TempStr
Exit Function
GAError:
GetAttrib = "Unknown"
Resume
End Function
Public Sub SetHidden(FileName As String)
On Error Resume Next
SetAttr FileName, vbHidden
End Sub
Public Sub SetReadOnly(FileName As String)
On Error Resume Next
SetAttr FileName, vbReadOnly
End Sub
Public Sub SetSystem(FileName As String)
On Error Resume Next
SetAttr FileName, vbSystem
End Sub
Public Sub SetNormal(FileName As String)
On Error Resume Next
SetAttr FileName, vbNormal
End Sub
Public Function GetFileExtension(FileName As String)
On Error Resume Next
Dim TempStr As String
TempStr = Right(FileName, 2)
If Left(TempStr, 1) = "." Then
GetFileExtension = Right(FileName, 1)
Exit Function
Else
 TempStr = Right(FileName, 3)
 If Left(TempStr, 1) = "." Then
 GetFileExtension = Right(FileName, 2)
 Exit Function
 Else
 TempStr = Right(FileName, 4)
 If Left(TempStr, 1) = "." Then
 GetFileExtension = Right(FileName, 3)
 Exit Function
 Else
 TempStr = Right(FileName, 5)
 If Left(TempStr, 1) = "." Then
 GetFileExtension = Right(FileName, 4)
 Exit Function
 Else
 GetFileExtension = "Unknown"
 End If
 End If
 End If
End If
 
End Function
Public Function GetFileDate(FileName As String) As String
On Error Resume Next
GetFileDate = FileDateTime(FileName)
End Function
Public Sub DeleteFile(FileName As String)
On Error GoTo DelError
Kill FileName
Exit Sub
DelError:
MsgBox "Error deleting File"
Resume
End Sub
Public Sub CopyFile(Source As String, Destination As String)
On Error GoTo CopyError
FileCopy Source, Destination
Exit Sub
CopyError:
MsgBox "Error copying File"
Resume
End Sub
Public Sub MoveFile(Source As String, Destination As String)
On Error GoTo MoveError
FileCopy Source, Destination
Kill Source
Exit Sub
MoveError:
MsgBox "Error moving File"
Resume
End Sub
Public Sub MakeDIR(Path As String)
On Error GoTo DIRError
MkDir Path
Exit Sub
DIRError:
MsgBox "Error creating Directory"
Resume
End Sub
Public Sub RemoveDIR(Path As String)
On Error GoTo DIRError2
RmDir Path
Exit Sub
DIRError2:
MsgBox "Error removing Directory"
Resume
End Sub
Public Sub CloseAllFiles()
On Error Resume Next
Reset
End Sub


Other 2 submission(s) by this author

 


Report Bad Submission
Use this form to tell us if this entry should be deleted (i.e contains no code, is a virus, etc.).
This submission should be removed because:

Your Vote

What do you think of this code (in the Beginner category)?
(The code with your highest vote will win this month's coding contest!)
Excellent  Good  Average  Below Average  Poor (See voting log ...)
 

Other User Comments


 There are no comments on this submission.
 

Add Your Feedback
Your feedback will be posted below and an email sent to the author. Please remember that the author was kind enough to share this with you, so any criticisms must be stated politely, or they will be deleted. (For feedback not related to this particular code, please click here instead.)
 

To post feedback, first please login.