Attribute VB_Name = "Module1"
Option Explicit

Public Const SAVE_TO_FILE = "AFD.txt"
Public Const NULL_CHAR = "/\vbNullChar/\"

Private Type OSVERSIONINFO
  OSVSize         As Long         'size, in bytes, of this data structure
  dwVerMajor      As Long         'ie NT 3.51, dwVerMajor = 3; NT 4.0, dwVerMajor = 4.
  dwVerMinor      As Long         'ie NT 3.51, dwVerMinor = 51; NT 4.0, dwVerMinor= 0.
  dwBuildNumber   As Long         'NT: build number of the OS
                                  'Win9x: build number of the OS in low-order word.
                                  '       High-order word contains major & minor ver nos.
  PlatformID      As Long         'Identifies the operating system platform.
  szCSDVersion    As String * 128 'NT: string, such as "Service Pack 3"
                                  'Win9x: string providing arbitrary additional information
End Type

Public Type RECT
   Left As Long
   Top As Long
   Right As Long
   Bottom As Long
End Type

Public Const WM_INITDIALOG = &H110
Private Const VER_PLATFORM_WIN32_NT = 2

Public Const OFN_ALLOWMULTISELECT As Long = &H200
Public Const OFN_CREATEPROMPT As Long = &H2000
Public Const OFN_ENABLEHOOK As Long = &H20
Public Const OFN_ENABLETEMPLATE As Long = &H40
Public Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Public Const OFN_EXPLORER As Long = &H80000
Public Const OFN_EXTENSIONDIFFERENT As Long = &H400
Public Const OFN_FILEMUSTEXIST As Long = &H1000
Public Const OFN_HIDEREADONLY As Long = &H4
Public Const OFN_LONGNAMES As Long = &H200000
Public Const OFN_NOCHANGEDIR As Long = &H8
Public Const OFN_NODEREFERENCELINKS As Long = &H100000
Public Const OFN_NOLONGNAMES As Long = &H40000
Public Const OFN_NONETWORKBUTTON As Long = &H20000
Public Const OFN_NOREADONLYRETURN As Long = &H8000&
Public Const OFN_NOTESTFILECREATE As Long = &H10000
Public Const OFN_NOVALIDATE As Long = &H100
Public Const OFN_OVERWRITEPROMPT As Long = &H2
Public Const OFN_PATHMUSTEXIST As Long = &H800
Public Const OFN_READONLY As Long = &H1
Public Const OFN_SHAREAWARE As Long = &H4000
Public Const OFN_SHAREFALLTHROUGH As Long = 2
Public Const OFN_SHAREWARN As Long = 0
Public Const OFN_SHARENOWARN As Long = 1
Public Const OFN_SHOWHELP As Long = &H10
Public Const OFS_MAXPATHNAME As Long = 260

Public Const OFS_FILE_OPEN_FLAGS = OFN_EXPLORER Or OFN_LONGNAMES Or OFN_CREATEPROMPT Or OFN_NODEREFERENCELINKS Or OFN_ALLOWMULTISELECT

Public Type OPENFILENAME
  nStructSize       As Long
  hWndOwner         As Long
  hInstance         As Long
  sFilter           As String
  sCustomFilter     As String
  nMaxCustFilter    As Long
  nFilterIndex      As Long
  sFile             As String
  nMaxFile          As Long
  sFileTitle        As String
  nMaxTitle         As Long
  sInitialDir       As String
  sDialogTitle      As String
  flags             As Long
  nFileOffset       As Integer
  nFileExtension    As Integer
  sDefFileExt       As String
  nCustData         As Long
  fnHook            As Long
  sTemplateName     As String

 'new Win2000 / WinXP members
  pvReserved        As Long
  dwReserved        As Long
  FlagsEx           As Long
End Type

Public OFN As OPENFILENAME

Public Declare Function GetOpenFileName Lib "comdlg32" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetShortPathName Lib "kernel32" Alias "GetShortPathNameA" (ByVal lpszLongPath As String, ByVal lpszShortPath As String, ByVal cchBuffer As Long) As Long
Public Declare Function GetVersionEx Lib "kernel32" Alias "GetVersionExA" (lpVersionInformation As Any) As Long
Public Declare Function SetWindowText Lib "user32" Alias "SetWindowTextA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Public Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Public Declare Function GetParent Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function MoveWindow Lib "user32" (ByVal hwnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long) As Long

Public Function FARPROC(ByVal pfn As Long) As Long
   FARPROC = pfn
End Function

Public Function OFNHookProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
   'Center the Open File Dialog in it's parent window
   Dim hwndParent As Long
   Dim RC As RECT
   Select Case uMsg
      Case WM_INITDIALOG
         hwndParent = GetParent(hwnd)
         If hwndParent <> 0 Then
            Call GetWindowRect(hwndParent, RC)
            Call MoveWindow(hwndParent, ((frmMain.Left / Screen.TwipsPerPixelX) + (((frmMain.Width / Screen.TwipsPerPixelX) - (RC.Right - RC.Left)) \ 2)), ((frmMain.Top / Screen.TwipsPerPixelY) + (((frmMain.Height / Screen.TwipsPerPixelY) - (RC.Bottom - RC.Top)) \ 2)), (RC.Right - RC.Left), (RC.Bottom - RC.Top), True)
            OFNHookProc = 1
         End If
   End Select
