PureBasic Forums - English

Code: Select all

; ---------------------------------------------------------------
; Open IncludeFile - Popup Tool for PB Editor 
; by horst.schaeffer@gmx.net
; ---------------------------------------------------------------
#title = "InclOpen"
#version = " Version 1.62"  ; 03.JUL 2004 
      ; supports relative IncludeFile paths, 
      ; Option /S (sort by file name)

IncludePath "C:\source\purebasic\downloaded code\filebuffer\"
XIncludeFile "FileBuffer.pbi" 

PBfile.s = ProgramParameter()         ; PB source 
DefPath.s = GetPathPart(PBfile)       ; initial (default) IncludePath
If Right(DefPath,1) <> "\" : DefPath + "\" : EndIf
InclPath.s = DefPath
If UCase(ProgramParameter()) = "/S" : Sort = 1 : EndIf 

If FileSize(PBfile) < 0 
  MessageBox_(0,#title+#version+Chr(13)+"by Horst Schaeffer"+Chr(13)+Chr(13)+"See Readme.txt",#title,#MB_ICONASTERISK)
  End   
EndIf 

; ---------------------------------------------------------------
;- Handling functions
; ---------------------------------------------------------------

Procedure.s GetQstring(pos) ; get quoted string, strip quote marks 
  Shared line.s 
  While PeekB(@line+pos-1) = ' ' : pos+1 : blanks+1 : Wend 
  If blanks And PeekB(@line+pos-1) = '"'
    StartPos = pos+1
    Repeat 
      pos +1
      If PeekB(@line+pos-1) = '"'
        s.s = Mid(line,StartPos,pos-StartPos)
      EndIf
    Until s Or pos >= Len(line) 
  EndIf 
ProcedureReturn s
EndProcedure 

Global NewList item.s()

Procedure AddToSortList(name.s) ; add fname w/path, but sort by name only
  ResetList(item())
  uName.s = UCase(GetFilePart(name))
  Repeat
    If NextElement(item())
      If uName < UCase(GetFilePart(item())) 
        InsertElement(item()) : done = 1
      EndIf 
    Else 
      AddElement(item()) : done = 1
    EndIf 
  Until done 
  item() = name
EndProcedure 

; ---------------------------------------------------------------
;- Main 
; ---------------------------------------------------------------

If OpenWindow(0,0,0,1,1,#title,#WS_POPUP|#PB_Window_Invisible) = 0 : End : EndIf 
CreatePopupMenu(0) 

If LoadFileToMem(0,PBfile)
  While MoreInMem()
    line.s = ReadLineFromMem()
    lineL.s = LCase(line)
    ; catch IncludePath .. statement ---------------------------------
    pos = FindString(lineL,"includepath",1)   ; ignore case 
    If pos : Path.s = GetQstring(pos+11) 
      If Path 
        If Right(Path,1) <> "\" : Path + "\" : EndIf
        If Mid(Path,2,1) <> ":" : Path = DefPath + Path : EndIf 
        If Left(line,pos-1) = Space(pos-1) ; nothing but spaces preceding?
          InclPath = Path                  ; take it for following IncludeFile's
        EndIf 
      EndIf 
    Else 
    ; catch [X]IncludeFile statements --------------------------------
      pos = FindString(lineL,"includefile",1) 
      If pos 
        fname.s = GetQstring(pos+11)
        ; nothing but spaces preceding, or "x"?
        If pos > 1 And PeekB(@lineL+pos-2) = 'x' : pos -1 : EndIf 
        If Left(line,pos-1) = Space(pos-1) And fname 
          If Mid(fname,2,1) <> ":" : fname = InclPath + fname : EndIf 
          If Sort 
            AddToSortList(fname)
          Else 
            AddElement(item()) : item() = fname
          EndIf 
        EndIf 
      EndIf 
    EndIf 
  Wend 
  CloseFileMem()
EndIf 

ForEach item()
  MenuItem(index,GetFilePart(item()))
  OutputDebugString_(item())
  index+1
Next  

If index
  DisplayPopupMenu(0, WindowID(0)) 
  count = GetTickCount_()
  Repeat 
    If WindowEvent() = #PB_Event_Menu 
      SelectElement(item.s(),EventMenu())
      ShellExecute_(WindowID(0),"open",item(),"","",#SW_SHOW)
      End 
    EndIf 
  Until GetTickCount_() - count > 1000 
EndIf 
End

Code: Select all

; ---------------------------------------------------------------
; File Buffer for fast line reading 
; The complete file is read into the buffer, and closed while 
; the file remains in memory. 
; End of line codes supported: CR+LF or LF+CR or CR or LF only  
; by Horst Schaeffer - horst.schaeffer@gmx.net
; ---------------------------------------------------------------
; Version 27 May 2004: Bugfix: now missing CR/LF at end of file
; is handled correctly.

Global MemFileOffset.l, MemFileSize.l  
; you can use MemFileOffset (to save/restore or reset to 0) 

; Special feature: 
; If fname = "", the file (fileID) is assumed open, and will not be closed.
; This way you can re-write the file while reading
; (to rewrite: FileSeek(0) at start, and SetEndOfFile_(handle) at end

Procedure LoadFileToMem(fileID,fname.s) 
  ;Protected fileID, fname 
  Shared *FileBuffer
  MemFileOffset = 0 : MemFileSize = 0
  If fname = "" Or ReadFile(fileID,fname)
    FileID(fileID)
    MemFileSize = Lof(fileID)
    *FileBuffer = AllocateMemory(MemFileSize)
    If *FileBuffer : ReadData(fileID, *FileBuffer,MemFileSize) : EndIf 
    If fname : CloseFile(fileID) : EndIf 
  EndIf 
ProcedureReturn *FileBuffer ; returns 0 if no memory
EndProcedure 

Procedure MoreInMem()
  If MemFileOffset < MemFileSize : ProcedureReturn 1 : EndIf 
EndProcedure 

Procedure.s ReadLineFromMem()  
  Protected Length, *pt.BYTE, *endPt, *strPt.BYTE 
  Shared *FileBuffer
  Length = 0 
  *pt = *FileBuffer + MemFileOffset     ; current scan point
  *endPt = *FileBuffer + MemFileSize
  *strPt = *pt                          ; will be @string
  If *FileBuffer 
    While *pt < *endPt
      c = *pt\b : *pt +1  
      If c = 13 : Break : EndIf 
      If c = 10 : Break : EndIf
      Length +1
    Wend 
    If *pt < *endPt                     ; 2nd byte of CR+LF or LF+CR ? 
      n = *pt\b
      If n+c = 23 : *pt +1 : EndIf       ; cr + lf or lf + cr  (10+13)
    EndIf 
    MemFileOffset = *pt - *FileBuffer
  EndIf 
ProcedureReturn PeekS(*strPt,Length)     ; in case EOF: empty line is returned
EndProcedure 

Procedure CloseFileMem()
  Shared *FileBuffer
  If *FileBuffer : FreeMemory(*FileBuffer) : EndIf 
EndProcedure