IncrediMail .IMF content cataloguer

Windows specific forum
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by Fangbeast.

This is my first attempt to make a cataloguer for people who love IncrediMail, can't help themselves collecting content for it, can't figure out what they have got from some of the strange names that get posted.

1. This program is simple, like me!!!
2. This program is slow and makes a few assumptions
3. Make a directory on hour hard drive called imftest
4. This program uses microsoft's EXTRACT.EXE to read the IMF files (CABs)
5. Lots of flickering as EXTRACT gets shelled out to and called.
6. Did I mention that it was slow??
7. I am working on improvements as I have over 2,600 IncrediMail files!!
8. Check the wrapping of the code in this example and no yelling please!

Structure NameStructure
NameLine.s
EndStructure

NewList NameList.NameStructure()

StartDrive$ = "c:\"
WildCard$ = ".imf"
Unpacker$ = "c:\imftest\extract.exe"
MasterList$ = "c:\imftest\masterlist.txt"
Catalogue$ = "c:\imftest\catalogue.txt"

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

Procedure getlist(SourceDirectory$, Start, Pattern$)

If ExamineDirectory(Start, SourceDirectory$, "*.*")
Repeat
Type = NextDirectoryEntry()
If Type = 2
If DirectoryEntryName() "." And DirectoryEntryName() ".."
a$ = SourceDirectory$ + DirectoryEntryName() + "\"
getlist(a$, Start + 1, Pattern$)
UseDirectory(Start)
EndIf
Else
If Type = 1 And Right(Ucase(DirectoryEntryName()),Len(Pattern$)) = Ucase(Pattern$)
AddElement(NameList())
NameList()\NameLine = SourceDirectory$ + DirectoryEntryName()
EndIf
EndIf
Until Type = 0
EndIf

EndProcedure

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

Procedure dumplist(ListName$)

ResetList(NameList())

If OpenFile(0, ListName$)

While NextElement(NameList())
WriteStringN(NameList()\NameLine)
Wend

EndIf

CloseFile(0)

EndProcedure

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

Procedure getcontent(Unpacker$)

ResetList(NameList())

While NextElement(NameList())

Params$ = " /Y /E /L c:\imftest " + Chr(34) + NameList()\NameLine + Chr(34) + " content.ini"
If RunProgram(Unpacker$, Params$, 0)
EndIf
Delay(100)

If ReadFile(0, "c:\imftest\content.ini")
While eof() = 0
Test$ = ReadString()
TestLen = Len(Test$)
If Left(Test$, 9) = "Category="
Category$ = Mid(Test$, 10, TestLen - 9)
EndIf
If Left(Test$, 11) = "Collection="
Collection$ = Mid(Test$, 12, TestLen - 11)
EndIf
If Left(Test$, 8) = "Display="
Display$ = Mid(Test$, 9, TestLen - 8)
EndIf
Wend
EndIf
CloseFile(0)

NameList()\NameLine = NameList()\NameLine + " , " + Chr(34) + Category$ + " - " + Collection$ + " - " + Display$ + Chr(34)
Category$ = "" : Collection$ = "" : Display$ = ""

Wend

EndProcedure

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

getlist(StartDrive$,0, WildCard$)
dumplist(MasterList$)
getcontent(Unpacker$)
dumplist(Catalogue$)

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

Fangles
BackupUser
PureBasic Guru
PureBasic Guru
Posts: 16777133
Joined: Tue Apr 22, 2003 7:42 pm

Post by BackupUser »

Restored from previous forum. Originally posted by Fangbeast.

Fangles
Ouch!! Sorry about the lack of indenting, forgot to turn HTML on in here. P.S.. Don't forget to find and copy EXTRACT.EXE to the IMFTEST directory. It is a part of every LEGAL Windows O/S installation

Scream, Yell, critisize, modify, suggest improvements etc. I need this and so do others. Got waaaaay to much IncrediMail graphics :)

Fangles
Post Reply