Read line x from a text file

[UEZ]

I don't know if something similar exists but here my version:

Code: Select all

'Coded by UEZ build 2024-03-20 beta

#include "file.bi"
#include "windows.bi"

Type tFile
	As WString * 4096 name
End Type

Function FileReadLine(sFile As tFile, iLine As ULong) As String '...'
	Dim As LongInt iFileSize = FileLen(sFile.name), i, c = 0
	If iFileSize < 1 Then Return ""
	Dim As UByte Ptr pMem
	Dim As Integer hFile = FreeFile()
	pMem = Allocate(iFileSize)
	Open sFile.name For Binary Access Read As #hFile
	Get #hFile, 0, pMem[0], iFileSize
	Close #hFile	
	Dim As String sResult
	Dim As LongInt iStart = 0, iEnd = 0
	While iEnd <= iFileSize 
		If pMem[iEnd] = &h0A Then 'check for LF = &h0A, CR = &h0D
			c += 1	
			If c = iLine Then
                If pMem[iEnd - 1] = &h0D Then iEnd -= 2
				For i = iStart To iEnd
                    sResult &= Chr(pMem[i])
				Next
				Exit While
			Else
				iStart = iEnd + 1
			End If
		End If
		iEnd += 1
	Wend

	If c + 1 = iLine Then 'check for last line
        If pMem[iFileSize - 1] = &h0D Then iFileSize -= 1
		For i = iStart To iFileSize - 1
            sResult &= Chr(pMem[i])
		Next
	End If
	
	Deallocate(pMem)
	Return sResult
End Function

Function FileReadLineW(sFile As tFile, iLine As ULong, bUniCode As BOOL = True) As WString Ptr
	Dim As LongInt iFileSize = FileLen(sFile.name), i, c = 0
	If iFileSize < 1 Then Return 0
	Dim As UByte Ptr pMem
	Dim As Integer hFile = FreeFile()
	pMem = Allocate(iFileSize)
	Open sFile.name For Binary Access Read As #hFile
	Get #hFile, 0, pMem[0], iFileSize
	Close #hFile
	Dim As String sResult
	Dim As LongInt iStart = 0, iEnd = 0
	While iEnd <= iFileSize 
		If pMem[iEnd] = &h0A Then 'check for LF = &h0A, CR = &h0D
			c += 1	
			If c = iLine Then
                If pMem[iEnd - 1] = &h0D Then iEnd -= 2
				For i = iStart To iEnd
                    sResult &= Chr(pMem[i])
				Next
				Exit While
			Else
				iStart = iEnd + 1
			End If
		End If
		iEnd += 1
	Wend

	If c + 1 = iLine Then 'check for last line
        If pMem[iFileSize - 1] = &h0D Then iFileSize -= 1
		For i = iStart To iFileSize - 1
            sResult &= Chr(pMem[i])
		Next
	End If
	
	If bUniCode Then    'Windows only
		Dim As WString Ptr pResultW
		pResultW = Allocate(Len(sResult) * SizeOf(WString))
		MultiByteToWideChar(CP_UTF8, 0, StrPtr(sResult), -1, pResultW, Len(sResult) * SizeOf(WString))
		Deallocate(pMem)
		Return pResultW
	EndIf
	Deallocate(pMem)
	Return Cast(WString Ptr, @sResult)
End Function

Dim As tFile sFile
sFile.name = "c:\Temp\UEZ.txt"
Dim As ULong iLine = 299
? "Printing line "
? iLine & ": >" & FileReadLine(sFile, iLine) & "<"
?
? "Unicode-----------------------------------"
sFile.name = "c:\Temp\text.txt"
iLine = 1
Dim As WString Ptr p = FileReadLineW(sFile, iLine)
? "Printing unicode line "
? iLine & ": >" & p[0] & "<"
Deallocate(p)
Sleep

Added unicode support for Window OS only.

[dodicat]

You have added an extra line end (chr(10)) to the last line in the file in 64 bits.
The last line looks strange in 32 bits.

Code: Select all

'Coded by UEZ build 2024-03-19 beta
#cmdline "-exx"
#include "file.bi"

Type tFile
	As WString * 4096 Name
End Type

Function FileReadLine(sFile As tFile, iLine As Ulong) As String
	Dim As Longint iFileSize = Filelen(sFile.name), i, c = 0
	If iFileSize < 1 Then Return ""
	Dim As Ubyte Ptr pMem
	Dim As Integer hFile = Freefile()
	pMem = Allocate(iFileSize)
	Open sFile.name For Binary Access Read As #hFile
	Get #hFile, 0, pMem[0], iFileSize
	Close #hFile	
	Dim As String sResult
	Dim As Longint iStart = 0, iEnd = 0
	While iEnd <= iFileSize 
		If pMem[iEnd] = &h0A Then 
			c += 1 'check for LF	
			If c = iLine Then
				For i = iStart To iEnd
					sResult &= Chr(pMem[i])
                Next
				Exit While
            Else
				iStart = iEnd + 1
            End If
        End If
		iEnd += 1
    Wend
	If c = iLine - 1 Then 'check for last line
		For i = iStart To iEnd
			sResult &= Chr(pMem[i])
        Next
    End If
	Deallocate(pMem)
	Return sResult
End Function

Function save (filename As String,p As String) As String
    Dim As Long n=Freefile
    If Open (filename For Binary Access Write As #n)=0 Then
        Put #n,,p
        Close
    Else
        Print "Unable to save " + filename:Sleep:End
    End If
    Return filename
End Function

Function load (file As String,Byref oneline As String="") As String
    Dim As Long  f=Freefile,count
    If Open (file For Binary Access Read As #f)=0 Then
        Dim As String text
        If Lof(f) > 0 Then
            count+=1
            text = String(Lof(f), 0)
            Get #f, , text
        End If
        Close #f
        Return text
    Else
        Print "Unable to load " + file:Sleep:End
    End If 
End Function

Function getline(filename As String,num As Long) As String
    Var txt=load(filename)
    Dim As Long count
    Dim As String t
    For n As Long=0 To Len(txt)-1
        If txt[n]=10 Then count+=1
        If count=num -1 Then
            if txt[n]<>10 then t+=Chr(txt[n])
            If txt[n+1]=10 Then t+=chr(10):return t
        End If
    Next
    Return t
End Function

sub printline(a as string)
    for  n as long=0 to len(a)-1
    print a[n];" ";
next
print
print
    end sub

Dim As String s
For n As Long=1 To 300
    s+="line "+Str(n)+Chr(13,10)
Next
s=rtrim(s,chr(10))
print "The last bit of the file :"
print ". . . ";
printline(mid(s,len(s)-20))
save("UEZ.txt",s)

Dim As tFile sFile
sFile.name = "UEZ.txt"
Dim As Ulong iLine = 100
dim as string a

a=FileReadLine(sFile, iLine)
? a
printline(a)
a=FileReadLine(sFile,1)
print a
printline(a)
a=FileReadLine(sFile,300)
print a
printline(a)
print "__________________________________________"
print
a=getline("UEZ.txt",100)
Print a
printline(a)

a=getline("UEZ.txt",1)
print a
printline(a)
a=getline("UEZ.txt",300)
print a
printline(a)
kill "UEZ.txt"
print "done . . ."
Sleep 

[UEZ]

@dodicat: thanks for you feedback. I had updated the code to cover also last line without LF. I tested only on x64 bit.

Let me check your version and my x86 version...

Edit: updated the code above - should work now.