Attribute VB_Name = "modFileIO"
'-----------------------------------------------------
' MirageBot File Input/Output Module
' Written by Christopher Nevin (lancergli@gmail.com)
'-----------------------------------------------------

Option Explicit

Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Private Declare Function GetPrivateProfileSection Lib "kernel32" Alias "GetPrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Private Declare Function WritePrivateProfileSection Lib "kernel32" Alias "WritePrivateProfileSectionA" (ByVal lpAppName As String, ByVal lpString As String, ByVal lpFileName As String) As Long

Public Function DeleteFile(File As String) As Boolean
On Error GoTo hErr:
    Dim FSO As New FileSystemObject
    If FSO.FileExists(File) = True Then FSO.DeleteFile File, True: DeleteFile = True
    Set FSO = Nothing
hErr:
End Function

Public Function CreateFile(File As String) As Boolean
On Error GoTo hErr:
    Dim FSO As New FileSystemObject
    If FSO.FileExists(File) = False Then FSO.CreateTextFile File: CreateFile = True
    Set FSO = Nothing
hErr:
End Function

Public Function IsFile(File As String) As Boolean
On Error GoTo hErr:
    Dim FSO As New FileSystemObject
    IsFile = FSO.FileExists(File)
    Set FSO = Nothing
hErr:
End Function

Public Function DeleteFolder(Folder As String) As Boolean
On Error GoTo hErr:
    Dim FSO As New FileSystemObject
    If FSO.FolderExists(Folder) = True Then FSO.DeleteFolder Folder, True: DeleteFolder = True
    Set FSO = Nothing
hErr:
End Function

Public Function CreateFolder(Folder As String) As Boolean
On Error GoTo hErr:
    Dim FSO As New FileSystemObject
    If FSO.FolderExists(Folder) = False Then FSO.CreateFolder Folder: CreateFolder = True
    Set FSO = Nothing
hErr:
End Function

Public Function IsFolder(Dir As String) As Boolean
On Error GoTo hErr:
    Dim FSO As New FileSystemObject
    IsFolder = FSO.FolderExists(Dir)
    Set FSO = Nothing
hErr:
End Function

Public Function FolderList(Dir As String) As Folders
    Dim f As Folder, S As Folders, FSO As New FileSystemObject
    Set f = FSO.GetFolder(Dir)
    Set S = f.SubFolders
    Set FolderList = S
End Function

Public Function FileList(Mask As String) As String()
On Error GoTo hErr
    Dim sFile As String, sList() As String, lCtr As Long
1   ReDim sList(0) As String
2   sFile = Dir$(Mask, vbNormal)
3   Do While Len(sFile)
4       If sList(0) = vbNS Then
5           sList(0) = sFile
        Else
6           lCtr = UBound(sList) + 1
7           ReDim Preserve sList(lCtr) As String
8           sList(lCtr) = sFile
        End If
9       sFile = Dir
    Loop
10  FileList = sList
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "ReadWrite", "FileList"
End Function

Public Function GetFileName(Path As String) As String
    Dim File As String
    File = Path
    If InStr(File, "\") <> 0 Then
        File = Mid$(File, InStrRev(File, "\") + 1)
        If InStr(File, ".") <> 0 Then
            File = Left$(File, InStrRev(File, ".") - 1)
        End If
    End If
    GetFileName = File
End Function

Public Function ReadINI(ByRef File As String, ByRef Section As String, ByRef Key As String) As String
On Error GoTo hErr
    Dim Buffer As String * 256
2   GetPrivateProfileString Section, Key, vbNS, Buffer, 256, File
3   If InStrB(Buffer, vbNullChar) <> 0 Then Buffer = Split(Buffer, vbNullChar)(0)
4   ReadINI = Trim$(Buffer)
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "ReadWrite", "ReadINI"
End Function

Public Sub WriteINI(ByRef File As String, ByRef Section As String, ByRef Key As String, ByRef Value As String)
On Error GoTo hErr
2   WritePrivateProfileString Section, Key, Trim$(Value), File
    Exit Sub
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "ReadWrite", "WriteINI"
End Sub

Public Function ReadProfileSection(ByVal SectionName As String, ByVal FileName As String) As String()
    Const MaxSectionLen As Integer = 6120 'Read Up To 5kB From Section
    Dim strSectionData As String * MaxSectionLen 'Define buffer to receive section data
    Dim lngApiFnVal As Long
    lngApiFnVal = GetPrivateProfileSection(SectionName, strSectionData, MaxSectionLen, FileName)
    If lngApiFnVal Then
        ReadProfileSection = Split(Left(strSectionData, InStr(strSectionData, vbNullChar + vbNullChar) - 1), vbNullChar)
    Else
        ReDim ReadProfileSection(0)
    End If
End Function

Public Sub SaveFile(File As String, Content As String)
On Error GoTo hErr:
    CreateFile File
    If Len(Content) > 2 Then
        If Right$(Content, 2) = vbCrLf Or Right$(Content, 2) = vbNewLine Then
            Content = Left$(Content, Len(Content) - 2)
        End If
    End If
    Dim FF As Integer
    FF = FreeFile
    Open File For Output As #FF
        Print #FF, Content
hErr:
    Close #FF
End Sub

Public Function ReadFile(File As String) As String
On Error GoTo hErr:
    CreateFile File
    Dim FF As Integer
    FF = FreeFile
    Open File For Input As #FF
        ReadFile = Input(LOF(FF), #FF)
    Close #FF
    If LenB(ReadFile) <> 0 Then
        While Right$(ReadFile, 2) = vbNewLine
            ReadFile = Left$(ReadFile, Len(ReadFile) - 2)
        Wend
    End If
    Exit Function
hErr:
    Close #FF
End Function

Public Function DebugOutput(ByVal sIn As String) As String
On Error GoTo hErr
    Dim x1 As Long, y1 As Long
    Dim iLen As Long, iPos As Long
    Dim SB As String, ST As String
    Dim sOut As String
    Dim Offset As Long, sOffset As String
    iLen = Len(sIn)
    If iLen = 0 Then Exit Function
    sOut = vbNS
    Offset = 0
    For x1 = 0 To ((iLen - 1) \ 16)
        sOffset = Right$("0000" & Hex$(Offset), 4)
        SB = Space$(48)
        ST = String$(16, ".")
        For y1 = 1 To 16
            iPos = 16 * x1 + y1
            If iPos > iLen Then Exit For
            Mid$(SB, 3 * (y1 - 1) + 1, 2) = Right$("00" & Hex$(Asc(Mid$(sIn, iPos, 1))), 2) & Space$(1)
            Select Case Asc(Mid$(sIn, iPos, 1))
            Case 0, 9, 10, 13
            Case Else
                Mid$(ST, y1, 1) = Mid$(sIn, iPos, 1)
            End Select
        Next y1
        If LenB(sOut) <> 0 Then sOut = sOut & vbCrLf
        sOut = sOut & sOffset & ":  " & SB & Space$(2) & ST
        Offset = Offset + 16
    Next x1
    DebugOutput = sOut
    Exit Function
hErr:
    ErrorHandler Err.Number, Err.Description, Erl, "ReadWrite", "DebugOutput"
End Function
