PureBasic Forums - English

Code: Select all

Procedure.i Parsecount( String$ , delim$ )
  Protected ii.i
  If Right(String$,1)<>delim$
    String$=string$+delim$
  EndIf  
  ii=CountString ( String$ , delim$ )
  ProcedureReturn ii
EndProcedure
;===================================================
Procedure parse(String$,Array sList$(1),delim$)
  Protected ii.i, k.i
  If Right(String$,1)<>delim$
    String$=string$+delim$
  EndIf  
  ii=parsecount (String$, delim$)
  For k = 1 To ii
    sList$(k)=StringField (String$, k, delim$)
  Next
EndProcedure
;=========================================================
 Procedure.i FileExists2(File.s)
  Protected Result
  If FileSize(File) > 0
    Result = #True
  Else
    Result = #False  ; Doesn't exist or a folder
  EndIf
  ProcedureReturn Result
EndProcedure
;========================================================
Procedure ImportMyFiles(myFileName.s, Delimiter.s) 
  Dim lines.s(1)
  Protected i.l, fnum.l, ii.l
  Dim RowValues.s(1)
  Dim lDate.l(1)
  Protected LastLine.l
  Protected sBigString.s
  Protected tempstr.s, sFileSpec.s
  Protected strlen.l, jj.l, NumofCols.l
  Protected dOOSDays.d, dTestDays.d
  Protected myFileSize.q
  ReDim lDate(3) 
    If FileExists2(myFileName)=0  
       MessageRequester( "File Error",myFileName+" does Not Exist")
       ProcedureReturn
    EndIf     
    fnum = 29  
    sBigString=""
;===============================================
;PowerBasic Code    
;    Open myFileName For Binary As #fnum
;    Get$ #fnum,Lof(fnum), BigString
;    Close #fnum
;===============================================    
    If ReadFile(fnum,myFileName)
      myFileSize=Lof(fnum)
      sBigString=ReadString(fnum,#PB_File_IgnoreEOL,myFileSize)
      CloseFile( fnum)
    EndIf    
    Dim lines(ParseCount(sBigString,#LF$))
    LastLine=ParseCount(sBigstring,#LF$)
  ; get all lines in the file
    PARSE (sBigString, lines(), #LF$)
    Dim Rowvalues(50)
    Parse (lines(1),RowValues(),"," )
  ;Setup gCvsArr
    LastLine = ArraySize(lines())
  ;Check If PB put LastLine as nothing 
    If  Len(lines(lastline))=0 : LastLine=LastLine-1 : EndIf
  ;Check For comma on End of Line(1) If so delete it    
    If (Right(lines(1), 1) = ",") 
      lines(1) = Left(lines(1), Len(lines(1)) - 1)
    EndIf ;check For comma on End    
    gCsvCols=ParseCount(lines(1),",")
    gCsvRows=LastLine
    Dim gCsvArr(gCsvRows, gCsvCols)
    For i = 1 To gCsvRows
     ;Check For comma on end.. if so delete it
      If (Right(lines(i), 1) = ",")
            lines(i) = Left(lines(i), Len(lines(i)) - 1)
      EndIf ;check For comma on End
   
      PARSE (lines(i), RowValues(), ",")
      For jj = 1 To gCsvCols
        gCsvArr(i jj) = RowValues(jj)
      Next jj      
    Next i
  sBigString="" ;Release string memory
  FreeArray( lines())
  FreeArray( rowvalues())
EndProcedure

Code: Select all

Procedure.i MySplitString(s.s, multiCharSep.s, Array a.s(1))
  ; last substring is not necesseraly followed by a char-sep
  Protected count, i, soc, lnStr,lnBStr, lnSep,lnBSep, ss, ee
  
  soc     = SizeOf(Character)
  lnSep   = Len(multiCharSep) :   lnBSep  = lnSep * soc
  lnStr   = Len(s)            :   lnBStr  = lnStr * soc
  If lnStr <= 0               :   ProcedureReturn 0       : EndIf
  
  count   = CountString(s,multiCharSep)
  If count <= 0
    Dim a(1) : a(1) = s : ProcedureReturn 1
  EndIf
  
  If Right(s,lnSep) <> multiCharSep : count + 1 : EndIf 
  
  Dim a(count) ; a(0) is ignored
  
  i = 1: ss = 0: ee = 0
  While ee < lnBStr
    If CompareMemory(@s + ee, @multiCharSep, lnBSep)
      a(i) = PeekS(@s + ss, (ee-ss)/soc)
      ss = ee + lnBSep: ee = ss: i+1
    Else
      ee + soc
    EndIf
  Wend
  
  If i < count+1: a(count) = PeekS(@s + ss, (ee-ss)/soc) : EndIf
  ProcedureReturn count ;return count of substrings
  
EndProcedure