' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Remove File Lines V1.1                            '
'                                                   '
' Developed by A. David Garza Marín in VB-DOS for   '
' RosettaCode. November 30, 2016.                   '
'                                                   '
' Date      | Change                                '
'-------------------------------------------------- '
' 2016/11/30| Original version                      '
' 2016/12/30| Added functionality to read parameters'
'           | from Command Line                     '
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

'OPTION _EXPLICIT ' For QB45
OPTION EXPLICIT ' For VBDOS, PDS 7.1

' SUBs and FUNCTIONs
DECLARE FUNCTION DeleteLinesFromFile% (WhichFile AS STRING, Start AS LONG, HowMany AS LONG)
DECLARE FUNCTION FileExists% (WhichFile AS STRING)
DECLARE FUNCTION GetDummyFile$ (WhichFile AS STRING)
DECLARE FUNCTION getFileName$ (CommandString AS STRING)
DECLARE FUNCTION getHowManyLines& (CommandLine AS STRING)
DECLARE FUNCTION getStartPoint& (CommandLine AS STRING)
DECLARE FUNCTION ErrorMessage$ (WhichError AS INTEGER)
DECLARE FUNCTION CountLines& (WhichFile AS STRING)

' Var
DIM iOk AS INTEGER, iErr AS INTEGER, lStart AS LONG, lHowMany AS LONG, lSize AS LONG
DIM sFile AS STRING, sCommand AS STRING

' Const
CONST ProgramName = "RemFLine (Remove File Lines) Enhanced V1.1"

' ----------------------------- Main program cycle --------------------------------
CLS
PRINT ProgramName
PRINT
PRINT "This program will remove as many lines of a text file as you state, starting"
PRINT "with the line number you also state. If the starting line number is beyond"
PRINT "total lines in the text file stated, then the process will be aborted. If the"
PRINT "quantity of lines stated to be deleted is beyond the total lines in the text"
PRINT "file, the process also will be aborted. The program will give you a message"
PRINT "if everything ran ok or if any error happened. Includes a function to count"
PRINT "how many lines has the intended file."
' Verifies if parameters are specified
sCommand = COMMAND$
IF sCommand <> "" THEN
  sFile = getFileName$(sCommand)
  lSize = CountLines&(sFile)
  lStart = getStartPoint&(sCommand)  ' Defaults to 1
  lHowMany = getHowManyLines&(sCommand) ' Defaults to 1
ELSE
  PRINT
  INPUT "Please, type the name of the file"; sFile
  sFile = LTRIM$(RTRIM$(sFile))
  IF sFile <> "" THEN
    lSize = CountLines&(sFile)
    IF lSize > 0 THEN
      PRINT "Delete starting on which line (Default=1, Max="; lSize; ")";
      INPUT lStart

      IF lStart = 0 THEN lStart = 1
      IF lStart < lSize THEN
        PRINT "How many lines do you want to remove (Default=1, Max="; (lSize - lStart) + 1; ")";
        INPUT lHowMany
        IF lHowMany = 0 THEN lHowMany = 1
      END IF
    END IF
  END IF
END IF

PRINT
PRINT "Erasing "; lHowMany; "lines from "; sFile; " starting on line"; lStart; "."
IF lSize > 0 THEN
  IF lHowMany + lStart <= lSize THEN
    iOk = DeleteLinesFromFile%(sFile, lStart, lHowMany)
  ELSEIF lHowMany + lStart > lSize THEN
    iOk = 1
  ELSEIF lStart > lSize THEN
    iOk = 2
  END IF
ELSEIF lSize = -1 THEN
  iOk = 3
END IF

IF lSize = -1 THEN
  iOk = 3
ELSEIF lSize = 0 THEN
  iOk = 4  ' The file is not a text file
END IF

IF sFile = "" THEN
  iOk = 5  ' Null file name not allowed
END IF

PRINT
PRINT ErrorMessage$(iOk)
'----------------End of Main program Cycle ----------------

END

FileError:
    iErr = ERR
RESUME NEXT

FUNCTION CountLines& (WhichFile AS STRING)
    ' Var
    DIM iFile AS INTEGER
    DIM l AS LONG, li AS LONG, j AS LONG, lFileSize AS LONG, lLines AS LONG
    DIM sLine AS STRING, strR AS STRING

    ' This function will count how many lines has the file
    IF FileExists%(WhichFile) THEN
        strR = CHR$(13)
        li = 1
        iFile = FREEFILE
        sLine = SPACE$(128)
        lLines = 0
        OPEN WhichFile FOR BINARY AS #iFile
          lFileSize = LOF(iFile)
          DO
            IF (LOC(iFile) + LEN(sLine)) > lFileSize THEN
              sLine = SPACE$(lFileSize - LOC(iFile))
            END IF
            IF LEN(sLine) > 0 THEN
              GET #iFile, , sLine
              GOSUB AnalizeLine
            END IF
          LOOP UNTIL LEN(sLine) < 128
        CLOSE iFile
    ELSE
        lLines = -1
    END IF

    CountLines& = lLines

EXIT FUNCTION

