FlashCompare (Better version)

[Fangbeast]

Code updated for 5.20+

Added Splitter, Statusbar for messages and number of files and html file refs, proper refreshing during loading the lists, comprarin and deleteing from lists. Can also move physical files on disk that were unreferenced in the html code, but only after a comparison run. (You don't want to move your whole file base!!!) Better use of the status bar too.

Hope someone can use this...

Code: Select all

; Copyright, PeriTek Visions, 2003.
; Free, do what you wish with it.
;
;===========================================================================================================================================================
; Init Constants
;===========================================================================================================================================================

;----------
#ProgramVersion                         = "FlashCompare, v1.0"
;----------

; Window Constants

Enumeration
  #Window_FlashGetCompare
  
  ; Window_FlashGetCompare
  
  #MenuBar_FlashGetCompare             
  #MenuBar_FlashGetCompare_loaddirlist 
  #MenuBar_FlashGetCompare_savedirlist 
  #MenuBar_FlashGetCompare_loadfilelist
  #MenuBar_FlashGetCompare_savefilelist
  #MenuBar_FlashGetCompare_catfiles   
  #MenuBar_FlashGetCompare_parselist  
  #MenuBar_FlashGetCompare_runcompare 
  #MenuBar_FlashGetCompare_movefiles  
  #MenuBar_FlashGetCompare_exitnow   
  
  #Gadget_FlashGetCompare_filelist   
  #Gadget_FlashGetCompare_htmllist   
  
  #Gadget_FlashGetCompare_toolbar    
  
  #Gadget_SplitterGadget             
  
  #StatusBar_FlashGetCompare          
  #StatusBar_FlashGetCompare_messages  
  #StatusBar_FlashGetCompare_filenames 
  #StatusBar_FlashGetCompare_filerefs
EndEnumeration

;===========================================================================================================================================================
; Declare any needed lists
;===========================================================================================================================================================

NewList dir.s()                                              ; Recursion routine uses this to find all files

;===========================================================================================================================================================
; Program declarations
;===========================================================================================================================================================

Declare.l Window_FlashGetCompare()
Declare   Messages(Heading.s, Message.s)
Declare   StatMess(Field.l, Message.s)
Declare   FlushEvents()

;===========================================================================================================================================================
; Main Event Loop
;===========================================================================================================================================================

If Window_FlashGetCompare()
 
  quitFlashGetCompare = 0

  StatMess(0, "Ready")
  StatMess(1, "File(s) ")
  StatMess(2, "Ref(s) ")
   
  Repeat
    EventID = WaitWindowEvent()
    Select EventID
      Case #PB_Event_CloseWindow
        If EventWindow() = #Window_FlashGetCompare
          quitFlashGetCompare = 1
        EndIf

      Case #PB_Event_Menu
        Select EventMenu()
          Case #MenuBar_FlashGetCompare_loaddirlist
          Case #MenuBar_FlashGetCompare_savedirlist   : Gosub SaveDirectoryList
          Case #MenuBar_FlashGetCompare_loadfilelist
          Case #MenuBar_FlashGetCompare_savefilelist
          Case #MenuBar_FlashGetCompare_catfiles      : Gosub MakeCatalogue
          Case #MenuBar_FlashGetCompare_parselist     : Gosub ParseHtml
          Case #MenuBar_FlashGetCompare_runcompare    : Gosub CompareFiles
          Case #MenuBar_FlashGetCompare_movefiles     : Gosub MoveFiles
          Case #MenuBar_FlashGetCompare_exitnow
            quitFlashGetCompare = 1
        EndSelect

      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Gadget_FlashGetCompare_filelist
            Select EventType()
              Case #PB_EventType_LeftDoubleClick
              Case #PB_EventType_RightDoubleClick
              Case #PB_EventType_RightClick
              Default
            EndSelect
          Case #Gadget_FlashGetCompare_htmllist
            Select EventType()
              Case #PB_EventType_LeftDoubleClick
              Case #PB_EventType_RightDoubleClick
              Case #PB_EventType_RightClick
              Default
            EndSelect
        EndSelect

    EndSelect
  Until quitFlashGetCompare
  CloseWindow(#Window_FlashGetCompare)
EndIf
End

;===========================================================================================================================================================
; Program window
;===========================================================================================================================================================

Procedure.l Window_FlashGetCompare()
  If OpenWindow(#Window_FlashGetCompare,175,0,840,600, #ProgramVersion, #PB_Window_SystemMenu|#PB_Window_Invisible)
    CreateMenu(#MenuBar_FlashGetCompare,WindowID(#Window_FlashGetCompare))
      MenuTitle("Files")
      MenuItem(#MenuBar_FlashGetCompare_loaddirlist,"Load Directory List")
      MenuItem(#MenuBar_FlashGetCompare_savedirlist,"Save Directory List")
      MenuItem(#MenuBar_FlashGetCompare_loadfilelist,"Load File List")
      MenuItem(#MenuBar_FlashGetCompare_savefilelist,"Save File List")
      MenuTitle("Jobs")
      MenuItem(#MenuBar_FlashGetCompare_catfiles,"Catalogue Files")
      MenuItem(#MenuBar_FlashGetCompare_parselist,"Parse HTML List")
      MenuItem(#MenuBar_FlashGetCompare_runcompare,"Run Comparison")
      MenuItem(#MenuBar_FlashGetCompare_movefiles,"Move UnReferenced Files")
      MenuTitle("Exit menu")
      MenuItem(#MenuBar_FlashGetCompare_exitnow,"Exit Now")
      
      
    ListIconGadget(#Gadget_FlashGetCompare_filelist,10,10,405,540,"Filenames",600,#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
      SendMessage_(GadgetID(#Gadget_FlashGetCompare_filelist),#LVM_SETBKCOLOR,0,16744448)
      SendMessage_(GadgetID(#Gadget_FlashGetCompare_filelist),#LVM_SETTEXTBKCOLOR,0,16744448)
    ListIconGadget(#Gadget_FlashGetCompare_htmllist,425,10,405,540,"Html Names",600,#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
      SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist),#LVM_SETBKCOLOR,0,16711935)
      SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist),#LVM_SETTEXTBKCOLOR,0,16711935)
    CreateStatusBar(#StatusBar_FlashGetCompare,WindowID(#Window_FlashGetCompare))
      AddStatusBarField(600)
      AddStatusBarField(120)
      AddStatusBarField(120)
    SplitterGadget(#Gadget_SplitterGadget, 10, 10, 818, 540, #Gadget_FlashGetCompare_filelist, #Gadget_FlashGetCompare_htmllist, #PB_Splitter_Vertical|#PB_Splitter_Separator)
    HideWindow(#Window_FlashGetCompare,0)
    ProcedureReturn WindowID(#Window_FlashGetCompare)
  EndIf
EndProcedure

;===========================================================================================================================================================
; Custom error messages to cut down on the amount of typing
;===========================================================================================================================================================

Procedure Messages(Heading.s, Message.s)

  MessageRequester(Heading.s, Message.s, #PB_MessageRequester_Ok)

EndProcedure

;===========================================================================================================================================================
; Custom routine to set statusbar messages to save typing
;===========================================================================================================================================================

Procedure StatMess(Field.l, Message.s)

StatusBarText(#StatusBar_FlashGetCompare, Field.l, Message.s)

EndProcedure

;===========================================================================================================================================================
; Flush window events to prevent hanging and greying out of objects
;===========================================================================================================================================================

Procedure FlushEvents()

  While WindowEvent() : Wend
 
EndProcedure

;===========================================================================================================================================================
; Cataloge files and populate the display
;===========================================================================================================================================================

MakeCatalogue:

  CompareFlag = 0
 
  ClearList(dir.s())

  drive.s   = PathRequester("Please select the drive and directory to catalogue", "")
 
  If drive.s = ""
    Return
  EndIf
   
  If Right(drive.s, 1) = "\"
    drive.s = Left(drive.s, Len(drive.s) - 1)
  EndIf

  ClearGadgetItems(#Gadget_FlashGetCompare_filelist)
 
  AddElement(dir())
   
  dir() = drive.s                                                ; (Paul Leischow)
   
  idx = 0
   
  Repeat
    SelectElement(dir(), idx)
    If ExamineDirectory(0, dir(), "*.*")
      path.s = dir() + "\"
      quit = 0
      While NextDirectoryEntry(0)
        filename.s = DirectoryEntryName(0)
        Select DirectoryEntryType(0)
          Case #PB_DirectoryEntry_File
            diskfile.s = path + filename.s
            AddGadgetItem(#Gadget_FlashGetCompare_filelist, - 1, diskfile.s)
            FlushEvents()
            StatMess(1, "File(s) " + Str(count))
            SendMessage_(GadgetID(#Gadget_FlashGetCompare_filelist), #LVM_ENSUREVISIBLE, count , 0)
            count + 1
          Case #PB_DirectoryEntry_Directory
            filename.s = DirectoryEntryName(0)
            If filename.s <> ".." And filename.s <> "."
              AddElement(dir())
              dir() = path + filename.s
            EndIf
        EndSelect 
      Wend
    EndIf
    idx + 1
  Until idx > ListSize(dir()) - 1

  ClearList(dir.s())

Return

;===========================================================================================================================================================
; Parse html catalogue file
;===========================================================================================================================================================

ParseHtml:

  CompareFlag = 0
 
  numfound = 0
 
  file.s   = OpenFileRequester("Please Select the directory And file To parse", "", "*.*",0)

  If file.s = ""
    Return
  EndIf
   
  ClearGadgetItems(#Gadget_FlashGetCompare_htmllist)
 
  If OpenFile(0, file.s) <> 0
    While Eof(0) = 0
    ;-------------------------------------------------------------------------------------------------------
      Temp.s = ReadString(0)
      Pos    = FindString(Temp.s, "file://", 0)
     
      If Pos <> 0
        FilePos     = FindString(Temp.s, ">", Pos)
        SubString.s = Mid(Temp.s, Pos + 7, FilePos - Pos - 8)
        AddGadgetItem(#Gadget_FlashGetCompare_htmllist, - 1, SubString.s)
        FlushEvents()
        StatMess(2, "Ref(s) " + Str(numfound))
        SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist), #LVM_ENSUREVISIBLE, numfound , 0)
        numfound + 1
      EndIf
    ;-------------------------------------------------------------------------------------------------------
    Wend
  Else
    Return
  EndIf
     
  CloseFile(0)
     
Return

;===========================================================================================================================================================
; Compare actual files with database entries, delete matching pairs from the lists
;===========================================================================================================================================================

CompareFiles:

  CompareFlag = 0
 
  Files = CountGadgetItems(#Gadget_FlashGetCompare_filelist)
  Lists = CountGadgetItems(#Gadget_FlashGetCompare_htmllist)
  ;-----------------------------------------------------------------------------------------------
  If Files = 0 Or Lists = 0
    Messages("Error", "No files in one or more lists to compare")
    Return
  EndIf
  ;-----------------------------------------------------------------------------------------------
  For ListLoop = 0 To Lists - 1
    ListFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_htmllist, ListLoop, 0)
    SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist), #LVM_ENSUREVISIBLE, ListLoop , 0)
    Gosub LoopDiskFiles
  Next ListLoop
 
  CompareFlag = 1
 
Return

;===========================================================================================================================================================
; Loop through disk filenames and delete matches from both lists
;===========================================================================================================================================================

LoopDiskFiles:

  For FilesLoop = 0 To Files - 1
    DiskFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_filelist, FilesLoop, 0)
    If DiskFile.s = ListFile.s
      RemoveGadgetItem(#Gadget_FlashGetCompare_htmllist, ListLoop)
      FlushEvents()
      StatMess(2, "Ref(s) " + Str(Lists))
      RemoveGadgetItem(#Gadget_FlashGetCompare_filelist, FilesLoop)
      FlushEvents()
      StatMess(1, "File(s) " + Str(Files))
      Files - 1 : FilesLoop - 1: Lists - 1 : ListLoop - 1
    EndIf
  Next FilesLoop
 
Return

;===========================================================================================================================================================
; Save the list of files in the catalogue pane to hard disk
;===========================================================================================================================================================

SaveDirectoryList:

  Files = CountGadgetItems(#Gadget_FlashGetCompare_filelist)

  If Files = 0
    Messages("Error", "No files in the list to save!!")
    Return
  EndIf

  DirFileName.s = SaveFileRequester("Directory Listing", "", "Text | *.txt", 0)
 
  If DirFileName.s = ""
    Return
  EndIf
 
  If OpenFile(0, DirFileName.s) <> 0
    For DirLoop = 0 To Files
      DirFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_filelist, DirLoop, 0)
      WriteStringN(0, DirFile.s)
      SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist), #LVM_ENSUREVISIBLE, DirLoop , 0)
    Next DirLoop
    WriteStringN(0, "End of listing")
  EndIf
 
  CloseFile(0)
 
  Messages("Finished", "Directory listing written to disk!!")

Return

;===========================================================================================================================================================
; Move files that were unreferenced To somewhere Else
;===========================================================================================================================================================

MoveFiles:

  If CompareFlag = 0
    Messages("Error", "No comparison done, cannot move entire filebase!!")
    Return
  EndIf
 
  Files = CountGadgetItems(#Gadget_FlashGetCompare_filelist)

  If Files = 0
    Messages("Error", "No files in the directory list to move!!")
    Return
  EndIf

  MovePath.s = PathRequester("Move Un-Reference files to:", "")
 
  If MovePath.s = ""
    Return
  EndIf

  For MoveLoop = 0 To Files -1
    OriginalFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_filelist, MoveLoop, 0)
    OldFileName.s  = GetFilePart(OriginalFile.s)
    NewPath.s = MovePath.s + OldFileName.s
    StatMess(0, "Moving File: " + OriginalFile.s)   
    CopyFile(OriginalFile.s, NewPath.s)
    DeleteFile(OriginalFile.s)
    RemoveGadgetItem(#Gadget_FlashGetCompare_filelist, MoveLoop)
    FlushEvents()
    MoveLoop - 1  : Files - 1
    NewPath.s = ""
  Next MoveLoop
 
  CompareFlag = 0
 
Return

[Fangbeast]

Added full screen resizing, recalc status bar for full screen, nice frame, date at start in titlebar, wrappers for some common commands.

Code: Select all

; Copyright, PeriTek Visions, 2003.
; Free, do what you wish with it.
;
;===========================================================================================================================================
; Init Constants
;===========================================================================================================================================

;----------
#ProgramVersion                         = "FlashCompare, v1.0"
;----------
#WindowIndex                            = 0
#GadgetIndex                            = 0
#ImageIndex                             = 0
#StatusBarIndex                         = 0
#MenuBarIndex                           = 0

; Window Constants

#Window_FlashGetCompare                 = #WindowIndex  : #WindowIndex  = #WindowIndex  + 1

; Window_FlashGetCompare

#MenuBar_FlashGetCompare                = #MenuBarIndex : #MenuBarIndex = #MenuBarIndex + 1
#MenuBar_FlashGetCompare_loaddirlist    = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_savedirlist    = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_loadfilelist   = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_savefilelist   = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_catfiles       = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_parselist      = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_runcompare     = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_movefiles      = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#MenuBar_FlashGetCompare_exitnow        = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1

#Gadget_FlashGetCompare_Frame           = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1

#Gadget_FlashGetCompare_filelist        = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1
#Gadget_FlashGetCompare_htmllist        = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1

#Gadget_FlashGetCompare_toolbar         = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1

#Gadget_SplitterGadget                  = #GadgetIndex  : #GadgetIndex  = #GadgetIndex  + 1

#StatusBar_FlashGetCompare              = #StatusBarIndex : #StatusBarIndex = #StatusBarIndex + 1
#StatusBar_FlashGetCompare_messages     = 0
#StatusBar_FlashGetCompare_filenames    = 1
#StatusBar_FlashGetCompare_filerefs     = 2

;- Setup names for numerical calendar ---------------------------------------------------------------------------------------

Dim nameOfDay.s(7)                                          ; fill an array with the names of the days

  nameOfDay(0) = "Sunday"     : nameOfDay(1) = "Monday"   : nameOfDay(2) = "Tuesday"  : nameOfDay(3) = "Wednesday"  
  nameOfDay(4) = "Thursday"   : nameOfDay(5) = "Friday"   : nameOfDay(6) = "Saturday"

Dim daysPerMonth(12)                                       ; fill an array on how many days per month there are

For x = 0 To 11     
  daysPerMonth(x) = 31 
Next

  daysPerMonth(1)  = 28   : daysPerMonth(3)  = 30   : daysPerMonth(5)  = 30 : daysPerMonth(8)  = 30 
  daysPerMonth(10) = 30

Dim nameOfMonth.s(12)                                    ; fill an array with the names of the months

  nameOfMonth(0)  = "January"   : nameOfMonth(1)  = "February"   :  nameOfMonth(2)  = "March"     : nameOfMonth(3)  = "April"    
  nameOfMonth(4)  = "May"       : nameOfMonth(5)  = "June"       :  nameOfMonth(6)  = "July"      : nameOfMonth(7)  = "August"     
  nameOfMonth(8)  = "September" : nameOfMonth(9)  = "October"    :  nameOfMonth(10) = "November"  : nameOfMonth(11) = "December"

Dim years.s(7)                                           ; fill an array with the years

  years(0) = "2002" : years(1) = "2003" : years(2) = "2004" : years(3) = "2005" : years(4) = "2006"   : years(5) = "2007" 
  years(6) = "2008"

;===========================================================================================================================================
; Declare any needed lists
;===========================================================================================================================================

NewList dir.s()                                              ; Recursion routine uses this to find all files

;===========================================================================================================================================
; Any global values needed
;===========================================================================================================================================

Global hStatusBar, OriginalWidth, OriginalHeight, OldStatusBarWidth, NewStatusBarWidth, hStatusBar, currentdate.s

;============================================================================================================================
; Dimension the number of fields in the status bar that we are going to resize in the callback
;============================================================================================================================

Dim StatusBarFields.l(2) ; <- needed for resize, must be the number of Fields -1 (since it begins at 0)

;===========================================================================================================================================
; Program declarations
;===========================================================================================================================================

Declare.l Window_FlashGetCompare()
Declare   Messages(Heading.s, Message.s)
Declare   WindowCallback(WindowID,Message,wParam,lParam)
Declare   StatMess(Field.l, Message.s)
Declare   FlushEvents()
Declare   SetDate()
Declare.s addDateSuffix(date.s)

;===========================================================================================================================================
; Any needed structures
;===========================================================================================================================================

Structure dateStructure
  Year.w
  Month.w
  DayOfWeek.w
  Day.w
  Hour.w
  Minute.w
  Second.w
  Milliseconds.w
EndStructure

;===========================================================================================================================================
; Main Event Loop
;===========================================================================================================================================

If Window_FlashGetCompare()
 
  SetWindowCallback(@WindowCallback())

  SetDate()                                              ; Set the current date for the user

  quitFlashGetCompare = 0

  StatMess(0, "Ready")
  StatMess(1, "File(s) ")
  StatMess(2, "Ref(s) ")
    
  Repeat
    EventID = WaitWindowEvent()
    Select EventID
      Case #PB_Event_CloseWindow
        If EventWindowID() = #Window_FlashGetCompare
          quitFlashGetCompare = 1
        EndIf

      Case #PB_Event_Menu
        Select EventMenuID()
          Case #MenuBar_FlashGetCompare_loaddirlist
          Case #MenuBar_FlashGetCompare_savedirlist   : Gosub SaveDirectoryList
          Case #MenuBar_FlashGetCompare_loadfilelist
          Case #MenuBar_FlashGetCompare_savefilelist
          Case #MenuBar_FlashGetCompare_catfiles      : Gosub MakeCatalogue
          Case #MenuBar_FlashGetCompare_parselist     : Gosub ParseHtml
          Case #MenuBar_FlashGetCompare_runcompare    : Gosub CompareFiles
          Case #MenuBar_FlashGetCompare_movefiles     : Gosub MoveFiles
          Case #MenuBar_FlashGetCompare_exitnow
        EndSelect

      Case #PB_Event_Gadget
        Select EventGadgetID()
          Case #Gadget_FlashGetCompare_filelist
            Select EventType()
              Case #PB_EventType_LeftDoubleClick
              Case #PB_EventType_RightDoubleClick
              Case #PB_EventType_RightClick
              Default
            EndSelect
          Case #Gadget_FlashGetCompare_htmllist
            Select EventType()
              Case #PB_EventType_LeftDoubleClick
              Case #PB_EventType_RightDoubleClick
              Case #PB_EventType_RightClick
              Default
            EndSelect
        EndSelect

    EndSelect
  Until quitFlashGetCompare
  CloseWindow(#Window_FlashGetCompare)
EndIf
End

;===========================================================================================================================================
; Program window
;===========================================================================================================================================

Procedure.l Window_FlashGetCompare()
  If OpenWindow(#Window_FlashGetCompare,189,0,840,600,#PB_Window_SystemMenu|#PB_Window_Invisible|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_SizeGadget,#ProgramVersion)
    Brush.LOGBRUSH\lbColor=16695498
    SetClassLong_(WindowID(#Window_FlashGetCompare),#GCL_HBRBACKGROUND,CreateBrushIndirect_(Brush))
    OriginalWidth  = WindowWidth()  ; Original non-client width.
    OriginalHeight = WindowHeight() ; Original non-client height.
    OldStatusBarWidth = WindowWidth()  ; <- needed for resizing
    CreateMenu(#MenuBar_FlashGetCompare,WindowID(#Window_FlashGetCompare))
      MenuTitle("Files")
      MenuItem(#MenuBar_FlashGetCompare_loaddirlist,"Load Directory List")
      MenuItem(#MenuBar_FlashGetCompare_savedirlist,"Save Directory List")
      MenuItem(#MenuBar_FlashGetCompare_loadfilelist,"Load File List")
      MenuItem(#MenuBar_FlashGetCompare_savefilelist,"Save File List")
      MenuTitle("Jobs")
      MenuItem(#MenuBar_FlashGetCompare_catfiles,"Catalogue Files")
      MenuItem(#MenuBar_FlashGetCompare_parselist,"Parse HTML List")
      MenuItem(#MenuBar_FlashGetCompare_runcompare,"Run Comparison")
      MenuItem(#MenuBar_FlashGetCompare_movefiles,"Move UnReferenced Files")
      MenuTitle("Exit menu")
      MenuItem(#MenuBar_FlashGetCompare_exitnow,"Exit Now")
    If CreateGadgetList(WindowID())
      Frame3DGadget(#Gadget_FlashGetCompare_Frame,5,0,830,555,"")
      ListIconGadget(#Gadget_FlashGetCompare_filelist,15,15,400,530,"Files on disk and not in database",600,#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
        SendMessage_(GadgetID(#Gadget_FlashGetCompare_filelist),#LVM_SETBKCOLOR,0,16695498)
        SendMessage_(GadgetID(#Gadget_FlashGetCompare_filelist),#LVM_SETTEXTBKCOLOR,0,16695498)
      ListIconGadget(#Gadget_FlashGetCompare_htmllist,425,15,400,530,"Files in database but not on disk",600,#PB_ListIcon_MultiSelect|#PB_ListIcon_FullRowSelect|#PB_ListIcon_AlwaysShowSelection)
        SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist),#LVM_SETBKCOLOR,0,16695498)
        SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist),#LVM_SETTEXTBKCOLOR,0,16695498)
      hStatusBar = CreateStatusBar(#StatusBar_FlashGetCompare,WindowID(#Window_FlashGetCompare))
        AddStatusBarField(600)
        AddStatusBarField(120)
        AddStatusBarField(120)
      SplitterGadget(#Gadget_SplitterGadget, 15, 15, 810, 530, #Gadget_FlashGetCompare_filelist, #Gadget_FlashGetCompare_htmllist, #PB_Splitter_Vertical|#PB_Splitter_Separator) 
      HideWindow(#Window_FlashGetCompare,0)
      ProcedureReturn WindowID()
    EndIf
  EndIf
EndProcedure

;===========================================================================================================================================
; Custom error messages to cut down on the amount of typing
;===========================================================================================================================================

Procedure Messages(Heading.s, Message.s)

  MessageRequester(Heading.s, Message.s, #PB_MessageRequester_Ok)

EndProcedure

;===========================================================================================================================================
; Window and object resizing
;===========================================================================================================================================

Procedure WindowCallback(WindowID,Message,wParam,lParam)

  ReturnValue = #PB_ProcessPureBasicEvents

  Select Message
    Case #WM_GETMINMAXINFO                                            ; Restrict the minimum size to 500x(307 + MenuHeight()), borders included
      Result = 0
      *ptr.MINMAXINFO       = lParam
      *ptr\ptMinTrackSize\x = 640 + 8
      *ptr\ptMinTrackSize\y = 480 + 14 + MenuHeight()
    Case #WM_SIZE
      winwidth.l  = WindowWidth()                                     ; Get the new width of the window
      winheight.l = WindowHeight()                                    ; Get the new height of the window
      widthchange  = winwidth  - OriginalWidth                        ; Get the width difference
      heightchange = winheight - OriginalHeight                       ; Get the height difference 108,0,587,400
      ;-----------------------------------------------------------------------------------------------------------------
      ResizeGadget(#Gadget_FlashGetCompare_Frame, 5, 0, 830 + widthchange, 555 + heightchange)

      ResizeGadget(#Gadget_SplitterGadget,                        -1,                 -1, 810 + widthchange, 530 + heightchange)
;      SetGadgetState(#Gadget_SplitterGadget, 104)
      UpdateStatusBar(#StatusBar_FlashGetCompare)
      NewStatusBarWidth = WindowWidth()                               ; Get new width
      SendMessage_(hStatusBar, #SB_GETPARTS, 3, @StatusBarFields())   ; 4 is the number of Fields in the StatusBar
      For i = 0 To 2                                                  ; 3 is number of Fields-1, because Array goes from 0 to 3
        StatusBarFields(i) = StatusBarFields(i) + (NewStatusBarWidth - OldStatusBarWidth)
      Next i
      SendMessage_(hStatusBar, #SB_SETPARTS, 3, @StatusBarFields())      
      OldStatusBarWidth = NewStatusBarWidth                           ; New Width will be old next time
      RedrawWindow_(WindowID(#Window_FlashGetCompare), 0, 0, #RDW_INVALIDATE)
      UpdateStatusBar(#StatusBar_FlashGetCompare)
      ReturnValue = 1
  EndSelect
  
  ProcedureReturn  ReturnValue
  
EndProcedure

;===========================================================================================================================================
; Custom routine to set statusbar messages to save typing
;===========================================================================================================================================

Procedure StatMess(Field.l, Message.s)

StatusBarText(#StatusBar_FlashGetCompare, Field.l, Message.s)

EndProcedure

;===========================================================================================================================================
; Flush window events to prevent hanging and greying out of objects
;===========================================================================================================================================

Procedure FlushEvents()

  While WindowEvent() : Wend
  
EndProcedure

;===========================================================================================================================================
; Set the current day and date to the window title area
;===========================================================================================================================================

Procedure SetDate()

  newDate.dateStructure
  GetSystemTime_(@newDate)
  weekDay.b = newDate\DayOfWeek
  day.b     = newDate\Day
  month.b   = newDate\Month
  year.w    = newDate\Year

  currentdate.s = nameOfDay(weekDay) + ", " + addDateSuffix(Str(day)) + ", " + nameOfMonth(month - 1) + ", " + Str(year)
  
  SetWindowText_(WindowID(#Window_FlashGetCompare), #ProgramVersion + " - " + currentdate.s)

EndProcedure

;===========================================================================================================================================
; Add date suffix to date figure
;===========================================================================================================================================

Procedure.s addDateSuffix(date.s)

  If date = "1" Or date = "21" Or date = "31"
    date = date+"st"
  ElseIf date = "2" Or date = "22"
    date = date+"nd"
  ElseIf date = "3" Or date = "23"
    date = date+"rd"
  Else
    date = date+"th"
  EndIf

  ProcedureReturn date

EndProcedure

;===========================================================================================================================================
; Cataloge files and populate the display
;===========================================================================================================================================

MakeCatalogue:

  CompareFlag = 0
  
  ClearList(dir.s())

  drive.s   = PathRequester("Please select the drive and directory to catalogue", "")
  
  If drive.s = ""
    Return
  EndIf
    
  If Right(drive.s, 1) = "\"
    drive.s = Left(drive.s, Len(drive.s) - 1)
  EndIf

  ClearGadgetItemList(#Gadget_FlashGetCompare_filelist)
  
  AddElement(dir())
    
  dir() = drive.s                                                ; (Paul Leischow)
    
  idx = 0
    
  Repeat
    SelectElement(dir(), idx)
    If ExamineDirectory(0, dir(), "*.*")
      path.s = dir() + "\"
      quit = 0
      Repeat
        nextfile = NextDirectoryEntry()
        filename.s = DirectoryEntryName()
        Select nextfile
          Case 0
            quit = 1
          Case 1
            diskfile.s = path + filename.s
            AddGadgetItem(#Gadget_FlashGetCompare_filelist, - 1, diskfile.s)
            FlushEvents()
            StatMess(1, "File(s) " + Str(count))
            SendMessage_(GadgetID(#Gadget_FlashGetCompare_filelist), #LVM_ENSUREVISIBLE, count , 0)
            count + 1
          Case 2
            filename.s = DirectoryEntryName()
            If filename.s <> ".." And filename.s <> "."
              AddElement(dir())
              dir() = path + filename.s
            EndIf
        EndSelect  
      Until quit = 1
    EndIf
    idx + 1
  Until idx > CountList(dir()) - 1

  ClearList(dir.s())

Return

;===========================================================================================================================================
; Parse html catalogue file
;===========================================================================================================================================

ParseHtml:

  CompareFlag = 0
  
  numfound = 0
  
  file.s   = OpenFileRequester("Please Select the directory And file To parse", "", "*.*",0)

  If file.s = ""
    Return
  EndIf
    
  ClearGadgetItemList(#Gadget_FlashGetCompare_htmllist)
  
  If OpenFile(0, file.s) <> 0
    While Eof(0) = 0
    ;-------------------------------------------------------------------------------------------------------
      Temp.s = ReadString()
      Pos    = FindString(Temp.s, "file://", 0)
      
      If Pos <> 0
        FilePos     = FindString(Temp.s, ">", Pos)
        SubString.s = Mid(Temp.s, Pos + 7, FilePos - Pos - 8)
        AddGadgetItem(#Gadget_FlashGetCompare_htmllist, - 1, SubString.s)
        FlushEvents()
        StatMess(2, "Ref(s) " + Str(numfound))
        SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist), #LVM_ENSUREVISIBLE, numfound , 0)
        numfound + 1
      EndIf
    ;-------------------------------------------------------------------------------------------------------
    Wend
  Else
    Return
  EndIf
      
  CloseFile(0)
      
Return

;===========================================================================================================================================
; Compare actual files with database entries, delete matching pairs from the lists
;===========================================================================================================================================

CompareFiles:

  CompareFlag = 0
  
  Files = CountGadgetItems(#Gadget_FlashGetCompare_filelist)
  Lists = CountGadgetItems(#Gadget_FlashGetCompare_htmllist)
  ;-----------------------------------------------------------------------------------------------
  If Files = 0 Or Lists = 0
    Messages("Error", "No files in one or more lists to compare")
    Return
  EndIf
  ;-----------------------------------------------------------------------------------------------
  For ListLoop = 0 To Lists - 1
    ListFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_htmllist, ListLoop, 0)
    SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist), #LVM_ENSUREVISIBLE, ListLoop , 0)
    Gosub LoopDiskFiles
  Next ListLoop
  
  CompareFlag = 1
  
Return

;===========================================================================================================================================
; Loop through disk filenames and delete matches from both lists
;===========================================================================================================================================

LoopDiskFiles:

  For FilesLoop = 0 To Files - 1
    DiskFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_filelist, FilesLoop, 0)
    If DiskFile.s = ListFile.s
      RemoveGadgetItem(#Gadget_FlashGetCompare_htmllist, ListLoop)
      FlushEvents()
      StatMess(2, "Ref(s) " + Str(Lists))
      RemoveGadgetItem(#Gadget_FlashGetCompare_filelist, FilesLoop)
      FlushEvents()
      StatMess(1, "File(s) " + Str(Files))
      Files - 1 : FilesLoop - 1: Lists - 1 : ListLoop - 1
    EndIf
  Next FilesLoop
  
Return

;===========================================================================================================================================
; Save the list of files in the catalogue pane to hard disk
;===========================================================================================================================================

SaveDirectoryList:

  Files = CountGadgetItems(#Gadget_FlashGetCompare_filelist)

  If Files = 0
    Messages("Error", "No files in the list to save!!")
    Return
  EndIf

  DirFileName.s = SaveFileRequester("Directory Listing", "", "Text | *.txt", 0)
  
  If DirFileName.s = ""
    Return
  EndIf
  
  If OpenFile(0, DirFileName.s) <> 0
    For DirLoop = 0 To Files - 1
      DirFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_filelist, DirLoop, 0)
      WriteStringN(DirFile.s)
      SendMessage_(GadgetID(#Gadget_FlashGetCompare_htmllist), #LVM_ENSUREVISIBLE, DirLoop , 0)
    Next DirLoop
    WriteStringN("End of listing")
  EndIf
 
  CloseFile(0)
 
  Messages("Finished", "Directory listing written to disk!!")

Return

;===========================================================================================================================================
; Move files that were unreferenced To somewhere Else
;===========================================================================================================================================

MoveFiles:

  If CompareFlag = 0
    Messages("Error", "No comparison done, cannot move entire filebase!!")
    Return
  EndIf
  
  Files = CountGadgetItems(#Gadget_FlashGetCompare_filelist)

  If Files = 0
    Messages("Error", "No files in the directory list to move!!")
    Return
  EndIf

  MovePath.s = PathRequester("Move Un-Reference files to:", "")
  
  If MovePath.s = ""
    Return
  EndIf

  For MoveLoop = 0 To Files -1
    OriginalFile.s = GetGadgetItemText(#Gadget_FlashGetCompare_filelist, MoveLoop, 0)
    OldFileName.s  = GetFilePart(OriginalFile.s)
    NewPath.s = MovePath.s + OldFileName.s
    StatMess(0, "Moving File: " + OriginalFile.s)    
    CopyFile(OriginalFile.s, NewPath.s)
    DeleteFile(OriginalFile.s)
    RemoveGadgetItem(#Gadget_FlashGetCompare_filelist, MoveLoop)
    FlushEvents()
    MoveLoop - 1  : Files - 1
    NewPath.s = ""
  Next MoveLoop
  
  CompareFlag = 0
  
Return