PureBasic Forums - English

Code: Select all

Structure record
  deleted.l
  marked.l
  diskfile.b[255]
  filesize.b[14]
  version.b[6]
  crc32.b[15]
  filename.b[50]
  filetype.b[15]
  category.b[30]
  collection.b[30]
  display.b[30]
  trademark.b[30]
  tradelink.b[50]
  comments.b[255]
EndStructure

Structure dbheader
  numrecords.l
  numdeleted.l
  recordlen.l
EndStructure

NewList dir.s()

#database = "IncrediMailStyles.dat"

#displaybox = 1
#gobutton = 2

; Setup global strings so we don't have to constantly pass long winded parameters -------

Global diskfile.s, filesize.s, version.s, crc32.s
Global filename.s, filetype.s, category.s, collection.s, display.s, trademark.s, tradelink.s, comments.s
Global recbuf.record, header.dbheader

;- precalculated variables --------------------------------------------------------------

header\recordlen = SizeOf(record)

;- Open the database or create it if it doesn't exist -----------------------------------

If FileSize(#database) > 0
  OpenFile(1, #database)
  ReadData(@header, SizeOf(dbheader))
  CloseFile(1)
Else
  CreateFile(1, #database)
  WriteData(@header, SizeOf(dbheader))
  CloseFile(1)
EndIf
; ---------------------------------------------------------------------------------------

Declare$ getini(key$, section$)                           ; Declare any needed routines
Declare$ fillcontent(content$)

;----------------------------------------------------------------------------------------

Procedure$ getini(key$, section$)                         ; API procedure to replace Mr Skunk's INI file reading routine
  empty$ = "Empty"
  returnspace$ = Space(255)
  inidata = GetPrivateProfileString_(section$, key$, empty$, @returnspace$, 255, "C:\iCat2\content.ini")
  ProcedureReturn returnspace$
EndProcedure

;- Main code starts here ----------------------------------------------------------------

  fontname$ = "Comic Sans MS"
  fontheight = 10
  font = LoadFont(1, fontname$, fontheight)
  SetGadgetFont(font)
  ;--------------------------------------------------------------------------------------
  winx = (GetSystemMetrics_(#SM_CXSCREEN) - 630) / 2
  winy = (GetSystemMetrics_(#SM_CYSCREEN) - 40) / 2

  mainwindow = OpenWindow(0, Random(winx), Random(winy), 630, 40, #PB_Window_SystemMenu, "")
  
  If mainwindow = 0 Or CreateGadgetList(WindowID()) = 0
    End
  EndIf

  StringGadget(#displaybox, 5, 5, 500, 25, "")
  ButtonGadget(#gobutton, 505, 5, 100, 25, "Go")
  ;--------------------------------------------------------------------------------------
  Repeat

    eventid = WaitWindowEvent()

    If eventid = #PB_EventCloseWindow
      quitvalue = 1
    EndIf
    ;----------------------------------------------
    If eventid = #PB_EventGadget
      Select EventGadgetID()
        Case #gobutton  : Gosub maincode
      EndSelect
    EndIf
  
  Until quitvalue = 1
  
  CloseWindow(0)
  
  End
  
;----------------------------------------------------------------------------------------
; Main code for getting files
;----------------------------------------------------------------------------------------

maincode:

  AddElement(dir())
  dir() = PathRequester("Select the drive And directory To catalogue", "")
  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
          count + 1
          ;------------------------------------------------------------------------------
          itype.s = Right(filename, 4)
          Select itype.s
            Case ".ima"
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
            Case ".imf" 
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
            Case ".ime"
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
            Case ".imi"
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
            Case ".imf"
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
            Case ".imn"
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
            Case ".ims"
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
            Case ".imw"
              diskfile = path + filename
              SetGadgetText(#displaybox, diskfile)
              Gosub processcurrentfile
          EndSelect
          ;------------------------------------------------------------------------------
        Case 2
          filename.s = DirectoryEntryName()
          If filename  ".." And filename  "."
            AddElement(dir())
            dir() = path + filename
          EndIf
      EndSelect  
    Until quit = 1
  EndIf
  idx + 1
  Until idx > CountList(dir())

Return

;----------------------------------------------------------------------------------------
; Process the files found during the directory search
;----------------------------------------------------------------------------------------

processcurrentfile:

  filesize = Str(FileSize(diskfile) / 1024) + "k"           ; Get the disk filename size
  ;--------------------------------------------------------------------------------------
  If ReadFile(0, diskfile)                                  ; Get the 32 bit crc if you can read it
    length = Lof()
    buffer = AllocateMemory(0, length)
    ReadData(buffer,length)
    crc32 = Hex(CRC32Fingerprint(buffer, length))
  EndIf
  FreeMemory(0) 
  ;--------------------------------------------------------------------------------------
  unpacker$ = "C:\iCat2\extract.exe"                        ; Drive and directory for extract.exe
            
  params$ = " /Y /E /L C:\iCat2\ " + Chr(34) + diskfile + Chr(34) + " content.ini" ; Make unpack String

  If RunProgram(unpacker$, params$, "", 1 | 2)  0
  EndIf
  ;--------------------------------------------------------------------------------------
  section$ = "Version"
    version = getini("Number", section$)
  section$ = "General"
    filename = getini("File", section$)
    filetype = getini("Type", section$)
    category = getini("Category", section$)
    collection = getini("Collection", section$)
    display = getini("Display", section$)
  section$ = "Trademark"
    trademark = getini("TradeMark", section$)
  section$ = "X-Extensions"
    tradelink = getini("TradeMarkLink", section$)
  ;--------------------------------------------------------------------------------------
  For r = 0 To SizeOf(record) - 1                                ; Must start at 0 and end at record - 1
    PokeB(@recbuf\deleted + r, 0)                                 ; Poke 0's at position (r)
  Next r
  ;--------------------------------------------------------------------------------------
  recbuf\deleted = 0
  recbuf\marked = 0

  CopyMemory(@diskfile, @recbuf\diskfile[0], Len(diskfile))
  CopyMemory(@filesize, @recbuf\filesize[0], Len(filesize))
  CopyMemory(@version, @recbuf\version[0], Len(version))
  CopyMemory(@crc32, @recbuf\crc32[0], Len(crc32))
  CopyMemory(@filename, @recbuf\filename[0], Len(filename))
  CopyMemory(@filetype, @recbuf\filetype[0], Len(filetype))
  CopyMemory(@category, @recbuf\category[0], Len(category))
  CopyMemory(@collection, @recbuf\collection[0], Len(collection))
  CopyMemory(@display, @recbuf\display[0], Len(display))
  CopyMemory(@trademark, @recbuf\trademark[0], Len(trademark))
  CopyMemory(@tradelink, @recbuf\tradelink[0], Len(tradelink))
  comments = " ": CopyMemory(@comments, @recbuf\comments[0], Len(comments))
  ;--------------------------------------------------------------------------------------

  If OpenFile(1, #database)
    
    FileSeek(Lof())                                                 ; Seek to the end of the file
    WriteData(@recbuf, SizeOf(record))                              ; Write the record to disk

    header\recordlen = SizeOf(record)                               ; Compute the length of the record
    header\numrecords + 1                                           ; Calculate new number of records
            
    FileSeek(0)                                                     ; Seek to the start of the file
           
    WriteData(@header, SizeOf(dbheader))                            ; Write the header details (file length, records)
            
    CloseFile(1)                                                    ; Close the file
    ;------------------------------------------------------------------------------------
    For r = 0 To SizeOf(record) - 1                                ; Must start at 0 and end at record - 1
      PokeB(@recbuf\deleted + r, 0)                                 ; Poke 0's at position (r)
    Next r
    ;------------------------------------------------------------------------------------
    
  EndIf
  
Return