Sort your Incredimail content

Share your advanced PureBasic knowledge/code with the community.
Frank Smart
New User
New User
Posts: 8
Joined: Wed Jul 20, 2005 2:36 pm

Re: Sort your Incredimail content

Post by Frank Smart »

Hello Fangbeast,
Fangbeast wrote:The Letter styles manager is okay enough to need testing. Anyone in here use IncrediMail who isn't afraid to test?? (EVIL GRIN(c))
Sorry, I wasn't around here for some days... As you know my wife is using IC heavily. I would dare to test it. But as you also know that she will kill me if I delete only one of her letters.

Best,

Frank
PureBasic Version 3.94
PureBasic Version 4.31
PureBasic Version 5.21 LTS

Feel the ..Pure.. Power
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Sort your Incredimail content

Post by Fangbeast »

Removed - Outdated
Last edited by Fangbeast on Thu Mar 18, 2010 2:09 pm, edited 1 time in total.
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Sort your Incredimail content

Post by Fangbeast »

Removed - Outdated
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Sort your Incredimail content

Post by Fangbeast »

**Update**

Backup

Added the ability to backup your incredimail content only (not runtime) to another drive/path. Works out the correct data path on windows 7 or windows xp. Seems to backup okay to network path as well.

When the backup window opens, I elected not to fill the list with files immediately in case there were a huge amount of files, wanted to give the user to back out if they wanted at that point.

First button fetches a list of the files to be backed up. Second button gets the backup dir from the user. Third button runs the backup job.

These files are not added to the catalogue as that would produce too many duplicates, you must run it manually on the backup directory but I wouldn't bother personally.

Tool tips

I finally got around to adding tool tips to all the windows that were missing them.

To do

Basic security to move/delete functions to prevent people killing anything in their installed incredimail directories. Sooner or later.

Link in first post as usual
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Sort your Incredimail content

Post by Fangbeast »

These are the changes in the current release. To be honest, i can't remember everything I did, added, removed, fixed and changed. But it is as up to date as I can think of and the help file is now linked and fully updated. Link is in the first post as usual.
--------------------------------------------------------------------------------
01/04/2010 v0.00.00


Added You cannot delete a content file from a system data directory.

Added You cannot move a content file from a system data directory. The drag from and drag to paths are checked and disallowed files are ignored and a message raised in the status bar.

Added Sorting from a set of directories to a target in the form of root target / item type / category name / collection name / file name. You will not be able to sort from system data directories.

Added In the directory fetchers for the sort routine, you will be warned when selecting system directories and the operation will be disallowed.

Added Each submodule redirects file counters to their own forms rather than the main form, makes it easier to see what is going on.

Fixed The statusbars resize corerctly thanks to Arctic Fox's suggestions. I had no clue to the math:):)

Added The main screen clock is now asynchronous!!

Changed The way I was searching for IncrediMail content to backup has been replaced and the code slimmed down. Yay!

Fixed Some of the function toggle code was inoperative.

Removed The logos were taking up too much space in each form.

Added Some forms were missing tooltips.

Changed Some form status messages were too large and took up too much space.

Changed Catalogue form mirrors the window title and catalogue path to the status bar. This is also updated each time you change the directory to catalogue.

Changed All database transactions use "begin transaction" and "Commit" to drastically speed up operations. My 66,000 files took only 5 minutes to catalogue and it was very disk intensive.

Added Help buttons added to every form.

Added Help shortcuts added to every form.

Added SQL search types added to search form.

Fixed Statusbar record field was missing. Forgot to include a field in the resize.

Fixed Listing a directory of content now shows the correct count.

Fixed Counters for all modules were fixed.

Fixed No forms grey out any more. Slower but more reliable.

Changed File counters and operations from the various forms are not redirected to the main form underneath but to themselves. made more sense.

Changed When windows are opened on the main form, the statusbar is notified of the action and the window.
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Sort your Incredimail content

Post by Fangbeast »

Back in 2012, I made a very basic sorter and cataloguer but a few years later, a hard disk crash lost my 85,000 letter styles.

I bought the cataloguer/sorter part up to 2017 specifications and it works fine on Windows 10 Pro 1709.16299.125 and PB 5.61 x86.

Do not try it under the latest Windows 10 RS4 branches as the API's have changed and nobody know how or why!!

I only managed to download around 16,000 styles this time as most sites seem to have disappeared by now, wish I could find more.

The code below need a few small button graphics and I am too hot and lazy to get them for you!!!

If anyone could point me towards many more thousands of Incredimail stationery (Letters, ecards etc), I'd be grateful as I have exhausted ll the links that I have found.

Part 1 of 2

Code: Select all

; Setup the database technology that we will be using

UseSQLiteDatabase()                                                                                    ; Use the SQlite database format

; Standard system definitions (Visual designer created constants and windows below)

UsePNGImageDecoder()

Define EventID, MenuID, GadgetID, WindowID

Enumeration 1
  #Window_iSortiCat
EndEnumeration

#WindowIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  ; Window_iSortiCat
  #Gadget_iSortiCat_fmain
  #Gadget_iSortiCat_litemname
  #Gadget_iSortiCat_itemname
  #Gadget_iSortiCat_litemtype
  #Gadget_iSortiCat_itemtype
  #Gadget_iSortiCat_litemcategory
  #Gadget_iSortiCat_itemcategory
  #Gadget_iSortiCat_litemcollection
  #Gadget_iSortiCat_itemcollection
  #Gadget_iSortiCat_litemdisplay
  #Gadget_iSortiCat_itemdisplay
  #Gadget_iSortiCat_litemstatus
  #Gadget_iSortiCat_itemstatus
  #Gadget_iSortiCat_litmenumber
  #Gadget_iSortiCat_itmenumber
  #Gadget_iSortiCat_lcopystatus
  #Gadget_iSortiCat_copystatus
  #Gadget_iSortiCat_fpicture
  #Gadget_iSortiCat_iicat
  #Gadget_iSortiCat_fsourcepath
  #Gadget_iSortiCat_lsourcepath
  #Gadget_iSortiCat_sourcepath
  #Gadget_iSortiCat_fsortpath
  #Gadget_iSortiCat_lsortpath
  #Gadget_iSortiCat_sortpath
  #Gadget_iSortiCat_fpaths
  #Gadget_iSortiCat_sortfromdir
  #Gadget_iSortiCat_sorttodir
  #Gadget_iSortiCat_frun
  #Gadget_iSortiCat_rundir
  #Gadget_iSortiCat_foptions
  #Gadget_iSortiCat_move
  #Gadget_iSortiCat_copy
  #Gadget_iSortiCat_database
  #Gadget_iSortiCat_fexit
  #Gadget_iSortiCat_exit
EndEnumeration

#GadgetIndex = #PB_Compiler_EnumerationValue

Enumeration 1
  #StatusBar_iSortiCat
EndEnumeration

#StatusBarIndex = #PB_Compiler_EnumerationValue

#StatusBar_iSortiCat_micon    = 0
#StatusBar_iSortiCat_messages = 1

Enumeration 1
  #Image_iSortiCat_iicat
  #Image_iSortiCat_sortfromdir
  #Image_iSortiCat_sorttodir
  #Image_iSortiCat_rundir
  #Image_iSortiCat_exit
EndEnumeration

#ImageIndex = #PB_Compiler_EnumerationValue

