November 24, 2020, 06:57:00 AM

Author Topic: [bb] File Searcher by _PJ_ [ 1+ years ago ]  (Read 606 times)

Offline BlitzBot

  • Jr. Member
  • **
  • Posts: 1
[bb] File Searcher by _PJ_ [ 1+ years ago ]
« on: June 29, 2017, 12:28:38 AM »
Title : File Searcher
Author : _PJ_
Posted : 1+ years ago

Description : This started as a littl routine in which I wanted to ensure recursive file-searches. It rapidly expanded into much more.

Potentially there's still so much more that can be done  with it, but for now it does plenty as is.

What it does is stores a list of results from a file search in a Type.
The search can accept special criteria such as file type, AND NOT and OR type searches as wella s toggling case-sensitivity. There's notes in comments throughout the code, but I'll check back here regularly if anyone has any questions or bugs to report as well as suggestions too!

I may, if I get time, include some manner of Import / Export functionality and also hopefully try to include the criteria constraints into the other, more specialised functions added for user preferences.


Code :
Code: BlitzBasic
  1. ;Notes For Criteria Logic:
  2.  
  3. ; This will return ALL Records EXCLUDING those with ".bb", ".exe." or "Hello" in the filename (note, pending on the IgnoreCase flag)
  4. ;CriteriaType%          =       (CRITERIA_NOT Or CRITERIA_OR)
  5. ;CriteriaString$        =       (CRITERIA_STRING$=".bb"+CRITERIA_SEPARATOR$+".exe"+CRITERIA_SEPARATOR$+"Hello")
  6.  
  7. ; This will return ONLY Records whose filename exactly matches "Blitz3D.exe" (note, pending on the IgnoreCase flag)
  8. ;CriteriaType%          =       (CRITERIA_SPECIFIC)
  9. ;CriteriaString$        =       (CRITERIA_STRING$="Blitz3D.exe")
  10.  
  11. ; This will return ONLY Records whose filename DOES NOT exactly match "Read Me.txt", "Read Me.pdf", "Read Me.wri" OR "Read Me.doc" (note, pending on the IgnoreCase flag)
  12. ;CriteriaType%          =       (CRITERIA_SPECIFIC Or CRITERIA_NOT)
  13. ;CriteriaString$        =       (CRITERIA_STRING$="Read Me.txt"+CRITERIA_SEPARATOR$+"Read Me.pdf"+CRITERIA_SEPARATOR$+"Read Me.wri"++CRITERIA_SEPARATOR$+"Read Me.doc")
  14.  
  15. ; This will return ONLY Records whose filename contains BOTH "The Beatles" AND ".mp3" (note, pending on the IgnoreCase flag)
  16. ;CriteriaType%          =       (CRITERIA_AND)
  17. ;CriteriaString$        =       (CRITERIA_STRING$="The Beatles"+CRITERIA_SEPARATOR$+".exe"+CRITERIA_SEPARATOR$+".mp3")
  18.  
  19. ; Unfortunately, As of This version, the criteria logic NOT cannot be combined. So you cannot retrieve, for example, ALL Records
  20. ;containing "The Beatles" but excluding those with ".wav" within.
  21. ;NOT can be used with OR or AND if all criteria are to be excluded. Essenitally it reverses the selection process of the criteria.
  22. ;However, careful manipulation of two separate archives can still be used to lessen any workload.
  23.  
  24. ; For Ease of Use, the default folder names such as "." and ".." are skipped automatically. Attempting to retrieve these may cause error.
  25.  
  26. ;**********************************************************
  27.  
  28.  
  29.  
  30.  
  31.  
  32.  
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39.  
  40.  
  41.  
  42.  
  43.  
  44.  
  45.  
  46.  
  47.  
  48.  
  49.  
  50.  
  51.  
  52.  
  53.  
  54.  
  55.  
  56.  
  57.  
  58.  
  59.  
  60.  
  61.  
  62.  
  63.  
  64.  
  65.  
  66.  
  67.  
  68.  
  69.  
  70.  
  71.  
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84. ;**********************************************************************************************************************************************************************************
  85. ;*********************************************************************************  USER ENVIRONMENT  *****************************************************************************
  86. ;**********************************************************************************************************************************************************************************
  87.  
  88. ; These declarations are user-confgured.
  89. Global debug=Instr(Lower$(CommandLine()),"debug")       ; Checks for "debug" command line entry - alternatively, use a simple True or False!
  90. Global fDebuglogPath$=CurrentDir()+"Debuglog.log"       ; This is where the debug log will be output to.
  91. Const APP_NAME$="My Application"                                        ; Largely irrelevant for the scope of this snippet, this just holds the name of the application.
  92.  
  93.  
  94. ;**********************************************************
  95.  
  96. ;You can simply use the BuildArchive() function as it is, or, for more control, make use the following global definitions and functions
  97.  
  98. Global CRIT_STRING$=NULL_STRING$
  99.  
  100. Global CRIT_TYPE%=CRITERIA_OR%
  101.  
  102. Global FILETYPE_FILTER%=FILETYPE_EITHER%
  103.  
  104. Global RECURSIVE%=True
  105.  
  106. Global IGNORE%=True
  107.  
  108. Function ToggleIgnoreCase()
  109.         IGNORE%=(Not(IGNORE%))
  110. End Function
  111.  
  112. Function ToggleRecursive()
  113.         RECURSIVE%=(Not(RECURSIVE%))
  114. End Function
  115.  
  116. Function SetFileTypeFilter(FilterType)
  117.         FILETYPE_FILTER%=FilterType
  118. End Function
  119.  
  120. Function SetCriteriaTypeFilter(CritType)
  121.         CRIT_TYPE%=CritType
  122. End Function
  123.  
  124. Function AddToCritString$(AddString$)
  125.         CRIT_STRING$=CRIT_STRING$+CRITERIA_SEPARATOR$+AddString$
  126. End Function
  127.  
  128. ;With the above, the following wrapper can be used to generate an archive archive much more conveniently.
  129. Function GenerateArchive(Archive%=1,StartDirectory$=NULL_STRING$)
  130.         BuildArchive(Archive%,IGNORE,RECURSIVE,StartDirectory$,FILETYPE_FILTER%,CRIT_TYPE%,CRIT_STRING$,True)
  131. End Function
  132.  
  133. ;**********************************************************
  134.  
  135.  
  136.  
  137.  
  138.  
  139.  
  140. ;**********************************************************************************************************************************************************************************
  141. ;*************************************************************************************  REQUIRED  *********************************************************************************
  142. ;**********************************************************************************************************************************************************************************
  143.  
  144. ; All the following declarations are necessary and required parts of the system. Please do not alter them!
  145. Const NULL_STRING$=""
  146. Const SPACER$=" "
  147. Const WILDCARD$="*"
  148. Const BAR$="|"
  149.  
  150. Const EXTENSION_SEPARATOR$="."
  151. Const PATH_SEPARATOR$=""
  152. Const PATH_SEPARATOR_REVERSE$="/"
  153.  
  154. ; These provide help for readability and allow logic clauses.
  155. Const FILETYPE_FILE%=1
  156. Const FILETYPE_DIRECTORY%=2
  157. Const FILETYPE_EITHER%=3
  158. Const FILETYPE_INVALID%=0
  159.  
  160. ; Sets the Bitwise values for the Criteria logic.
  161. Const CRITERIA_AND%=1
  162. Const CRITERIA_OR%=2
  163. Const CRITERIA_SPECIFIC%=4
  164. Const CRITERIA_NOT%=8
  165.  
  166. ; This is used to imply separate entries.
  167. Const CRITERIA_SEPARATOR$="!*?"        
  168.  
  169. ; These declarations are used by the Debugger functionality.
  170. Global DBG_ERROR_CODE$[6]
  171. DBG_ERROR_CODE[0]="Undefined Error"
  172. DBG_ERROR_CODE[1]="Debugger consistency message"
  173.  
  174. DBG_ERROR_CODE[2]="Archive limit reached. Process not applied"
  175.  
  176. DBG_ERROR_CODE[3]="File cannot be written or bad path"
  177. DBG_ERROR_CODE[4]="File not found or bad path"
  178. DBG_ERROR_CODE[5]="File already deleted missing, or bad path"
  179.  
  180. Const DBG_ERC_NOT_AN_ERROR%=1
  181.  
  182. Const DBG_ERC_ARC_LIMITREACHED%=2
  183.  
  184. Const DBG_ERC_FILE_CANT_WRITE%=3
  185. Const DBG_ERC_FILE_MISSING%=4
  186. Const DBG_ERC_FILE_DELETE_MISSING%=5
  187.  
  188. ; Due to unknown potential of large number of Records, this Type is used to contain the results.
  189. ;Results split into separate parts for user functionality.
  190. Type Records
  191.         Field Returned_FileType%
  192.         Field Returned_Path$
  193.         Field Returned_Filename$
  194.         Field Returned_Extension$
  195.         Field Archive%
  196. End Type
  197.  
  198. ;**********************************************************************************************************************************************************************************
  199. ;*************************************************************************************  DEBUGGER  *********************************************************************************
  200. ;**********************************************************************************************************************************************************************************
  201.  
  202. Function DebugLine(sDebugFunction$="DEBUGGER:NULLFUNCTION",nCode%=0,bExitFlag=False,sDebugReason$=NULL_STRING$)
  203.         If (Not(debug))
  204.                 If (bExitFlag)
  205.                         AppTitle APP_NAME$+" Terminated by Debugger."
  206.                         RuntimeError Str(nCode)+" ("+DBG_ERROR_CODE[nCode%]+")"
  207.                 End If                 
  208.                 Return
  209.         End If
  210.         Local fDebug%=WriteFile%(fDebuglogPath$)
  211.         If (Not(fDebug))
  212.                 If (bExitFlag) Then ExitApplication(nCode%,sDebugFunction$,sDebugReason$)
  213.                 debug=False
  214.                 Return
  215.         End If
  216.         SeekFile(fDebug,FileSize(fDebuglogPath$))
  217.         Local sLine$=LSet$(CurrentDate(),11)+Chr(9)+BAR$+LSet$(CurrentTime(),8)+Chr(9)+BAR$+LSet$(Trim$(Replace$(sDebugFunction$,SPACER+SPACER,SPACER)),50)+Chr(9)+BAR$+LSet$(Trim$(Replace$(Str(nCode%)+" ("+DBG_ERROR_CODE[nCode%]+")",SPACER+SPACER,SPACER)),50)+Chr$(9)+BAR$+Trim(Replace$(sDebugReason$,SPACER+SPACER,SPACER))
  218.         WriteLine(fDebug,sLine$)
  219.         CloseFile fDebug
  220.         If (bExitFlag)Then ExitApplication(nCode%,sDebugFunction$,sDebugReason$)
  221. End Function
  222.  
  223. Function ExitApplication(sFunction$,nCode%, sReason$)
  224.         ClearWorld
  225.         EndGraphics
  226.         AppTitle APP_NAME$+" Terminated by Debugger."
  227.         Local sReport$=APP_NAME$+" has been terminated by Debugger due to a critical error in function process:"+Chr(10)
  228.         sReport=sReport+Str(nCode%)+" ("+DBG_ERROR_CODE[nCode%]+")"+Chr$(10)
  229.         sReport=sReport+Str(nCode%)+" ("+DBG_ERROR_CODE[nCode%]+")"+Chr$(10)
  230.         sReport$=sReport$+"Debugger cites a possible reason: "+Chr(10)+sReason$
  231.         sReport$=sReport$+"For more information: "+Chr(10)+fDebuglogPath$
  232.        
  233.         AppTitle "Application Needs To Close",sReport$
  234.        
  235.         RuntimeError sReport$
  236. End Function
  237.  
  238. ;**********************************************************************************************************************************************************************************
  239. ;**********************************************************************************  CORE FUNCTIONS  ******************************************************************************
  240. ;**********************************************************************************************************************************************************************************
  241.  
  242.  
  243. Function BuildArchive(Archive%=1,Ignore_Case%=True,RecursiveSearch%=True,StartDir$=NULL_STRING$,RecordsType%=FILETYPE_EITHER%,CriteriaType%=CRITERIA_OR%,CriteriaString$=NULL_STRING$,FirstRun%=True)
  244.        
  245.         If (FirstRun%)
  246.                 Local nTotalArchives%=CountArchives()
  247.                 If (nTotalArchives%>29)
  248.                         DebugLine("CONFIGARCHIVE:BUILDARCHIVE",DBG_ERC_ARC_LIMITREACHED,False,"Archive total is: "+Str(nTotalArchives%)+" Maximum: 30")
  249.                         Return
  250.                 End If
  251.                 DebugLine("CONFIGARCHIVE:BUILDARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Building archive "+Archive%)
  252.                 DebugLine("CONFIGARCHIVE:BUILDARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Clearing old archive data")
  253.                 DeleteArchive(Archive%)
  254.         End If
  255.        
  256.         If (StartDir$=NULL_STRING$) Then StartDir$=CurrentDir()
  257.         Local SearchDir$=StartDir$
  258.         SearchDir$=FixPath$(SearchDir$,True)
  259.         Local SearchHandle%=ReadDir(SearchDir$)
  260.        
  261.         If (Not(SearchHandle)) Then SearchHandle%=ReadDir(CurrentDir())
  262.        
  263.         DebugLine("CONFIGARCHIVE:BUILDARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Searching directory "+SearchDir$)
  264.        
  265.         Local CurrentFile$=NextFile(SearchHandle%)
  266.         Local FullFilePath$=FixPath$(SearchDir$+CurrentFile$)
  267.         Local CurrentFileType%=FileType(FullFilePath$)
  268.         While (CurrentFile$<>NULL_STRING)
  269.                 If (Right$(CurrentFile$,1)<>EXTENSION_SEPARATOR)
  270.                         CurrentFileType%=FileType(FullFilePath$)               
  271.                         If FileTypeCriteriaValid%(CurrentFileType%,RecordsType%)
  272.                                 If (CheckCriteria%(CurrentFile$,CriteriaString$,CriteriaType%,Ignore_Case%))
  273.                                         DebugLine("CONFIGARCHIVE:BUILDARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Valid file found: "+FullFilePath$)
  274.                                         AddFile(FullFilePath$,Archive%)
  275.                                 End If
  276.                         End If
  277.                         If (CurrentFileType=FILETYPE_DIRECTORY)
  278.                                 FullFilePath$=FixPath(FullFilePath$,True)
  279.                                 DebugLine("CONFIGARCHIVE:BUILDARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Directory found: "+FullFilePath$)
  280.                                 If (RecursiveSearch)
  281.                                         BuildArchive(Archive,Ignore_Case,True,FixPath$(FullFilePath$,True),RecordsType,CriteriaType%,CriteriaString$,False)
  282.                                 End If
  283.                         End If
  284.                 End If
  285.                 CurrentFile$=NextFile(SearchHandle%)
  286.                 FullFilePath$=SearchDir$+CurrentFile$
  287.         Wend
  288.         CloseDir SearchHandle
  289.         DebugLine("CONFIGARCHIVE:BUILDARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Archive: "+Str(Archive)+" built with "+Str(CountAllRecordsInArchive%(Archive%))+" records.")
  290. End Function           
  291.  
  292. ;**********************************************************
  293.  
  294. ; What happens with the generated archive archives is very much up to the user, but here's some typical functions that may
  295. ;be of use...
  296.  
  297. ;**********************************************************
  298.  
  299. ; Deletes all archives From Memory
  300. Function DeleteAllArchives()
  301.         Local nArchiveCount%=CountArchives%()
  302.         DebugLine("CONFIGARCHIVE:DELETEALLARCHIVES",DBG_ERC_NOT_AN_ERROR,False,"Deleting all "+Str(nArchiveCount%))
  303.         Local Del.Records
  304.         For Del.Records=Each Records
  305.                 Delete Del.Records
  306.         Next
  307.         DebugLine("CONFIGARCHIVE:DELETEALLARCHIVES",DBG_ERC_NOT_AN_ERROR,False,"Archives total remaining: "+ZERO_STRING$)
  308. End Function
  309.  
  310. ; Deletes A Specific archive From Memory
  311. Function DeleteArchive(Archive%=1)     
  312.         Local Del.Records
  313.         Local nArchiveCount%=CountArchives%()
  314.         If (nArchiveCount%)
  315.                 DebugLine("CONFIGARCHIVE:DELETEARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Deleting archive: "+Str(Archive%)+" from total of "+(Str(nArchiveCount%)))
  316.                
  317.                 For Del.Records=Each Records
  318.                         If (Del.Records<>Null)
  319.                                 If      (ArchiveRecordValid(Archive%,Del.Records))
  320.                                         Delete Del.Records
  321.                                 Else
  322.                                         If ((nArchiveCount%>1) And (Archive%<nArchiveCount))
  323.                                                 If (ArchiveOfRecord%(Del.Records)>Archive%) Then DelArchive%=DelArchive%-1
  324.                                         End If
  325.                                 End If
  326.                         End If
  327.                 Next
  328.                 nArchiveCount%=nArchiveCount%-1
  329.         End If
  330.         DebugLine("CONFIGARCHIVE:DELETEARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Archives total remaining: "+(Str(nArchiveCount%)))
  331. End Function
  332. ; Combines Archives. The NewArchive Flag, if set, will combine the archives as a new archive, otherwise the entries from
  333. ;ArchiveToCombine will be added to ArchiveMaster.
  334. Function CombineArchivesAs(ArchiveMaster%=1,ArchiveToCombine%=1,AllowDuplicates%=True,NewArchive%=True)
  335.         Local DoAdd%=True
  336.         Local AddArchive%=ArchiveMaster%
  337.         Local TotalArchives%=CountArchives%()
  338.         If (NewArchive%=True) Then AddArchive%=TotalArchives%+1
  339.         If (TotalArchives%>30)
  340.                 DebugLine("CONFIGARCHIVE:COMBINEARCHIVEAS",DBG_ERC_ARC_LIMITREACHED,False,"Arhieve total is: "+Str(TotalArchives%-1)+" Maximum: 30")
  341.         Else   
  342.                 DebugLine("CONFIGARCHIVE:COMBINEARCHIVEAS",DBG_ERC_NOT_AN_ERROR,False,"Seeking records to combine from archive: "+Str(ArchiveToCombine%)+" to archive: "+Str(AddArchive%))
  343.                 Local nCount%=CountAllRecordsInArchive(ArchiveToCombine%)
  344.                 DebugLine("CONFIGARCHIVE:COMBINEARCHIVEAS",DBG_ERC_NOT_AN_ERROR,False,"Total records in archive "+Str(ArchiveToCombine%)+": "+Str(nCount%))
  345.                 Local IterRecords
  346.                 Local CombineRecord.Records
  347.                 Local RetrieveString$=NULL_STRING$
  348.                 For IterRecords=1 To nCount%
  349.                         DoAdd%=True
  350.                         CombineRecord.Records=GrabRecord.Records(IterRecords,ArchiveToCombine)
  351.                         RetrieveString$=GrabArchiveRecordEntireString$(IterRecords,ArchiveToCombine)
  352.                         ;DebugLine("CONFIGARCHIVE:COMBINEARCHIVEAS",DBG_ERC_NOT_AN_ERROR,False,"Verifying record: "+Str(IterRecords%)+" contents "+RetrieveString$)
  353.                         If (GetIndexForSearch%(RetrieveString$,True,ArchiveMaster%))
  354.                                 If (Not(AllowDuplicates%))
  355.                                         DebugLine("CONFIGARCHIVE:COMBINEARCHIVEAS",DBG_ERC_NOT_AN_ERROR,False,"Record "+Str(IterRecords%)+" of "+Str(nCount%)+" invalid. Duplicates disallowed")
  356.                                         DoAdd%=False
  357.                                 End If
  358.                         End If
  359.                         If (DoAdd%)
  360.                                 DebugLine("CONFIGARCHIVE:COMBINEARCHIVEAS",DBG_ERC_NOT_AN_ERROR,False,"Copying record: "+Str(IterRecords%)+" of "+Str(nCount%)+" from archive: "+Str(ArchiveToCombine%)+" to Archive: "+Str(AddArchive%))
  361.                                 AddFile(RetrieveString,AddArchive%)
  362.                         End If
  363.                         RemoveArchiveRecordsByString(RetrieveString$,True,ArchiveToCombine%)
  364.                 Next   
  365.                 DebugLine("CONFIGARCHIVE:COMBINEARCHIVEAS",DBG_ERC_NOT_AN_ERROR,False,"Archives "+Str(ArchiveToCombine)+" and "+Str(ArchiveMaster%)+" combined into "+(AddArchive%))
  366.         End If
  367. End Function
  368.  
  369. Function RemoveRecordByIndex(Index%=1,Archive%=1)
  370.         DebugLine("CONFIGARCHIVE:REMOVERECORDBYINDEX",DBG_ERC_NOT_AN_ERROR,False,"Removing record: "+Str(Index%)+" from archive: "+Str(Archive%))
  371.         Delete GrabRecord.Records(Index%,Archive%)
  372. End Function
  373.  
  374. Function RemoveArchiveRecordsByString(CheckString$=NULL_STRING$,Exact%=True,Archive%=1)
  375.         DebugLine("CONFIGARCHIVE:REMOVEARCHIVERECORDSBYSTRING",DBG_ERC_NOT_AN_ERROR,False,"Seeking matching records: "+CheckString$+" from archive: "+Str(Archive))
  376.         Local DoRemove%=GetIndexForSearch%(CheckString$,Exact%,Archive)
  377.         While (DoRemove)
  378.                 DebugLine("CONFIGARCHIVE:REMOVEARCHIVERECORDSBYSTRING",DBG_ERC_NOT_AN_ERROR,False,"Found matching record: "+Str(DoRemove%)+" in archive: "+Str(Archive))
  379.                 RemoveRecordByIndex(DoRemove%,Archive%)
  380.                 DoRemove=GetIndexForSearch%(CheckString$,Exact%,Archive%)
  381.         Wend
  382. End Function
  383.  
  384. ; Introduxes a hard limit of 30 archives, though it's unlikely so many would ever be needed.
  385. Function CountArchives%()
  386.         Local nCount%
  387.         Local itercount%
  388.         Local BitCheck%
  389.         Local CountRecords.Records
  390.         For CountRecords.Records = Each Records
  391.                 If (CountRecords.Records<>Null)
  392.                         BitCheck%=(2^(CountRecordsArchive%))
  393.                         If (Not(LogicCheck(nCount%,BitCheck%))) Then nCount%=nCount%+BitCheck%
  394.                 End If
  395.         Next
  396.         For itercount%=1 To 30
  397.                 If (Not(LogicCheck((1 Shr itercount),nCount%))) Then Exit
  398.         Next
  399.         DebugLine("CONFIGARCHIVE:COUNTARCHIVES",DBG_ERC_NOT_AN_ERROR,False,"Found "+Str(itercount%)+" archives")
  400.         Return itercount%
  401. End Function
  402.  
  403. Function CountAllRecordsInArchive%(Archive%=1)
  404.         Local nCount%
  405.         Local CountRecords.Records
  406.         For CountRecords.Records = Each Records
  407.                 If (ArchiveRecordValid%(Archive%,CountRecords.Records)) Then nCount%=nCount%+1
  408.         Next
  409.         DebugLine("CONFIGARCHIVE:COUNTALLRECORDSINARCHIVE",DBG_ERC_NOT_AN_ERROR,False,"Total records counted in archive "+Str(Archive%)+": "+Str(nCount%))
  410.         Return nCount%
  411. End Function
  412.  
  413. Function GrabRecord.Records(RecordIndex%=1,Archive%=1)
  414.         DebugLine("CONFIGARCHIVE:GRABRECORD",DBG_ERC_NOT_AN_ERROR,False,"Retrieving record data: "+Str(RecordIndex%)+" from archive: "+Str(Archive%))
  415.         Return ArchiveRecordCount.Records(Archive%,RecordIndex%)
  416. End Function
  417.  
  418. Function GetIndexForSearch%(CheckString$=NULL_STRING$,Exact%=True,Archive%=1)
  419.         Local nCount%
  420.         Local CountRecords.Records
  421.         Local TestString$
  422.         ;DebugLine("CONFIGARCHIVE:GETINDEXFORSEARCH",DBG_ERC_NOT_AN_ERROR,False,"Seeking matching records: "+CheckString$+" from archive: "+Str(Archive))
  423.         For CountRecords.Records=Each Records
  424.                 If ArchiveRecordValid%(Archive%,CountRecords.Records)
  425.                         nCount%=nCount%+1
  426.                         TestString$=GrabArchiveRecordEntireString$(nCount%,Archive%)Lower$(CheckString$)
  427.                         If CheckString$=GrabArchiveRecordEntireString$(nCount%,Archive%) Then Return nCount
  428.                         If  (Instr(Lower$(TestString$),CheckString$>0))
  429.                                 If (Not(Exact%))
  430.                                         DebugLine("CONFIGARCHIVE:GETINDEXFORSEARCH",DBG_ERC_NOT_AN_ERROR,False,"Found matching record: "+Str(nCount%))
  431.                                         Return nCount%
  432.                                 End If
  433.                         End If 
  434.                 End If
  435.         Next
  436.         DebugLine("CONFIGARCHIVE:GETINDEXFORSEARCH",DBG_ERC_NOT_AN_ERROR,False,"No matching records")
  437.         Return False
  438. End Function
  439. ;Returns the actual pathname stored in record
  440. Function GrabArchiveRecordPathString$(RecordIndex=1,Archive=1)
  441.        
  442.         Local sReturn$=NULL_STRING$
  443.         Local ReturnRecord.Records=GrabRecord.Records(RecordIndex,Archive)
  444.         If (ReturnRecord.Records<>Null)
  445.                 sReturn$=EndDirPath$(ReturnRecordReturned_Path$)
  446.         End If
  447.         DebugLine("CONFIGARCHIVE:GRABARCHIVERECORDEXTENSIONSTRING",DBG_ERC_NOT_AN_ERROR,False,"Retrieving record "+RecordIndex+" of archive: "+Str(Archive%)+" File Extension: "+Chr$(34)+sReturn$+Chr(34))
  448.         Return sReturn$                
  449. End Function
  450.  
  451. ;Returns the actual filename stored in record
  452. Function GrabArchiveRecordFilenameString$(RecordIndex=1,Archive=1)
  453.         Local sReturn$=NULL_STRING$
  454.         Local ReturnRecord.Records=GrabRecord.Records(RecordIndex%,Archive%)
  455.         If (ReturnRecord.Records<>Null)
  456.                 sReturn$=ReturnRecordReturned_Filename$
  457.         End If
  458.         DebugLine("CONFIGARCHIVE:GRABARCHIVERECORDFILENAMESTRING",DBG_ERC_NOT_AN_ERROR,False,"Retrieving record "+RecordIndex+" of archive: "+Str(Archive%)+" File Name: "+Chr$(34)+sReturn$+Chr(34))
  459.         Return sReturn$                
  460. End Function
  461.  
  462. ;Returns the actual fileextension stored in record
  463. Function GrabArchiveRecordExtensionString$(RecordIndex%=1,Archive%=1)
  464.         Local sReturn$=NULL_STRING$
  465.         Local ReturnRecord.Records=GrabRecord.Records(RecordIndex,Archive)
  466.         If (ReturnRecord.Records<>Null)
  467.                 sReturn$=ReturnRecordReturned_Extension$
  468.         End If
  469.         DebugLine("CONFIGARCHIVE:GRABARCHIVERECORDEXTENSIONSTRING",DBG_ERC_NOT_AN_ERROR,False,"Retrieving record "+RecordIndex+" of archive: "+Str(Archive%)+" File Extension: "+Chr$(34)+sReturn$+Chr(34))
  470.         Return sReturn$                
  471. End Function
  472.  
  473. ;Returns the entire File path, name plus extension string stored in record
  474. Function GrabArchiveRecordEntireString$(RecordIndex=1,Archive%=1)
  475.         Local sReturn$=NULL_STRING$
  476.         Local ReturnRecord.Records=GrabRecord.Records(RecordIndex%,Archive%)
  477.         If (ReturnRecord.Records<>Null)
  478.                 sReturn$=EndDirPath$(ReturnRecordReturned_Path$)
  479.                 sReturn=sReturn$+ReturnRecordReturned_Filename$
  480.                 sReturn=sReturn$+ReturnRecordReturned_Extension$
  481.         End If
  482.         DebugLine("CONFIGARCHIVE:GRABARCHIVERECORDENTIRESTRING",DBG_ERC_NOT_AN_ERROR,False,"Retrieving entire record "+RecordIndex+" of archive: "+Str(Archive%)+SPACER$+sReturn$)
  483.         Return sReturn$                
  484. End Function
  485.  
  486. ;Returns the actual fileExtension stored in record
  487. Function GrabArchiveRecordFileType%(RecordIndex%=1,Archive%=1)
  488.         Local nReturn%=FILETYPE_INVALID
  489.         Local ReturnRecord.Records=GrabRecord.Records(RecordIndex,Archive)
  490.         If (ReturnRecord.Records<>Null)
  491.                 nReturn%=ReturnRecordReturned_FileType%
  492.         End If
  493.         DebugLine("CONFIGARCHIVE:GRABARCHIVERECORDFILETYPE",DBG_ERC_NOT_AN_ERROR,False,"Retrieving record "+RecordIndex+" of archive: "+Str(Archive%)+" File Type: "+Str(nReturn%))
  494.         Return nReturn%                
  495. End Function
  496.  
  497. ;**********************************************************
  498. ;System functions for the above to work. Not user-called.
  499.  
  500. Function AddFile(FullFilePath$,Archive%=1)
  501.        
  502.         FullFilePath$=FixPath$(FullFilePath$)
  503.        
  504.         Local AddRecords.Records
  505.         Local AddPath$=NULL_STRING$
  506.        
  507.         Local AddFileName$=NULL_STRING$
  508.         Local AddExtension$=NULL_STRING$
  509.         Local AddFileType%=FileType(FullFilePath$)
  510.        
  511.         AddPath$=FixPath$(GetContainerDir$(FullFilePath$),True)
  512.        
  513.         AddFileName$=FixPath$(GetFilename$(FullFilePath$))
  514.         AddExtension$=GetExtension$(AddFileName$)
  515.        
  516.         If (AddExtension$<>NULL_STRING$)
  517.                 AddFileName$=Left$(AddFileName$,Len(AddFileName$)-Len(AddExtension$))
  518.         End If
  519.        
  520.         If (AddFileType=FILETYPE_INVALID)
  521.                 DebugLine("CONFIGARCHIVE:ADDFILE",DBG_ERC_FILE_DELETE_MISSING,False,FullFilePath$)
  522.         Else
  523.                
  524.                 If (AddFileType=FILETYPE_DIRECTORY)
  525.                         AddPath$=FixPath$(AddPath$,True)
  526.                         AddFileName$=NULL_STRING
  527.                         AddExtension$=NULL_STRING
  528.                 End If
  529.                
  530.                 DebugLine("CONFIGARCHIVE:ADDFILE",DBG_ERC_NOT_AN_ERROR,False,"Adding "+FullFilePath$+" to archive: "+Str(Archive%))
  531.                
  532.                 AddRecords.Records=New Records
  533.                
  534.                 AddRecordsReturned_Path$=AddPath$
  535.                 AddRecordsReturned_Filename$=AddFileName$
  536.                 AddRecordsReturned_Extension$=AddExtension$
  537.                
  538.                 AddRecordsArchive%=Archive%
  539.                 AddRecordsReturned_FileType=AddFileType%
  540.         End If
  541.        
  542. End Function
  543.  
  544. Function CheckCriteria%(Recordstring$,CritString$,CriteriaType,Case_Insensitive%=True)
  545.        
  546.         If (Not(IGNORE))
  547.                 CritString$=Upper$(CritString$)
  548.                 Recordstring$=Upper$(Recordstring$)
  549.         End If
  550.        
  551.         Local ReturnCheck%=False
  552.         Local MaxCritTypes%=CountAllCritStrings%(CritString$)
  553.         If (MaxCritTypes%=0)
  554.                 CritString$=Replace(CritString$,CRITERIA_SEPARATOR$,NULL_STRING$)
  555.                 MaxCritTypes%=1        
  556.         End If
  557.         Local IterCrits%
  558.         For IterCrits%=1 To MaxCritTypes%
  559.                 ReturnCheck%=DoCheck%(CriteriaType%,ResolveStringPart$(CritString$,IterCrits),Recordstring$,ReturnCheck%)
  560.         Next           
  561.         Return ReturnCheck%
  562. End Function
  563.  
  564. Function DoCheck%(CriteriaType%,CritString$,Recordstring$,CurrentCheck%)
  565.        
  566.         ;DebugLine("CONFIGARCHIVE:DOCHECK",DBG_ERC_NOT_AN_ERROR,False,"Seeking matching criteria in "+Recordstring$)
  567.        
  568.         Local ORCheck%=False,ANDCheck%=False,NOTCheck%=False,SPECCheck%=False,ThisCheck%
  569.        
  570.         If (LogicCheck%(CriteriaType%,CRITERIA_OR%)) Then ORCheck%=(Instr(Recordstring$,CritString$))
  571.         If (LogicCheck%(CriteriaType%,CRITERIA_AND%))Then ANDCheck%=(Instr(Recordstring$,CritString$))
  572.        
  573.         If (LogicCheck%(CriteriaType%,CRITERIA_SPECIFIC%)) Then SPECCheck%=True
  574.         If (LogicCheck%(CriteriaType%,CRITERIA_NOT%))Then NOTCheck%=True
  575.        
  576.         If (ORCheck%) Then ThisCheck%=True
  577.         If (ANDCheck%) Then ThisCheck%=CurrentCheck%
  578.         If (SPECCheck) Then ThisCheck%=ThisCheck*(Recordstring$=CritString$)
  579.        
  580.         If (NOTCheck) Then ThisCheck=(Not(ThisCheck))
  581.        
  582.         If (ORCheck) Then ThisCheck%=(ThisCheck% Or CurrentCheck%)
  583.        
  584.         ;DebugLine("CONFIGARCHIVE:DOCHECK",DBG_ERC_NOT_AN_ERROR%,False,"Substring: "+CritString$+" considered: ("+Str(ThisCheck%)+")")
  585.         ;DebugLine("CONFIGARCHIVE:DOCHECK",DBG_ERC_NOT_AN_ERROR%,False,"Cumulative progress on: "+Recordstring$+" considered: ("+Str(CurrentCheck%)+")")
  586.        
  587.         Return ThisCheck%
  588.        
  589. End Function
  590.  
  591. Function LogicCheck%(Bit1,Bit2)
  592.         Return ((Bit1 And Bit2)=Bit2)
  593. End Function
  594.  
  595. Function CountAllCritStrings%(CritString$)
  596.         Local DebugFullstring$=CritString$
  597.         Local nCount%=0
  598.         Local Position%
  599.         If (CritString$<>NULL_STRING$)
  600.                 nCount%=nCount%+1
  601.                 Position%=(Instr(CritString$,CRITERIA_SEPARATOR$))
  602.                 While (Position)
  603.                         nCount%=nCount%+1
  604.                         CritString$=Right$(CritString$,Len(CritString$)-(Instr(CritString$,CRITERIA_SEPARATOR$,Position%)+2))
  605.                         Position%=(Instr(CritString$,CRITERIA_SEPARATOR$,Position%))
  606.                 Wend
  607.         End If
  608.         ;DebugLine("CONFIGARCHIVE:COUNTALLCRITSTRINGS",DBG_ERC_NOT_AN_ERROR%,False,"Total of "+nCount%+" substrings found within "+DebugFullstring$)
  609.         Return nCount%
  610. End Function
  611.  
  612. Function ResolveStringPart$(CritString$,Count%=1)
  613.         Local nCount%=0
  614.         If (Not(Instr(CritString,CRITERIA_SEPARATOR)) Or (Count%=1) Or (nCount%=Count%) Or (CritString$=NULL_STRING$))
  615.                 Return FixCriteria(CritString$)
  616.         End If
  617.         Local Position%=1
  618.         Local MyString$=CritString$
  619.         While(nCount%<Count%)
  620.                 Position%=Instr(CritString,CRITERIA_SEPARATOR,Position)
  621.                 nCount%=nCount%+1
  622.                 If ((nCount%=Count%) Or (Position%=0)) Then Exit
  623.                 MyString$=Left(CritString$,Position%-1)
  624.         Wend
  625.         Position%=Instr(MyString$,CRITERIA_SEPARATOR$,1)
  626.         If (Position%=1) Then Position%=Instr(MyString$,CRITERIA_SEPARATOR$,2)
  627.         If (Position%=0) Then Position%=-2
  628.         MyString$=FixCriteria$(Right(MyString,Len(MyString$)-(Position%+2)))
  629.         ;DebugLine("CONFIGARCHIVE:RESOLVESTRINGPARTS",DBG_ERC_NOT_AN_ERROR%,False,"Substring: "+Count%+" resolved as "+MyString$)
  630.         Return MyString$
  631. End Function
  632.  
  633. Function ArchiveOfRecord%(Record.Records)
  634.         If (Record.Records = Null) Then Return False
  635.         Return RecordArchive%
  636. End Function
  637.  
  638. Function ArchiveRecordValid%(Archive%=1,Record.Records)
  639.         Return (ArchiveOfRecord%(Record.Records)=Archive%)
  640. End Function
  641.  
  642. Function ArchiveRecordCount.Records(Archive%,CountIndex%)
  643.         Local Count%
  644.         Local CountRecords.Records
  645.         For CountRecords.Records=Each Records
  646.                 Count%=Count%+1
  647.                 If ((ArchiveRecordValid%(Archive%,CountRecords.Records)) And (Count%=CountIndex%)) Then Return CountRecords.Records
  648.         Next
  649.         Return Null
  650. End Function
  651.  
  652. Function FixCriteria$(CritString$)
  653.         Return Trim(Replace(CritString$,CRITERIA_SEPARATOR$,NULL_STRING$))
  654. End Function
  655.  
  656. Function GetContainerDir$(path$) ; Returns the Directory from the specifed path
  657.         Local iterbyte
  658.         For iterbyte = Len(path$) To 1 Step -1
  659.                 If ((Mid(path$,iterbyte,1)= PATH_SEPARATOR) Or (Mid(path$,iterbyte,1)= PATH_SEPARATOR_REVERSE))
  660.                         Return FixPath$(Left$(path$,iterbyte),True)
  661.                         Exit
  662.                 EndIf
  663.         Next
  664.         Return NULL_STRING$
  665. End Function
  666.  
  667. Function GetFilename$(path$) ; Returns the file from the specifed path
  668.         Local iterbyte%
  669.         For iterbyte% = Len%(path$) To 1 Step -1
  670.                 If ((Mid$(path$,iterbyte,1)= PATH_SEPARATOR) Or (Mid$(path$,iterbyte,1)=PATH_SEPARATOR_REVERSE))
  671.                         Return FixPath$(Right(path$,Len(path$)-iterbyte),False)
  672.                         Exit
  673.                 EndIf
  674.         Next
  675.         Return path$
  676. End Function
  677.  
  678. Function GetExtension$(FileName$) ; Returns the Extension from the specifed path or filename
  679.         If ((Instr(FileName$,EXTENSION_SEPARATOR)>0) And (Len%(FileName$)>2))
  680.                 Local nCount
  681.                 Local sReturn$=NULL_STRING$
  682.                 For nCount = Len%(FileName$) To 1 Step -1
  683.                         If (Mid$(FileName$,nCount,1)=EXTENSION_SEPARATOR)
  684.                                 sReturn$=FixPath$(Right$(Lower$(FileName$),Len(FileName$)-(nCount)),False)
  685.                                 Exit
  686.                         End If
  687.                 Next
  688.         End If
  689.         Return sReturn
  690. End Function
  691.  
  692. Function FixPath$(Path$,Dir%=False)
  693.         Path$=Replace$(Path$,PATH_SEPARATOR_REVERSE$,PATH_SEPARATOR$)
  694.         Path$=Replace$(Path$,PATH_SEPARATOR$+PATH_SEPARATOR$,PATH_SEPARATOR$)
  695.         If ((Right$(Path$,1)=PATH_SEPARATOR$)) Then Path$=Left$(Path$,Len(Path$)-1)
  696.         If (Dir%) Then Path$=EndDirPath$(Path$)
  697.         Return Path$
  698. End Function   
  699.  
  700. Function FixLink$(Path$)
  701.         Path$=Replace$(Path$,PATH_SEPARATOR$,PATH_SEPARATOR_REVERSE$)
  702.         Path$=Replace$(Path$,PATH_SEPARATOR_REVERSE$+PATH_SEPARATOR_REVERSE$,PATH_SEPARATOR_REVERSE$)
  703.         Path$=Replace$(Path$,NET_HTTP$+TIME_SEPARATOR$+PATH_SEPARATOR_REVERSE$,NET_HTTP$+TIME_SEPARATOR$+PATH_SEPARATOR_REVERSE$+PATH_SEPARATOR_REVERSE$)
  704.         If ((Right$(Path$,1)=PATH_SEPARATOR_REVERSE$)) Then Path$=Left$(Path$,Len(Path$)-1)
  705.         Return Path$
  706. End Function   
  707.  
  708. Function EndDirPath$(Path$)
  709.         If (Path$=NULL_STRING) Then Path$=CurrentDir()
  710.         If (Right$(Path$,1)<>PATH_SEPARATOR$)
  711.                 Path$=Path$+PATH_SEPARATOR$
  712.         End If
  713.         Return Path$
  714. End Function
  715.  
  716. Function FileTypeCriteriaValid(CurrentFileType%,CriteriaSelection%=FILETYPE_EITHER)
  717.         If CurrentFileType=FILETYPE_INVALID Then Return False
  718.         If (CriteriaSelection=FILETYPE_EITHER) Then Return True
  719.         Return (CriteriaSelection%=CurrentFileType%)
  720. End Function