AnalizeLine:
   li = 1
   DO
     l = INSTR(li, sLine, strR)
     IF l > 0 THEN
       lLines = lLines + 1
       li = l + 1
     END IF
   LOOP UNTIL l = 0
RETURN
END FUNCTION

FUNCTION DeleteLinesFromFile% (WhichFile AS STRING, Start AS LONG, HowMany AS LONG)
    ' Var
    DIM lCount AS LONG, iFile AS INTEGER, iFile2 AS INTEGER, lhm AS LONG, iError AS INTEGER
    DIM sLine AS STRING, sDummyFile AS STRING

    IF FileExists%(WhichFile) THEN
        sDummyFile = GetDummyFile$(WhichFile)

        ' It is assumed a text file
        iFile = FREEFILE
        OPEN WhichFile FOR INPUT AS #iFile

        iFile2 = FREEFILE
        OPEN sDummyFile FOR OUTPUT AS #iFile2

        lhm = 0
        DO WHILE NOT EOF(iFile)
            LINE INPUT #iFile, sLine
            lCount = lCount + 1
            IF lCount >= Start AND lhm < HowMany THEN
                lhm = lhm + 1
            ELSE
                PRINT #iFile2, sLine
            END IF
        LOOP

        CLOSE iFile2, iFile

        ' Check if everything went ok or not
        iError = 0
        IF lCount < Start THEN
            iError = 2 ' Full file is shorter than the start line stated,
                       '  process will be aborted.
        ELSEIF lhm < HowMany THEN
            iError = 1 ' File was shorter than lines requested to be removed,
                       '  process will be aborted.
        END IF

        IF iError > 0 THEN
          KILL sDummyFile  ' Process aborted
        ELSE
          KILL WhichFile
          NAME sDummyFile AS WhichFile
        END IF
    ELSE
      iError = 3 ' The file doesn't exist. The process is aborted.
    END IF

    DeleteLinesFromFile% = iError

END FUNCTION

FUNCTION ErrorMessage$ (WhichError AS INTEGER)
    ' Var
    DIM sError AS STRING

    SELECT CASE WhichError
      CASE 0: sError = "Everything went Ok. Lines removed from file."
      CASE 1: sError = "File is shorter than the number of lines stated to remove. Process aborted."
      CASE 2: sError = "Whole file is shorter than the starting point stated. Process aborted."
      CASE 3: sError = "File doesn't exist. Process aborted."
      CASE 4: sError = "The file doesn't seem to be a text file. Process aborted."
      CASE 5: sError = "You need to provide a valid file name, please."
    END SELECT

    ErrorMessage$ = sError
END FUNCTION

FUNCTION FileExists% (WhichFile AS STRING)
    ' Var
    DIM iFile AS INTEGER
    DIM iItExists AS INTEGER
    SHARED iErr AS INTEGER

    ON ERROR GOTO FileError
    iFile = FREEFILE
    iErr = 0
    OPEN WhichFile FOR BINARY AS #iFile
    IF iErr = 0 THEN
        iItExists = LOF(iFile) > 0
        CLOSE #iFile

        IF NOT iItExists THEN
            KILL WhichFile
        END IF
    END IF
    ON ERROR GOTO 0
    FileExists% = iItExists

END FUNCTION

FUNCTION GetDummyFile$ (WhichFile AS STRING)
    ' Var
    DIM i AS INTEGER, j AS INTEGER

    ' Gets the path specified in WhichFile
    i = 1
    DO
        j = INSTR(i, WhichFile, "\")
        IF j > 0 THEN i = j + 1
    LOOP UNTIL j = 0

    GetDummyFile$ = LEFT$(WhichFile, i - 1) + "$dummyf$.tmp"
END FUNCTION

FUNCTION getFileName$ (CommandString AS STRING)
  ' Var
  DIM i AS INTEGER
  DIM sFileName AS STRING

  i = INSTR(CommandString, ",")
  IF i > 0 THEN
    sFileName = LEFT$(CommandString, i - 1)
  ELSEIF LEN(CommandString) > 0 THEN
    sFileName = CommandString
  END IF

  getFileName$ = sFileName
END FUNCTION

FUNCTION getHowManyLines& (CommandLine AS STRING)
  ' Var
  DIM i AS INTEGER, j AS INTEGER
  DIM l AS LONG

  i = INSTR(CommandLine, ",")
  IF i > 0 THEN
    j = INSTR(i + 1, CommandLine, ",")
    IF j = 0 THEN
      l = 1
    ELSE
      l = CLNG(VAL(MID$(CommandLine, j + 1)))
    END IF
  END IF

  getHowManyLines& = l

END FUNCTION

FUNCTION getStartPoint& (CommandLine AS STRING)
  ' Var
  DIM i AS INTEGER, j AS INTEGER
  DIM l AS LONG

  i = INSTR(CommandLine, ",")
  IF i > 0 THEN
    j = INSTR(i + 1, CommandLine, ",")
    IF j = 0 THEN j = LEN(CommandLine)
    l = CLNG(VAL(MID$(CommandLine, i + 1, j - i)))
  ELSE
    i = 1
  END IF

  getStartPoint& = l

END FUNCTION