CatchImage(#Image_iSortiCat_iicat,        ?_OPT_iSortiCat_iicat)
CatchImage(#Image_iSortiCat_sortfromdir,  ?_OPT_iSortiCat_sortfromdir)
CatchImage(#Image_iSortiCat_sorttodir,    ?_OPT_iSortiCat_sorttodir)
CatchImage(#Image_iSortiCat_rundir,       ?_OPT_iSortiCat_rundir)
CatchImage(#Image_iSortiCat_exit,         ?_OPT_iSortiCat_exit)

DataSection
  _OPT_iSortiCat_iicat:       : IncludeBinary "Images\nopicture.png"
  _OPT_iSortiCat_sortfromdir: : IncludeBinary "Images\open.png"
  _OPT_iSortiCat_sorttodir:   : IncludeBinary "Images\AddFile.ico"
  _OPT_iSortiCat_rundir:      : IncludeBinary "Images\run.ico"
  _OPT_iSortiCat_exit:        : IncludeBinary "Images\Exit.png"
EndDataSection

Procedure.i Window_iSortiCat()
  If OpenWindow(#Window_iSortiCat, 263, 84, 561, 490, "", #PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered|#PB_Window_Invisible)
      FrameGadget(#Gadget_iSortiCat_fmain, 5, 0, 385, 260, "")
      TextGadget(#Gadget_iSortiCat_litemname, 15, 20, 110, 20, "Item name", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_litemname, LoadFont(#Gadget_iSortiCat_litemname, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_itemname, 125, 15, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_itemname, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_itemname, LoadFont(#Gadget_iSortiCat_itemname, "Arial", 10, 0))
      TextGadget(#Gadget_iSortiCat_litemtype, 15, 50, 110, 20, "Item type", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_litemtype, LoadFont(#Gadget_iSortiCat_litemtype, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_itemtype, 125, 45, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_itemtype, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_itemtype, LoadFont(#Gadget_iSortiCat_itemtype, "Arial", 10, 0))
      TextGadget(#Gadget_iSortiCat_litemcategory, 15, 80, 110, 20, "Item category", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_litemcategory, LoadFont(#Gadget_iSortiCat_litemcategory, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_itemcategory, 125, 75, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_itemcategory, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_itemcategory, LoadFont(#Gadget_iSortiCat_itemcategory, "Arial", 10, 0))
      TextGadget(#Gadget_iSortiCat_litemcollection, 15, 110, 110, 20, "Item collection", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_litemcollection, LoadFont(#Gadget_iSortiCat_litemcollection, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_itemcollection, 125, 105, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_itemcollection, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_itemcollection, LoadFont(#Gadget_iSortiCat_itemcollection, "Arial", 10, 0))
      TextGadget(#Gadget_iSortiCat_litemdisplay, 15, 140, 110, 20, "Item display", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_litemdisplay, LoadFont(#Gadget_iSortiCat_litemdisplay, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_itemdisplay, 125, 135, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_itemdisplay, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_itemdisplay, LoadFont(#Gadget_iSortiCat_itemdisplay, "Arial", 10, 0))
      TextGadget(#Gadget_iSortiCat_litemstatus, 15, 170, 110, 20, "Item status", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_litemstatus, LoadFont(#Gadget_iSortiCat_litemstatus, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_itemstatus, 125, 165, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_itemstatus, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_itemstatus, LoadFont(#Gadget_iSortiCat_itemstatus, "Arial", 10, 0))
      TextGadget(#Gadget_iSortiCat_litmenumber, 15, 200, 110, 20, "Item number", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_litmenumber, LoadFont(#Gadget_iSortiCat_litmenumber, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_itmenumber, 125, 195, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_itmenumber, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_itmenumber, LoadFont(#Gadget_iSortiCat_itmenumber, "Arial", 10, 0))
      TextGadget(#Gadget_iSortiCat_lcopystatus, 15, 230, 110, 20, "Copy status", #PB_Text_Center)
        SetGadgetFont(#Gadget_iSortiCat_lcopystatus, LoadFont(#Gadget_iSortiCat_lcopystatus, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_copystatus, 125, 225, 255, 25, "", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetColor(#Gadget_iSortiCat_copystatus, #PB_Gadget_BackColor, $FFFFFF)
        SetGadgetFont(#Gadget_iSortiCat_copystatus, LoadFont(#Gadget_iSortiCat_copystatus, "Arial", 10, 0))
      FrameGadget(#Gadget_iSortiCat_fpicture, 395, 0, 160, 260, "")
      ImageGadget(#Gadget_iSortiCat_iicat, 400, 10, 150, 245, ImageID(#Image_iSortiCat_iicat))
      ResizeGadget(#Gadget_iSortiCat_iicat, 400, 10, 150, 245)
      ResizeImage(#Image_iSortiCat_iicat, 150, 245)
      SetGadgetState(#Gadget_iSortiCat_iicat, ImageID(#Image_iSortiCat_iicat))
      FrameGadget(#Gadget_iSortiCat_fsourcepath, 5, 260, 550, 65, "")
      TextGadget(#Gadget_iSortiCat_lsourcepath, 15, 275, 530, 18, " Path to sort IncrediMail(tm) from..")
        SetGadgetColor(#Gadget_iSortiCat_lsourcepath, #PB_Gadget_BackColor, $FF8080)
        SetGadgetFont(#Gadget_iSortiCat_lsourcepath, LoadFont(#Gadget_iSortiCat_lsourcepath, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_sourcepath, 15, 297, 530, 20, "D:\bangf\Downloads\Email Stationery\Incredimail\", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetFont(#Gadget_iSortiCat_sourcepath, LoadFont(#Gadget_iSortiCat_sourcepath, "Arial", 10, 0))
      FrameGadget(#Gadget_iSortiCat_fsortpath, 5, 325, 550, 65, "")
      TextGadget(#Gadget_iSortiCat_lsortpath, 15, 340, 530, 18, " Path to sort IncrediMail(tm) to..")
        SetGadgetColor(#Gadget_iSortiCat_lsortpath, #PB_Gadget_BackColor, $FF8080)
        SetGadgetFont(#Gadget_iSortiCat_lsortpath, LoadFont(#Gadget_iSortiCat_lsortpath, "Arial", 10, 256))
      StringGadget(#Gadget_iSortiCat_sortpath, 15, 362, 530, 20, "D:\SortedIncrediMail\", #PB_String_ReadOnly|#PB_String_BorderLess)
        SetGadgetFont(#Gadget_iSortiCat_sortpath, LoadFont(#Gadget_iSortiCat_sortpath, "Arial", 10, 0))
      FrameGadget(#Gadget_iSortiCat_fpaths, 5, 390, 100, 70, "")
      ButtonImageGadget(#Gadget_iSortiCat_sortfromdir, 15, 410, 40, 40, ImageID(#Image_iSortiCat_sortfromdir))
      ButtonImageGadget(#Gadget_iSortiCat_sorttodir, 55, 410, 40, 40, ImageID(#Image_iSortiCat_sorttodir))
      FrameGadget(#Gadget_iSortiCat_frun, 110, 390, 60, 70, "")
      ButtonImageGadget(#Gadget_iSortiCat_rundir, 120, 410, 40, 40, ImageID(#Image_iSortiCat_rundir))
      FrameGadget(#Gadget_iSortiCat_foptions, 175, 390, 315, 70, "")
      OptionGadget(#Gadget_iSortiCat_move, 185, 410, 135, 20, "Move while sorting!!")
        SetGadgetFont(#Gadget_iSortiCat_move, LoadFont(#Gadget_iSortiCat_move, "Arial", 10, 0))
      OptionGadget(#Gadget_iSortiCat_copy, 185, 435, 135, 15, "Copy while sorting")
        SetGadgetFont(#Gadget_iSortiCat_copy, LoadFont(#Gadget_iSortiCat_copy, "Arial", 10, 0))
      CheckBoxGadget(#Gadget_iSortiCat_database, 340, 415, 140, 15, "Add to database")
        SetGadgetFont(#Gadget_iSortiCat_database, LoadFont(#Gadget_iSortiCat_database, "Arial", 10, 0))
      FrameGadget(#Gadget_iSortiCat_fexit, 495, 390, 60, 70, "")
      ButtonImageGadget(#Gadget_iSortiCat_exit, 505, 410, 40, 40, ImageID(#Image_iSortiCat_exit))
      CreateStatusBar(#StatusBar_iSortiCat, WindowID(#Window_iSortiCat))
        AddStatusBarField(25)
        AddStatusBarField(535)
      HideWindow(#Window_iSortiCat, 0)
    ProcedureReturn WindowID(#Window_iSortiCat)
  EndIf
EndProcedure

; Custom program modules

Declare   CheckGagdetState(GadgetName.i)                                                ; Check the state of some of the gadgets on this form
Declare.s KillBadChars(DirtyString.s)                                                   ; Replace bad characters in an Incredimail cat and sub-cat string
Declare   SetStat(Flag.i, Message.s = #Empty$)                                          ; Handle statusbar messages with less typing.

; Database handling

Declare.s CountRecords(Query.s)                                                         ; Count the number of records in an SQLite database
Declare.s DatabaseLastInsertRowId()                                                     ; Get the ID of the last inserted record
Declare.s KillQuote(Instring.s)                                                         ; Kill double quotes in strings for display purposes
Declare   OpenSystemDatabase()                                                          ; Try to open the system database and create missing tables
Declare.s RepQuote(Instring.s)                                                          ; Uncle Berikco's routine to properly replace single quotes with double for SQL passing

; Generic modules that can be used by any routine

Declare.s AddDateSuffix(Date.s)                                                         ; Adds a alpha suffix to the end of a numeral 'date', not used in some countries
Declare   CleanDirectory(Directory.s)                                                   ; Clean a directory and all of its files no matter what attribute they have
Declare.s GetIniVal(IniSection.s, IniKey.s, IniFile.s)                                  ; API procedure to replace Mr Skunk's INI file reading routine
Declare   LastLine(Gadget.i, LineNumber.i)                                              ; Go to the last line of a ListIconGadget
Declare.s MakeSureDirectoryPathExists(Directory.s)                                      ; Need a unicode aware version of the API directory creator
Declare   MyBalloonToolTips(btWindow.i, btGadget.i, btText.s)                           ; Personal balloon tooltip window, colourful and not boring at all
Declare   SetIniVal(IniSection.s, IniKey.s, IniValue.s, IniFile.s)                      ; PB procedure to shorten INI file handling
Declare   SetDate(Windowid.i)                                                           ; Sort out the date And display it

; Data processing

Declare   GetSortFromDir()                                                              ; Get the target directory to sort from
Declare   GetSortToDir()                                                                ; Get the target directory to sort from
Declare   RunSortJob()                                                                  ; Check runtime parameters and run the job if okay
Declare   SearchEngine(SearchDir.s)                                                     ; Universal, recursive search engine
Declare   SortIncrediFile(FullFilename.s, MoveContent.s, Counter.s)                     ; Copy the file to the target directory

; Preference file handling

Declare   CreatePreferencesFile()                                                       ; Create a brand new INI file in the program directory if the default one is missing, with default values.
Declare   ReadPreferencesFile()                                                         ; Read the system preferences file or create it if missing
Declare   SavePreferencesFile()                                                         ; Read the system preferences file or create it if missing

; Microsoft CABinet compressed file handling. In this case, all Incredimail stationery

Declare   CAB_List_Callback(Context.l, Notification.l, Param1.l, Param2.l)              ; 
Declare   CAB_Extract_Callback(Context.l, Notification.l, Param1.l, Param2.l)           ; 
Declare   CAB_Extract(ArchiveName.s, ExtractPath.s)                                     ; 
Declare   CAB_List(ArchiveName.s, ExtractPath.s)                                        ; 

; Need a unicode aware version of the API directory creator for database directory, temporary directory and maybe others

Import "shell32.lib"                                                                                 ; Import 32 bit shell library
  SHCreateDirectory(*hwnd, pszPath.p-unicode)                                                         ; Grab the function that you want
EndImport                                                                                            ; End function import

; CAB file operation continuance flag

#FILEOP_DOIT                    = 1                                                                   ; 
#FILEOP_SKIP                    = 2                                                                   ; 

; Constants for statusbar handling and colouring

#SB_SETBKCOLOR                  = $2001                                                               ; Statusbar colour constant

; My personal constants

#Author                         = "Miklós G Bolváry"                                                  ; Author's name
#CopyRight                      = "MGB Technical Services 2012"                                       ; Copyright holder
#Version                        = "v1.00"                                                             ; Program version
#Regstring                      = " --* Freeware *-- "                                                ; Registration string
#Program                        = "iSortiCat(c) " + #Version + #Regstring                             ; Name and version of the program
#Database                       = "iSortiCat" + #Version + ".MGB"                                     ; Name of the database with version string
#Eol                            = #CRLF$                                                              ; End of line marker

; 

Structure FILE_IN_CABINET_INFO                                                                       ; 
  NameInCabinet.l                                                                                     ; 
  FileSize.l                                                                                          ; 
  Win32Error.l                                                                                        ; 
  DosDate.w                                                                                           ; 
  DosTime.w                                                                                           ; 
  DosAttribs.w                                                                                        ; 
  FullTargetName.s{260}                                                                               ; 
EndStructure                                                                                         ; 

; Tooltip structure data

Structure ToolTipData                                                                                ; If any tooltips setup, leep track of gadgets that have them so you can remove them if needed
  Window.i                                                                                            ; 
  Gadget.i                                                                                            ; 
  Handle.i                                                                                            ; 
EndStructure                                                                                         ; 

; Custom date routine structure

Structure DateStructure                                                                              ; Custom date routine
  Year.w                                                                                              ; 
  Month.w                                                                                             ; 
  DayOfWeek.w                                                                                         ; 
  Day.w                                                                                               ; 
  Hour.w                                                                                              ; 
  Minute.w                                                                                            ; 
  Second.w                                                                                            ; 
  Milliseconds.w                                                                                      ; 
EndStructure                                                                                         ; 

; All Icat letter data

Structure LetterStructure
  ; Version
  Version.s	                                                                                          ; [Version] 		    Number=4.0
  ; General
  Id.s		                                                                                            ; [General] 		    ID=E3C99062-1823-11D908270-0030DA2ED364
  File.s	                                                                                            ; [General] 		    File=buena_suerte.imf
  Type.s	                                                                                            ; [General] 		    Type=Letter
  Category.s	                                                                                        ; [General] 		    Category=Sin título
  Collection.s	                                                                                      ; [General] 		    Collection=La bruji designs
  Display.s	                                                                                          ; [General] 		    Display=buena suerte
  Thumbnail.s                                                                                         ; [General] 		    Thumbnail=flooble.jpg
  ; $/
  Background.s                                                                                        ; [$/] 		          Background=suerte.jpg
  Replace.s                                                                                           ; [Replace]         SOME~233.MID
  ; HTML
  HTMLCode.s                                                                                          ; [HTML]           <A href='_INCREDIMAIL_REPLACE_FILE_NAME_' ID='IncrediSound'> <IMG src='INCREDISOUNDIMAGE' 
  Title.s                                                                                             ; [HTML]           'INCREDISOUNDTOOLTIP' border=0></A>
  ; Depend
  Depend0.s                                                                                           ; [Depend]		      id0=BCEB29C0-42D3-11D4-BA3E-0050DAC68030
  Depend1.s                                                                                           ; [Depend]		      id1=2D6C0820-4542-11D4-BA40-0050DAC68030
  Depend2.s                                                                                           ; [Depend]		      id2=26D63310-3EFD-11D4-BA3D-0050DAC68030
  ; X-Extensions
  IMBL1.s                                                                                             ; [X-Extensions]    IMBL1=II$4…0‰ÅʼnMÁ™•…M‰8…0•04M,™0…,,8…I
  IMBL2.s                                                                                             ; [X-Extensions]    IMBL2=
  IMBL3.s                                                                                             ; [X-Extensions]    IMBL3=
  TradeMarkLink.s                                                                                     ; [X-Extensions]	  TradeMarkLink=http://ciberia.ya.com/brujixx
  TradeMark2.s                                                                                        ; [TradeMark]		    By the original artist
  ; LetterCreator
  LcBuild.s                                                                                           ; [LetterCreator]   LcBuild=2501361
  ; Trademark
  Trademark.s                                                                                         ; [TradeMark]		    TradeMark=© La bruji designs
  ; Charsets
  CategoryCharset.s                                                                                   ; [Charsets]        CategoryCharset=iso-8859-1
  TradeMarkCharset.s                                                                                  ; [Charsets]        TradeMarkCharset=iso-8859-1
  ; Directory
  Directory.s                                                                                         ;                   Where the file was found
EndStructure

; Program data structure

Structure ProgramData                                                                                ; Program data structure
  ProgQuit.l                                                                                          ; User quit the program, so set the quit value to allow program to end repeat loop
  
  TemporaryDirectory.s                                                                                ; Get the system temporary directory  
  CurrentDirectory.s                                                                                  ; Current program startup directory
  LastDirectory.s                                                                                     ; Last directory that the user moved files from
  
  InitialisationFile.s                                                                                ; The program.ini file to read
  ContentIniFile.s                                                                                    ; The content.ini file to read
  DatabaseName.s                                                                                      ; Path and name of the database
  DatabaseHandle.i                                                                                    ; The database handle

  CurrentDate.s                                                                                       ; The current system date as a string
  CurrentLine.i                                                                                       ; The current line in the display
  
  SortFromDirectory.s                                                                                 ; Directory to sort from
  SortToDirectory.s                                                                                   ; Directory to sort to
  MoveContent.s                                                                                       ; Move or copy content file
  MoveBadFile.s                                                                                       ; Move or copy bad file
  WriteToDatabase.s                                                                                   ; Write to database or not
EndStructure

; All global variables

Global Letter.LetterStructure                                                                         ; Letter data structure
Global Program.ProgramData                                                                            ; All program data structures

Global NewList FoundDirectories.s()                                                                  ; List of dirs found by the search engine
Global NewList ToolTips.ToolTipData()                                                                ; All tool tip handles and data here
Global NewList CabinetMembers.s()                                                                    ; CABinet file member names

Global td.SYSTEMTIME                                                                                  ; This is used as interface for time and date conversions
Global BadChars.s            = "~!@#$%^*()_+`-={}|[]\:" + Chr(34) + ";<>?,/"                          ; List of disallowed chars in cat/subcats

; 

Program\CurrentDate           = FormatDate("%dd/%mm/%yyyy", Date())                                   ; The current system date as a string

; Get current working program directory and store it for later

Program\CurrentDirectory.s    = GetCurrentDirectory()                                                 ; Find the current directory
Program\TemporaryDirectory.s  = GetTemporaryDirectory() + "MGB Technical Services\Icat\"              ; Get system temporary directory

; Reference the content file from which we get the incredimail information

Program\InitialisationFile    = Program\CurrentDirectory    + "iSortIcat.ini"                         ; Set the icatisort ini file
Program\ContentIniFile        = Program\TemporaryDirectory  + "content.ini"                           ; Set the incredimail ini file
Program\DatabaseName          = Program\CurrentDirectory    + #Database                               ; Name and path to the database

; Read startup preferences.

ReadPreferencesFile()                                                                                 ; 

; 

MakeSureDirectoryPathExists(Program\TemporaryDirectory)                                               ; Create the path if it doesn't exist
MakeSureDirectoryPathExists(Program\SortFromDirectory)                                                ; Create the path if it doesn't exist
MakeSureDirectoryPathExists(Program\SortToDirectory)                                                  ; Create the path if it doesn't exist

; Setup day and month literal names

Global Dim NameOfDay.s(7)                                                                             ; Fill an array with the names of the days (Terry Hough I think)

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

Global 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

Global 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"

Global 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"

; All my image constants

Enumeration #ImageIndex
  #Image_iSortiCat_messages                                                                           ; Statusbar message field
EndEnumeration

; Catch images from memory

CatchImage(#Image_iSortiCat_messages,     ?_MGB_iSortiCat_messages)                                   ; messages16x16.ico

; Include images in the exe file

DataSection
  _MGB_iSortiCat_messages:    : IncludeBinary "Images\_16x16\messages.ico"                            ; 
EndDataSection

; Custom program modules

; Check the state of some of the gadgets on this form

Procedure CheckGagdetState(GadgetName.i)
  Select GadgetName.i
    Case  #Gadget_iSortiCat_move
      If GetGadgetState(#Gadget_iSortiCat_move) = #True
        Program\MoveContent = "M"
      EndIf
    Case  #Gadget_iSortiCat_copy
      If GetGadgetState(#Gadget_iSortiCat_copy) = #True
        Program\MoveContent = "C"
      EndIf
    Case  #Gadget_iSortiCat_database
      If GetGadgetState(#Gadget_iSortiCat_database) = #True
        Program\WriteToDatabase = "Y"
      ElseIf GetGadgetState(#Gadget_iSortiCat_database) = #False
        Program\WriteToDatabase = "N"
      EndIf
  EndSelect
EndProcedure

; Replace bad characters in an Incredimail cat and sub-cat string

Procedure.s KillBadChars(DirtyString.s)
  If DirtyString.s <> #Empty$
    For BadLoop.i = 1 To Len(BadChars.s)
      DirtyString.s = ReplaceString(DirtyString.s, Mid(BadChars.s, BadLoop.i, 1), " ", #PB_String_NoCase)
    Next
  Else
    DirtyString.s = "Default"
  EndIf
  ProcedureReturn LTrim(RTrim(DirtyString.s))
EndProcedure

; Handle statusbar messages with less typing.

Procedure SetStat(Flag.i, Message.s = #Empty$)
  If Flag.i = 1
    StatusBarText(#StatusBar_iSortiCat, #StatusBar_iSortiCat_messages, "Info: " + Message.s, #PB_StatusBar_BorderLess)
  ElseIf Flag.i = 2
    StatusBarText(#StatusBar_iSortiCat, #StatusBar_iSortiCat_messages, "Error: " + Message.s, #PB_StatusBar_BorderLess)
  EndIf
EndProcedure

; Database handling

; Count the number of records in an SQLite database

Procedure.s CountRecords(Query.s)
  If DatabaseQuery(Program\DatabaseHandle, Query.s) <> #False
    While NextDatabaseRow(Program\DatabaseHandle)
      Records.s = GetDatabaseString(Program\DatabaseHandle, 0)
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle)
    ProcedureReturn Records.s
  EndIf
EndProcedure

; Get the ID of the last inserted record

Procedure.s DatabaseLastInsertRowId()
  If DatabaseQuery(Program\DatabaseHandle.i, "SELECT last_insert_rowid()") <> #False
    While NextDatabaseRow(Program\DatabaseHandle.i)
      RecordId.s = GetDatabaseString(Program\DatabaseHandle.i, 0)
    Wend
    FinishDatabaseQuery(Program\DatabaseHandle.i)
    ProcedureReturn RecordId.s
  EndIf
EndProcedure

; Kill double quotes in strings for display purposes

Procedure.s KillQuote(Instring.s)
  ProcedureReturn ReplaceString(Instring.s, "''", "'", 1, 1)
EndProcedure

; Try to open the system database and create missing tables

Procedure OpenSystemDatabase()
  DatabaseFileHandle.i = OpenFile(#PB_Any, Program\DatabaseName)
  If DatabaseFileHandle.i
    CloseFile(DatabaseFileHandle.i)
    Program\DatabaseHandle = OpenDatabase(#PB_Any, Program\DatabaseName, #Empty$, #Empty$)
    If Program\DatabaseHandle
      UpdateString.s = "CREATE TABLE IF NOT EXISTS icatisort("                                                     + 
                       "fullpath TEXT CONSTRAINT fullpath UNIQUE, version TEXT, id TEXT, file TEXT, type TEXT, "   + 
                       "category TEXT, collection TEXT, display TEXT, depend0 TEXT, depend1 TEXT, depend2 TEXT, "  + 
                       "trademarklink TEXT, lcbuild TEXT, trademark TEXT, trademark2 TEXT, status TEXT, "          + 
                       "record INTEGER PRIMARY KEY AUTOINCREMENT)"
      If DatabaseUpdate(Program\DatabaseHandle, UpdateString.s)
      EndIf
    Else
      MessageRequester("Database open error", "There was a serious problem attempting to connect to the system database, try another one", #PB_MessageRequester_Ok)
    EndIf 
  Else
    MessageRequester("Database open error", "There was a serious problem attempting to open the system database, try another one", #PB_MessageRequester_Ok)
  EndIf
EndProcedure
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
User avatar
Fangbeast
PureBasic Protozoa
PureBasic Protozoa
Posts: 4789
Joined: Fri Apr 25, 2003 3:08 pm
Location: Not Sydney!!! (Bad water, no goats)

Re: Sort your Incredimail content

Post by Fangbeast »

Part 2 of 2

Code: Select all

; Uncle Berikco's routine to properly replace single quotes with double for SQL passing

Procedure.s RepQuote(Instring.s)
  For i = 1 To Len(Instring.s)
    If Mid(Instring.s, i, 1) = "'"
      TemporaryString.s = TemporaryString.s + "''"
    Else
      TemporaryString.s = TemporaryString.s + Mid(Instring.s, i, 1)
    EndIf
  Next i
  ProcedureReturn TemporaryString.s
EndProcedure

; Generic modules that can be used by any routine

; Adds an alpha suffix to the end of a numeral 'date', not used in some countries

Procedure.s AddDateSuffix(Date.s)
  Select Date
    Case "1","21","31"
      Date + "'St"
    Case "2","22"
      Date + "'Nd"
    Case "3","23"
      Date + "'Rd"
    Default 
      Date + "'Th"
  EndSelect
  ProcedureReturn Date
EndProcedure

; Clean a directory and all of its files no matter what attribute they have
;
Procedure CleanDirectory(Directory.s)
  DirectoryId.i = ExamineDirectory(#PB_Any, Directory.s, "*.*")  ; Delete previous temporary files
  If DirectoryId.i
    Repeat
      TypeOfFile = NextDirectoryEntry(DirectoryId.i) 
      FileName.s = DirectoryEntryName(DirectoryId.i)
      If TypeOfFile = #PB_DirectoryEntry_File
        SetFileAttributes_(Directory.s + DirectoryEntryName(DirectoryId.i), #FILE_ATTRIBUTE_NORMAL)
        DeleteFile(Directory.s + DirectoryEntryName(DirectoryId.i))
      EndIf 
    Until TypeOfFile = 0 
  EndIf
EndProcedure

; API procedure to replace Mr Skunk's INI file reading routine

Procedure.s GetIniVal(IniSection.s, IniKey.s, IniFile.s)
  ; Open the Ini file for reading
  If OpenPreferences(IniFile.s) <> #False
    ; Go to the right group
    PreferenceGroup(IniSection)
    ; Read a value from the ini file
    IniData.s = ReadPreferenceString(IniKey, #Empty$)
    ; Close the INI file, finished
    ClosePreferences()
    ; Return the data to the calling line
    ProcedureReturn IniData.s
    ; 
  Else
    Debug "Cannot open " + IniFile.s
  EndIf
  ; 
EndProcedure

; Go to the last line of a ListIconGadget

Procedure LastLine(Gadget.i, LineNumber.i)
  SendMessage_(GadgetID(Gadget.i), #LVM_ENSUREVISIBLE, LineNumber.i, 0) ; Make sure the current line is visible
EndProcedure

; Need a unicode aware version of the API directory creator

Procedure.s MakeSureDirectoryPathExists(Directory.s)
  Protected Message.s
  ErrorCode.i = SHCreateDirectory(#Null, Directory.s)
  Select ErrorCode.i
    Case #ERROR_SUCCESS               : Message.s = "Directory created"                            ; ResultCode = 0
    Case #ERROR_BAD_PATHNAME          : Message.s = "Bad directory path"                           ; ResultCode = 161
    Case #ERROR_FILENAME_EXCED_RANGE  : Message.s = "Directory path too long"                      ; ResultCode = 206
    Case #ERROR_FILE_EXISTS           : Message.s = "Directory already exists"                     ; ResultCode = 80
    Case #ERROR_ALREADY_EXISTS        : Message.s = "Directory already exists"                     ; ResultCode = 183
   ;Case #ERROR_CANCELLED             : Message.s = "User cancelled creation"                       ; ResultCode = ??. Not defined in compiler residents
  EndSelect
  ProcedureReturn Message.s
  ; Debug MakeSureDirectoryPathExists("c:\1\2\3\4\5\6")
EndProcedure

; Personal balloon tooltip window, colourful and not boring at all

Procedure MyBalloonToolTips(btWindow.i, btGadget.i, btText.s)
  ForEach ToolTips()
    If ToolTips()\Window = btWindow And ToolTips()\Gadget = btGadget
      ProcedureReturn
    EndIf
  Next
  ToolTipControl = CreateWindowEx_(0, "ToolTips_Class32", #Empty$, #WS_POPUP | #TTS_NOPREFIX | #TTS_BALLOON, 0, 0, 0, 0, WindowID(btWindow), 0, GetModuleHandle_(0), 0)
  SetWindowPos_(ToolTipControl, #HWND_TOPMOST, 0, 0, 0, 0, #SWP_NOMOVE | #SWP_NOSIZE)
  SendMessage_(ToolTipControl,  #TTM_SETTIPTEXTCOLOR, 0, 0)
  SendMessage_(ToolTipControl,  #TTM_SETTIPBKCOLOR, $F58C0A, 0)
  SendMessage_(ToolTipControl,  #TTM_SETMAXTIPWIDTH, 0, 290)
  Button.TOOLINFO\cbSize  = SizeOf(TOOLINFO)
  Button\uFlags           = #TTF_IDISHWND | #TTF_SUBCLASS
  Button\hwnd             = WindowID(btWindow)
  Button\uID              = GadgetID(btGadget)
  Button\hInst            = 0
  Button\lpszText         = @btText
  SendMessage_(ToolTipControl, #TTM_ADDTOOL, 0, Button)
  SendMessage_(ToolTipControl, #TTM_UPDATE, 0, 0)
  AddElement(tooltips())
    ToolTips()\Window = btWindow
    ToolTips()\Gadget = btGadget
    ToolTips()\Handle = ToolTipControl
EndProcedure

; Sort out the date And display it

Procedure SetDate(Windowid.i)
  Dateval.i = Date()
  CurrentDate.s = NameOfDay(DayOfWeek(Dateval.i))     + ", "  + 
                  AddDateSuffix(Str(Day(Dateval.i)))  + " "   + 
                  NameOfMonth(Month(Dateval.i) - 1)   + ", "  + 
                  Str(Year(Dateval.i))
  SetWindowTitle(Windowid.i, #Program + CurrentDate.s)
EndProcedure

; PB procedure to shorten INI file handling

Procedure SetIniVal(IniSection.s, IniKey.s, IniValue.s, IniFile.s)
  If OpenPreferences(IniFile.s)                                                         ; Open the Ini file for reading
    PreferenceGroup(IniSection.s)                                                       ; Go to the right group
    WritePreferenceString(IniKey.s, IniValue.s)                                         ; Write the value to the INI file
    ClosePreferences()                                                                  ; Close the INI file, finished
  Else
    Debug "Cannot open " + IniFile.s + "!!!"
  EndIf
EndProcedure

; Data processing

; Get the target directory to sort from

Procedure GetSortFromDir()
  SortFromDir.s = PathRequester("Directory to sort from", #Empty$)
  If SortFromDir.s
    SetStat(1, "Got new source path for files...")
    SetGadgetText(#Gadget_iSortiCat_sourcepath, SortFromDir.s)
    Program\SortFromDirectory = SortFromDir.s
  EndIf
EndProcedure

; Get the target directory to sort from

Procedure GetSortToDir()
  SortToDirectory.s = PathRequester("Directory to sort to", #Empty$)
  If SortToDirectory.s
    SetStat(1, "Got new sort to dir...")
    SetGadgetText(#Gadget_iSortiCat_sortpath, SortToDirectory.s)
    Program\SortToDirectory = SortToDirectory.s                                                         ; My 'sort to' path
    MakeSureDirectoryPathExists_(Program\SortToDirectory)                                         ; Create the path if it doesn't exist
  EndIf
EndProcedure

; Check runtime parameters and run the job if okay

Procedure RunSortJob()
  If Program\SortFromDirectory And Program\SortToDirectory
    SearchEngine(Program\SortFromDirectory)
  Else
    SetStat(2, "No sort from and sort to directories selected.")
  EndIf
EndProcedure

; Universal, recursive search engine

Procedure SearchEngine(SearchDir.s)
  If GetGadgetState(#Gadget_iSortiCat_copy) = 1
    Program\MoveContent = "C"
  ElseIf GetGadgetState(#Gadget_iSortiCat_move) = 1
    Program\MoveContent = "M"
  EndIf
  ClearList(FoundDirectories.s())
  If SearchDir.s <> #Empty$
    If Right(SearchDir.s, 1) = "\"
      SearchDir.s = Left(SearchDir.s, Len(SearchDir.s) - 1)
    EndIf
    AddElement(FoundDirectories.s())
    FoundDirectories.s() = SearchDir.s
    Index = 0
    Repeat
      SelectElement(FoundDirectories.s(), Index)
      Directory = ExamineDirectory(#PB_Any, FoundDirectories.s(), "*.*")
      If Directory
        Path.s = FoundDirectories.s() + "\"
        While NextDirectoryEntry(Directory)
          Filename.s = DirectoryEntryName(Directory)
          Select DirectoryEntryType(Directory)
            Case 1
              Select LCase(GetExtensionPart(FileName.s))
                Case "ima", "imf", "impt", "ime", "imi", "impa", "imn", "impn", "ims", "imw"
                  Counter.i + 1
                  SortIncrediFile(Path.s + Filename.s, Program\MoveContent, Str(Counter.i))
              EndSelect
            Case 2
              Filename.s = DirectoryEntryName(Directory)
              If Filename.s <> ".." And Filename.s <> "."
                AddElement(FoundDirectories())
                FoundDirectories() = Path + Filename.s
              EndIf
          EndSelect
        Wend
        FinishDirectory(Directory)
      EndIf
      Index + 1
    Until Index > ListSize(FoundDirectories()) -1
  EndIf
EndProcedure

; Copy the file to the target directory

Procedure SortIncrediFile(FullFilename.s, MoveContent.s, Counter.s)
  ; Clean the temporary directory of all previous files
  CleanDirectory(Program\TemporaryDirectory)
  ; Attempt to extract the content file into the temporary directory
  If CAB_Extract(FullFilename.s, Program\TemporaryDirectory) <> #False
    ; Get the details for the directory names from the INI file
    Directory.s   = RepQuote(GetPathPart(FullFilename.s))
    Version.s     = KillBadChars(GetIniVal("Version",        "Number",        Program\ContentIniFile))  ;: Debug Version.s
    Id.s          = KillBadChars(GetIniVal("General",        "ID",            Program\ContentIniFile))  ;: Debug Id.s
    File.s        = KillBadChars(GetIniVal("General",        "File",          Program\ContentIniFile))  ;: Debug File.s
    Type.s        = KillBadChars(GetIniVal("General",        "Type",          Program\ContentIniFile))  ;: Debug Type.s
    Category.s    = KillBadChars(GetIniVal("General",        "Category",      Program\ContentIniFile))  ;: Debug Category.s
    Collection.s  = KillBadChars(GetIniVal("General",        "Collection",    Program\ContentIniFile))  ;: Debug Collection.s
    Display.s     = KillBadChars(GetIniVal("General",        "Display",       Program\ContentIniFile))  ;: Debug Display.s
    Tradelink.s   = KillBadChars(GetIniVal("X-Extensions",   "TradeMarkLink", Program\ContentIniFile))  ;: Debug Tradelink.s
    Background.s  = KillBadChars(GetIniVal("$/",             "Background",    Program\ContentIniFile))  ;: Debug Background.s
    Depend0.s     = KillBadChars(GetIniVal("Depend",         "id0",           Program\ContentIniFile))  ;: Debug Depend0.s
    Depend1.s     = KillBadChars(GetIniVal("Depend",         "id1",           Program\ContentIniFile))  ;: Debug Depend1.s
    Depend2.s     = KillBadChars(GetIniVal("Depend",         "id2",           Program\ContentIniFile))  ;: Debug Depend2.s
    Depend3.s     = KillBadChars(GetIniVal("Depend",         "id3",           Program\ContentIniFile))  ;: Debug Depend3.s
    Depend4.s     = KillBadChars(GetIniVal("Depend",         "id4",           Program\ContentIniFile))  ;: Debug Depend4.s
    Trademark.s   = KillBadChars(GetIniVal("TradeMark",      "TradeMark",     Program\ContentIniFile))  ;: Debug Trademark.s
    Trademark2.s  = KillBadChars(GetIniVal("TradeMark",      "TradeMark2",    Program\ContentIniFile))  ;: Debug Trademark2.s
    Creatorver.s  = KillBadChars(GetIniVal("LetterCreator",  "LcBuild",       Program\ContentIniFile))  ;: Debug Creatorver.s
    GoldId1.s     =              GetIniVal("X-Extensions",   "IMBL1",         Program\ContentIniFile)   ;: Debug GoldId1.s
    GoldId2.s     =              GetIniVal("X-Extensions",   "IMBL2",         Program\ContentIniFile)   ;: Debug GoldId2.s
    GoldId3.s     =              GetIniVal("X-Extensions",   "IMBL3",         Program\ContentIniFile)   ;: Debug GoldId3.s
    ; Setup the database query to add this information
    If Program\WriteToDatabase = "Y"
      DatabaseUpdate.s = "INSERT INTO icatisort("                                     + 
      "directory,   version,        id,       "                                       + 
      "file,        type,           category, "                                       + 
      "collection,  display,        depend0,  "                                       + 
      "depend1,     depend2,        depend3,  "                                       + 
      "depend4,     trademarklink,  lcbuild,  "                                       + 
      "trademark,   trademark2,     status)   "                                       + 
      "VALUES('" +  Directory.s     + "','" + Version.s       + "','" + Id.s          + 
      "','"      +  File.s          + "','" + Type.s          + "','" + Category.s    + 
      "','"      +  Collection.s    + "','" + Display.s       + "','" + Depend0.s     + 
      "','"      +  Depend1.s       + "','" + Depend2.s       + "','" + Depend3.s     + 
      "','"      +  Depend4.s       + "','" + Trademarklink.s + "','" + Lcbuild.s     + 
      "','"      +  Trademark.s     + "','" + Trademark2.s    + "','" + Creatorver.s  + 
      "','"      +  Status.s                                                          + 
      "')"
    EndIf
    ; Check if the file is a normal gallery file or a gold gallery file
    PathSuffix.s = Type.s  + "\" + Category.s + "\" + Collection.s  + "\"
    If GoldId1.s <> #Empty$ And GoldId2.s = #Empty$ And GoldId3.s = #Empty$ And Category.s <> "IM2"
      LetterPath.s  = Program\SortToDirectory + "_User Gallery\" + PathSuffix.s
      SetGadgetText(#Gadget_iSortiCat_itemstatus, "User gallery file")
      SetGadgetColor(#Gadget_iSortiCat_itemstatus, #PB_Gadget_FrontColor, $F0210F)
    ElseIf GoldId1.s <> #Empty$ And GoldId2.s = #Empty$ And GoldId3.s = #Empty$ And Category.s = "IM2"
      LetterPath.s  = Program\SortToDirectory + "_IncrediMail 2 Gallery\" + PathSuffix.s
      SetGadgetText(#Gadget_iSortiCat_itemstatus, "IncrediMail 2 Gallery file")
      SetGadgetColor(#Gadget_iSortiCat_itemstatus, #PB_Gadget_FrontColor, $F0210F)
    ElseIf GoldId1.s <> #Empty$ And GoldId2.s <> #Empty$ And GoldId3.s <> #Empty$
      LetterPath.s  = Program\SortToDirectory + "_Gold Gallery\" + PathSuffix.s
      SetGadgetText(#Gadget_iSortiCat_itemstatus, "Gold gallery file")
      SetGadgetColor(#Gadget_iSortiCat_itemstatus, #PB_Gadget_FrontColor, $2F9CD0)
    Else
      LetterPath.s  = Program\SortToDirectory + "_Uknown Gallery\" + PathSuffix.s
      SetGadgetText(#Gadget_iSortiCat_itemstatus, "Unknown gallery file")
      SetGadgetColor(#Gadget_iSortiCat_itemstatus, #PB_Gadget_FrontColor, $F0210F)
    EndIf
    MakeSureDirectoryPathExists(LetterPath.s)
    While WindowEvent() : Wend
    SetGadgetText(#Gadget_iSortiCat_itemname,         File.s)
    SetGadgetText(#Gadget_iSortiCat_itemtype,         Type.s)
    SetGadgetText(#Gadget_iSortiCat_itemcategory,     Category.s)
    SetGadgetText(#Gadget_iSortiCat_itemcollection,   Collection.s)
    SetGadgetText(#Gadget_iSortiCat_itemdisplay,      Display.s)
    SetGadgetText(#Gadget_iSortiCat_itmenumber,       Counter)
    Select MoveContent.s
      Case "M"
        If RenameFile(FullFilename.s, LetterPath.s + File.s)
          SetGadgetText(#Gadget_iSortiCat_copystatus, File.s + " moved okay.")
          SetGadgetColor(#Gadget_iSortiCat_copystatus, #PB_Gadget_FrontColor, $81CD7E)
        Else
          SetGadgetText(#Gadget_iSortiCat_copystatus, File.s + " not moved.")
          SetGadgetColor(#Gadget_iSortiCat_copystatus, #PB_Gadget_FrontColor, $0409FB)
        EndIf
      Case "C"
        If CopyFile(FullFilename.s, LetterPath.s + File.s)
          SetGadgetText(#Gadget_iSortiCat_copystatus, File.s + " copied okay.")
          SetGadgetColor(#Gadget_iSortiCat_copystatus, #PB_Gadget_FrontColor, $81CD7E)
        Else
          SetGadgetText(#Gadget_iSortiCat_copystatus, File.s + " not copied.")
          SetGadgetColor(#Gadget_iSortiCat_copystatus, #PB_Gadget_FrontColor, $0409FB)
        EndIf
    EndSelect
  Else
    SetGadgetText(#Gadget_iSortiCat_itemstatus, "Cannot decompress " + File.s)
    SetGadgetColor(#Gadget_iSortiCat_itemstatus, #PB_Gadget_FrontColor, $F0210F)
  EndIf
EndProcedure

; Preference file handling

; Create a brand new INI file in the program directory if the default one is missing, with default values.

Procedure CreatePreferencesFile()
  CreatePreferences(Program\InitialisationFile)                                                   ;
  PreferenceComment(" ")                                                                          ; 
  PreferenceComment("----------------------------------------------------------")                 ; 
  PreferenceGroup("Program Options")                                                              ; General program options
  PreferenceComment("----------------------------------------------------------")                 ; 
  PreferenceComment(" ")                                                                          ; 
  WritePreferenceString("Sort From Directory",   "D:\bangf\Downloads\Email Stationery\Incredimail\")                     ; Where to sort from
  WritePreferenceString("Sort To Directory",     "D:\SortedIncrediMail\")                         ; Where to sort to
  WritePreferenceString("Copy or Move Content",              "C")                                 ; Copy or move the content files
  WritePreferenceString("Copy or Move Bad Files",            "C")                                 ; Copy or move the bad files
  WritePreferenceString("Write To Database",                 "N")                                 ; Write details to the database
  ClosePreferences()                                                                              ;
EndProcedure

; Read the system preferences file or create it if missing

Procedure ReadPreferencesFile()
  ; If the INI file doesn't exist, create a default one
  If FileSize(Program\InitialisationFile) = -1
    CreatePreferencesFile()
  EndIf
  ; Program Toggles
  Program\SortFromDirectory   = GetIniVal("Program Options", "Sort From Directory",     Program\InitialisationFile)  ; Tool tips are on or off
  Program\SortToDirectory     = GetIniVal("Program Options", "Sort To Directory",       Program\InitialisationFile)  ; Load the animation settings
  Program\MoveContent         = GetIniVal("Program Options", "Copy or Move Content",    Program\InitialisationFile)  ; Save screen snapping state
  Program\MoveBadFile         = GetIniVal("Program Options", "Copy or Move Bad Files",  Program\InitialisationFile)  ; Turn the title bar updater on or off
  Program\WriteToDatabase     = GetIniVal("Program Options", "Write To Database",       Program\InitialisationFile)  ; The generated MD5 fingerprint of the password
EndProcedure

; Save all preferences at program end

Procedure SavePreferencesFile()
  ; If the INI file doesn't exist, create a default one
  If FileSize(Program\InitialisationFile) = -1
    CreatePreferencesFile()
  EndIf
  ; Program Toggles
  SetIniVal("Program Options", "Sort From Directory",         Program\SortFromDirectory,  Program\InitialisationFile)  ; Tool tips on or off
  SetIniVal("Program Options", "Sort To Directory",           Program\SortToDirectory,    Program\InitialisationFile)  ; Save the window animation state
  SetIniVal("Program Options", "Copy or Move Content",        Program\MoveContent,        Program\InitialisationFile)  ; Save screen snapping state
  SetIniVal("Program Options", "Copy or Move Bad Files",      Program\MoveBadFile,        Program\InitialisationFile)  ; Turn the title bar updater on or off
  SetIniVal("Program Options", "Write To Database",           Program\WriteToDatabase,    Program\InitialisationFile)  ; The generated MD5 fingerprint of the password
EndProcedure

; Microsoft CABinet file format handling

; 

Procedure CAB_Extract_Callback(Context.l, Notification.l, Param1.l, Param2.l)
  Protected *CAB_INFO.FILE_IN_CABINET_INFO
  Protected Path.s
  If Notification.l = $11
    *CAB_INFO = Param1.l
    Path.s = PeekS(Context.l)
    Path.s + PeekS(*CAB_INFO\NameInCabinet)
    MakeSureDirectoryPathExists_(GetPathPart(Path.s))
    *CAB_INFO\FullTargetName = Path.s
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure

; 

Procedure CAB_List_Callback(Context.l, Notification.l, Param1.l, Param2.l)
  Protected *CAB_INFO.FILE_IN_CABINET_INFO
  Protected Path.s
  If Notification.l = $11
    *CAB_INFO = Param1.l
    Path.s = PeekS(Context.l)
    Path.s + PeekS(*CAB_INFO\NameInCabinet)
    ;     MakeSureDirectoryPathExists_(GetPathPart(Path))
    ;     *CAB_INFO\FullTargetName = Path
    AddElement(CabinetMembers())
    CabinetMembers() = Path.s
    ProcedureReturn 2
  EndIf
  ProcedureReturn 0
EndProcedure

; 

Procedure CAB_List(ArchiveName.s, ExtractPath.s)
  ProcedureReturn SetupIterateCabinet_(@ArchiveName, 0, @CAB_List_Callback(), @ExtractPath)
EndProcedure

; 

Procedure CAB_Extract(ArchiveName.s, ExtractPath.s)
  If Right(ExtractPath.s, 1) <> "\"
    ExtractPath.s + "\"
  EndIf
  ProcedureReturn SetupIterateCabinet_(@ArchiveName, 0, @CAB_Extract_Callback(), @ExtractPath)
EndProcedure

; 

; If CAB_List(ArchiveName, ExtractPath)
;   ForEach Files()
;     Debug Files()
;   Next
; EndIf

; 

If Window_iSortiCat()
  
  ; Set main form date
  
  Program\ProgQuit = #False

  ; Add the message and record statusbar icons
  
  StatusBarImage(#StatusBar_iSortiCat, #StatusBar_iSortiCat_micon,  ImageID(#Image_iSortiCat_messages), #PB_StatusBar_BorderLess)

  ; Setup the status bar for colouring with an API
  
  SendMessage_(StatusBarID(#StatusBar_iSortiCat), #SB_SETBKCOLOR, 0, $C0C0C0)

  ; Object tooltips
  
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_sortfromdir,  "Select the source directory that you want to start sorting from.")
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_sorttodir,    "Select the target directory that you will be sorting to or keep the default. It will be created.")
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_sourcepath,   "This shows your selected sort from path.")
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_sortpath,     "This shows your selected sort to path.")
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_move,         "Select this option if you want the files to be physically moved to their new location." + Chr(10) + Chr(13) +  Chr(10) + Chr(13) + "DO NOT USE this option on your IncrediMail data folder path!!!")
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_copy,         "Select this option if you want the files to be just copied to their new location.")
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_database,     "Select this option if you want the content data to be written to the database")
  MyBalloonToolTips(#Window_iSortiCat, #Gadget_iSortiCat_rundir,       "Run the sorting operation now.")

  ; Set main form date
  
  SetDate(#Window_iSortiCat)
  
  ; 
  
  OpenSystemDatabase()
  
  ; 
  
  SetGadgetState(#Gadget_iSortiCat_copy, 1)
  
  ; Some temporary code to make sorting easier, predefined for my system
  
  SetGadgetText(#Gadget_iSortiCat_sourcepath, Program\SortFromDirectory)
  SetGadgetText(#Gadget_iSortiCat_sortpath,   Program\SortToDirectory)
  
  If Program\MoveContent = "M"
    SetGadgetState(#Gadget_iSortiCat_move, 1)
  ElseIf  Program\MoveContent = "C"
    SetGadgetState(#Gadget_iSortiCat_copy, 1)
  EndIf
  
  If Program\WriteToDatabase = "Y"
    SetGadgetState(#Gadget_iSortiCat_database, 1)
  ElseIf Program\WriteToDatabase = "N"
    SetGadgetState(#Gadget_iSortiCat_database, 0)
  EndIf
  
  SetStat(1, "IcatIsort ready. Sorting directories preset, you may change them if needed..")
  
  ; 
  
  ;   SetStat(1, "iSort ready to go")
  
  SetStat(3, "0")

  ; 
  
  SetActiveWindow(#Window_iSortiCat)

  ; 
  
  SetActiveGadget(#Gadget_iSortiCat_sortfromdir)
  
  ; 

  Repeat
    Select WaitWindowEvent()
      Case #PB_Event_CloseWindow
        Select EventWindow()
            Case #Window_iSortiCat            : quitiSortiCat = 1
        EndSelect
      Case #PB_Event_Gadget
        Select EventGadget()
          Case #Gadget_iSortiCat_sortfromdir  : GetSortFromDir()
          Case #Gadget_iSortiCat_sorttodir    : GetSortToDir()
          Case #Gadget_iSortiCat_rundir       : RunSortJob()
          Case #Gadget_iSortiCat_move         : CheckGagdetState(#Gadget_iSortiCat_move)
          Case #Gadget_iSortiCat_copy         : CheckGagdetState(#Gadget_iSortiCat_copy)
          Case #Gadget_iSortiCat_database     : CheckGagdetState(#Gadget_iSortiCat_database)
          Case #Gadget_iSortiCat_exit         : quitiSortiCat = 1
        EndSelect
    EndSelect
  Until quitiSortiCat
  CloseWindow(#Window_iSortiCat)
EndIf
End
Amateur Radio/VK3HAF, (D-STAR/DMR and more), Arduino, ESP32, Coding, Crochet
Post Reply