Comments :


Bobysait(Posted 1+ years ago)

 What do you expect to happen with those statments ?"If Blablabla<<Null"I've never seen this kind of implementation in blitz3d/bmax...Whatever, error occures compiling this.


markcw(Posted 1+ years ago)

 He means "If Blablabla<>Null" probably added those checks right before posting and never tested it.


_PJ_(Posted 1+ years ago)

 Correct, Markcw - I had tested ut forgot to check for Nulls so I added those lines in and posted without re-testing...Curiously, it was compiling fine with IDEal so I never noticed the typo :SI've fixed the code now :)


_PJ_(Posted 1+ years ago)

 Updated with slightly less optimised but more robust handling.Various issues related to multiple criteria strings are now fixed. Criteria checking logic is updated too.


_PJ_(Posted 1+ years ago)

 Updated with some provision to increase stability and logic. Combining archive functinality has been improved and file data stream entries should no longer cause errors.As part of the update, however, the introduction of a hard limit was made. No more than 30 archives can be made, however, it's unlikely that so many would ever be needed. Especially as criteria can be used to add/combine and remove archives easily.I also partially incorporated my fdebugger functionality to allow for a log which can track hat's happening.


_PJ_(Posted 1+ years ago)

 oops - quick minor update:  fixed an issue where CountAllArchives would fail when 0 archives counted.


 

SimplePortal 2.3.6 © 2008-2014, SimplePortal