PureBasic Forums - English

Code: Select all

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

Global idx.l,list_limit.l,filefmax
list_limit=4096
filefmax=2
Global Dim outfile.s(64550)
Global Dim filefilter.s(filefmax)
Global Dim x_dir_list.s(list_limit)

filefilter(0)="*\plugins\*"
filefilter(1)="*\help_code\*"
filefilter(2)="*\VD_PRJ\*"
;--------------------------------------------------------------------------------------------------
;
;--------------------------------------------------------------------------------------------------
Procedure OpenPBSource(filename.s)
  
  path.s=GetPathPart(filename)
  For i=0 To filefmax
    Debug(filefilter(i))
    If(path=filefilter(i))
      ProcedureReturn       
    EndIf
    If(FindString(filefilter(i),"*",0)<>0)
      cfilter.s=RemoveString(filefilter(i),"*")
      
      If(FindString(path,cfilter,0)<>0)
        ProcedureReturn
      Else
        Debug("X")
      EndIf
    EndIf
  Next     
  
  If(OpenFile(0,filename)<>0)
    
    outfile(idx)=";--------------------------------------------------------------------------------------------------" : idx+1
    outfile(idx)="; "+filename : idx+1
    outfile(idx)=";--------------------------------------------------------------------------------------------------" : idx+1
    
    While Eof(0)=0
      readln:
      ln.s=ReadString(0)
      If(FindString(ln,"Procedure ",0)<>0) And (FindString(ln,"EndProcedure ",0)=0)
        idx+1
        outfile(idx)=ReplaceString(ln,"Procedure ","Declare ")
        Goto readln
      EndIf
      If(FindString(ln,"Procedure.",0)<>0) And (FindString(ln,"EndProcedure ",0)=0)
        idx+1
        outfile(idx)=ReplaceString(ln,"Procedure.","Declare.")
        Goto readln
      EndIf
    Wend
    
    idx+1
    
    CloseFile(0)
  Else
    Debug("Can't open file : "+filename)
  EndIf   
EndProcedure
;--------------------------------------------------------------------------------------------------
;
;--------------------------------------------------------------------------------------------------
Procedure GetFileList(path.s)
  If Right(path.s,1)<>"\"
    path = path + "\"
  EndIf
  ;
  folder_n = 1
  x_dir_list(list_limit-folder_n) = path            ; store paths back to front
  file_n = 0
  ;
  While folder_n > 0
    folder.s = x_dir_list(list_limit-folder_n)
    x_dir_list(list_limit-folder_n)=""              ; << comment out when done debugging
    folder_n = folder_n-1
    If ExamineDirectory(nr,folder,"*.*") 
      file_added = 0     
      folder_added = 0
      Repeat
        type.l = NextDirectoryEntry(nr)
        If Left(DirectoryEntryName(nr),1)="."
        ElseIf type = 1
          file_added = file_added+1
          x_dir_list(file_n+file_added) = folder+DirectoryEntryName(nr)
        ElseIf type = 2
          folder_added = folder_added+1
          x_dir_list(list_limit-folder_n-folder_added) = folder+DirectoryEntryName(nr)+"\"
        Else
        EndIf
        If (folder_n+file_n+folder_added+file_added) >= list_limit-4    ; too many entries for the list
          limit_reached = #True
        EndIf
      Until type = 0 Or limit_reached = #True
      If file_added > 0
        SortArray(x_dir_list(),2,file_n+1,file_n+file_added)
        file_n = file_n+file_added
      EndIf
      If folder_added > 0
        SortArray(x_dir_list(),2,list_limit-folder_n-folder_added,list_limit-folder_n-1)
        folder_n = folder_n+folder_added
      EndIf
      ;
    EndIf
  Wend
  ProcedureReturn file_n
EndProcedure
;--------------------------------------------------------------------------------------------------
;
;--------------------------------------------------------------------------------------------------

file_n=GetFileList("D:\_Projects\FlameGet\")

For n = 1 To file_n
  If(FindString(LCase(x_dir_list(n)),".pb",0)<>0)
    OpenPBSource(x_dir_list(n))
  EndIf
Next n

CreateFile(0,"dump.pb")
For i=0 To idx
  WriteStringN(0,outfile(i))
Next
CloseFile(0)