End Function

Public Function IsWin2000Plus() As Boolean
  'returns True if running Windows 2000 or later
   Dim osv As OSVERSIONINFO
   osv.OSVSize = Len(osv)
   If GetVersionEx(osv) = 1 Then
    IsWin2000Plus = (osv.PlatformID = VER_PLATFORM_WIN32_NT) And (osv.dwVerMajor = 5 And osv.dwVerMinor >= 0)
   End If
End Function

Public Function AFDTextFileExists() As Boolean
 Dim path As String
 path = App.path
 If Right$(path, 1) <> "\" Then path = path & "\" 'if the path doesn't end with a slash, add a slash
 AFDTextFileExists = IIf(Dir$(path & SAVE_TO_FILE) = SAVE_TO_FILE, True, False)
End Function

Public Sub CreateAFDTextFile()
On Error GoTo CreateAFDTextFileError

Dim fso As FileSystemObject
Dim path As String

Set fso = CreateObject("Scripting.FileSystemObject")
path = App.path
If Right$(path, 1) <> "\" Then path = path & "\"
fso.CreateTextFile (path & SAVE_TO_FILE)
Set fso = Nothing

MsgBox "Successfully created the bad file list!" & vbNewLine & vbNewLine & "It is now located in:" & vbNewLine & path & SAVE_TO_FILE & vbNewLine, vbOKOnly + vbInformation

Exit Sub

CreateAFDTextFileError:
 MsgBox "There was an error." & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description & vbNewLine & "Occured in function: CreateAFDTextFile" & vbNewLine, vbCritical + vbOKOnly
End Sub

Public Sub AddAFileManually(show_done_dialog As Boolean, ByRef caller As Form)
On Error GoTo AddAFileManuallyError

caller.Enabled = False

'---------------- Reset the Open File Dialog ----------------------------
With OFN
 .sFile = "*.*" & Space$(1024) & vbNullChar & vbNullChar
 .nMaxFile = Len(.sFile)
 .sDefFileExt = "*" & vbNullChar & vbNullChar
 .sFileTitle = vbNullChar & Space$(512) & vbNullChar & vbNullChar
 .nMaxTitle = Len(OFN.sFileTitle)
 .sInitialDir = App.path & vbNullChar & vbNullChar
End With
'------------------------------------------------------------------------

If GetOpenFileName(OFN) Then 'user pressed ok

 Dim fso As FileSystemObject
 Dim textfile As File
 Dim a_textstream As TextStream
 Dim path As String
 Dim file_to_add As String
 Dim stop_string As String
 Dim length As Long
 
 stop_string = NULL_CHAR & NULL_CHAR
 length = 0
 
 Set fso = CreateObject("Scripting.FileSystemObject")
 path = App.path
 If Right$(path, 1) <> "\" Then path = path & "\"
 
 If AFDTextFileExists = False Then 'file does not exist, so create it
  fso.CreateTextFile (path & SAVE_TO_FILE)
 End If

 Set textfile = fso.GetFile(path & SAVE_TO_FILE)
 Set a_textstream = textfile.OpenAsTextStream(ForAppending)
 file_to_add = Replace(OFN.sFile, vbNullChar, NULL_CHAR) 'replace null chars with a human-readable string

 If InStr(file_to_add, stop_string) > 0 Then
  Do While Mid$(file_to_add, 1 + length, Len(stop_string)) <> stop_string
   length = length + 1
   DoEvents
  Loop
  file_to_add = Mid$(file_to_add, 1, length)

  If InStr(file_to_add, NULL_CHAR) > 0 Then 'contains more than 1 file
   Dim string_array() As String
   Dim i As Integer
   string_array = Split(file_to_add, NULL_CHAR)
   If UBound(string_array) > 0 Then
    For i = 1 To UBound(string_array)
     a_textstream.WriteLine string_array(0) & "\" & string_array(i)
     DoEvents
    Next
   End If
  Else 'only 1 file was found
   a_textstream.WriteLine file_to_add
  End If
  
  If show_done_dialog = True Then
   MsgBox "Successfully added file(s) to the bad file list.", vbOKOnly + vbInformation
  End If
 
 Else 'the stop string was not found in file_to_add
  MsgBox "Error: The Open File Dialog filename is damaged.", vbOKOnly + vbCritical
 End If 'end If InStr(file_to_add, stop_string) > 0
 
 a_textstream.Close
 Set fso = Nothing

End If 'end If GetOpenFileName(OFN) Then

caller.Enabled = True

Exit Sub

AddAFileManuallyError:
 caller.Enabled = True
 MsgBox "There was an error." & vbNewLine & vbNewLine & "Error Number: " & Err.Number & vbNewLine & "Error Description: " & Err.Description & vbNewLine & "Occured in function: AddAFileManually" & vbNewLine, vbCritical + vbOKOnly
End Sub