Code:
'+--------------------------------------------------------------------------+ '| | '| BUFIN | '| | '| Fast line input replacement based on the core Windows API file I/O | '| | '| Adapted from the WinLIFT's skBufin function | | '| | '| "ZAP image solution" programming tools | '| | '+--------------------------------------------------------------------------+ '| | '| Author Patrice TERRIER | '| 8 Domaine de Rochagnon. 38800 Champagnier FRANCE | '| [url="http://www.zapsolution.com/winlift/index.htm"]http://www.zapsolution.com/winlift/index.htm[/url] | '| E-mail: [email protected] | '| | '| copyright (c) 2000 Patrice TERRIER | '| | '+--------------------------------------------------------------------------+ '| Project started on : 04-19-2000 | '| Last revised : 04-19-2000 | '+--------------------------------------------------------------------------+ ' ' This example shows how to use the Bufin$ function to read ' in a sequential ASCII text file. ' Text line can be delimited with a single CR or both CR+LF. ' ' This example works in console mode, you must use the MKCON.EXE utility ' to make it work from a DOS windows session. #COMPILE EXE #INCLUDE "WIN32API.INC" DECLARE FUNCTION GetStdHandle LIB "KERNEL32.DLL" ALIAS "GetStdHandle" (BYVAL nStdHandle AS LONG) AS LONG DECLARE FUNCTION WriteConsole LIB "KERNEL32.DLL" ALIAS "WriteConsoleA" (BYVAL hConsoleOutput AS LONG, lpBuffer AS ASCIIZ, BYVAL nNumberOfCharsToWrite AS LONG, lpNumberOfCharsWritten AS LONG, BYVAL lpReserved AS LONG) AS LONG %STD_OUTPUT_HANDLE = -11& GLOBAL zTmp AS ASCIIZ * 256 ' Determines the presence of a file. FUNCTION Exist& (BYVAL FileSpec$) EXPORT LOCAL fd AS WIN32_FIND_DATA IF LEN(FileSpec$) THEN hFind& = FindFirstFile(BYVAL STRPTR(FileSpec$), fd) IF hFind& <> %INVALID_HANDLE_VALUE THEN CALL FindClose(hFind&) FUNCTION = -1 END IF END IF END FUNCTION ' Changes the character being used as delimiter to read in a sequential text file. FUNCTION SetBufinChar$(BYVAL Char$) STATIC EXPORT IF LEN(Char$) THEN UserChar$ = Char$ IF LEN(UserChar$) THEN FUNCTION = UserChar$ ELSE FUNCTION = CHR$(13) END IF END FUNCTION ' Generic open file function FUNCTION FOpen& (BYVAL FilName$, BYVAL AccessMode&, BYVAL ShareMode&, hFile&) EXPORT '@'skdebug "98" zTmp = FilName$ AccessMode& = MIN(MAX(AccessMode&, 0), 2) ' Coherce between 0-2 IF AccessMode& = 0 THEN ' 0 Open for read only. AccessIs& = %GENERIC_READ ELSEIF AccessMode& = 1 THEN ' 1 Open for write only. AccessIs& = %GENERIC_WRITE ELSE ' 2 Open for read and write. AccessIs& = %GENERIC_READ OR %GENERIC_WRITE END IF ShareMode& = MIN(MAX(ShareMode&, 1), 4) ' Coherce between 1-4 IF ShareMode& = 1 THEN ' 1 Deny read/write access. ShareIs& = 0 ELSEIF ShareMode& = 2 THEN ' 2 Deny write access. ShareIs& = %FILE_SHARE_READ ELSEIF ShareMode& = 3 THEN ' 3 Deny read access. ShareIs& = %FILE_SHARE_WRITE ELSE ' 4 Deny none (full share mode). ShareIs& = %FILE_SHARE_READ OR %FILE_SHARE_WRITE END IF IF hFile& = -1 THEN FlagAndAttribute& = %FILE_ATTRIBUTE_NORMAL OR %FILE_FLAG_WRITE_THROUGH ELSE FlagAndAttribute& = %FILE_ATTRIBUTE_NORMAL END IF hFile& = CreateFile(zTmp, AccessIs&, ShareIs&, BYVAL %NULL, %OPEN_ALWAYS, FlagAndAttribute&, BYVAL %NULL) IF hFile& = %INVALID_HANDLE_VALUE THEN ' -1 Fail to create the file FUNCTION = GetLastError ' Set the error code hFile& = 0 ' Reset handle number END IF END FUNCTION ' Dito LOF FUNCTION Flof& (BYVAL hFile&) EXPORT IF GetFileType(hFile&) = %FILE_TYPE_DISK THEN fSize& = GetFileSize(hFile&, BYVAL %NULL) IF fSize& > -1& THEN FUNCTION = fSize& END IF END FUNCTION ' Dito SEEK FUNCTION FSeek& (hFile&, BYVAL PosByte&) EXPORT IF SetFilePointer(hFile&, PosByte&, BYVAL %NULL, %FILE_BEGIN) < 0 THEN FUNCTION = GetLastError END IF END FUNCTION ' Dito GET FUNCTION FGet& (BYVAL hFile&, Buf$) EXPORT IF hFile& THEN LenBuf& = LEN(Buf$) IF LenBuf& THEN IF ReadFile&(hFile&, BYVAL STRPTR(Buf$), LenBuf&, ByttesReaded&, BYVAL %NULL) = 0 THEN FUNCTION = GetLastError END IF END IF END IF END FUNCTION ' GET at a specific offset FUNCTION FGetAt& (BYVAL hFile&, BYVAL PosByte&, Buf$) EXPORT ErrCode& = FSeek(hFile&, PosByte&) IF ErrCode& = 0 THEN ErrCode& = FGet(hFile&, Buf$) FUNCTION = ErrCode& END FUNCTION ' Dito CLOSE SUB FClose (hFile&) EXPORT IF hFile& THEN CALL CloseHandle(hFile&) hFile& = 0 END SUB ' Enhanced sequential LINEINPUT FUNCTION Bufin$ (FilName$, Done&) STATIC EXPORT IF LEN(FilName$) THEN IF NOT Reading& THEN Cr$ = SetBufinChar$("") ' added for spec char Reading& = -1: Done& = 0 IF ASC(Cr$) = 13 THEN ' added for spec char LenCr& = 0: Cr$ = CHR$(13) ELSE ' added for spec char LenCr& = LEN(Cr$) ' added for spec char END IF ' added for spec char iCr& = 0: Location& = 0 IF NOT Exist(FilName$) THEN GOTO BufEnd ' Nothing to do ErrCode& = FOpen(FilName$, 0, 2, hFile&) IF ErrCode& THEN Done& = ErrCode&: Reading& = 0 EXIT FUNCTION END IF Remaining& = Flof(hFile&) ' Bytes count to be read SizeFile& = Remaining& ' Remember this IF Remaining& = 0 GOTO BufEnd ' Nothing to read BufSize& = 16384 Buffer$ = SPACE$(BufSize&) END IF DO WHILE Remaining& ' While more in the file IF iCr& = 0 THEN ' If no return was found IF Remaining& < BufSize& THEN ' read only what remains. BufSize& = Remaining& ' Resize the buffer. IF BufSize& < 1 THEN EXIT DO ' Possible only if EOF 26. Buffer$ = SPACE$(BufSize&) END IF ErrCode& = FGetAt&(hFile&, Location&, Buffer$) ' Read a bloc. Location& = Location& + BufSize& ' Here we are. BufPos& = 1 ' Start at the beginning END IF ' of that bloc. DO ' Walk through buffer. iCr& = INSTR(BufPos&, Buffer$, Cr$) ' Look for a Return. IF LenCr& = 0 THEN ' Do this to read files with LenCr& = 1 ' or without LF after CR. IF ASC(Buffer$, iCr& + 1) = 10 THEN LenCr& = 2 END IF IF iCr& THEN ' We found one. SaveCr& = iCr& ' Save where FUNCTION = MID$(Buffer$, BufPos&, iCr& - BufPos&) BufPos& = iCr& + LenCr& ' In case of LF skip it EXIT FUNCTION ' all done for now. ELSE ' Back up in the file. ' If we reached the end of file and no iCR& ' was found, return what remains in the string. IF Location& >= SizeFile& THEN ' Assign function and trap ^Z FUNCTION = RTRIM$(MID$(Buffer$, SaveCr& + LenCr&), CHR$(26)) Remaining& = BufSize& EXIT DO END IF ' 05-06-1998 () were missing on each side of (LenCr& - 1) Slop& = BufSize& - SaveCr& - (LenCr& - 1) ' Calc buffer excess. Remaining& = Remaining& + Slop& ' Calc file excess. Location& = Location& - Slop& END IF LOOP WHILE iCr& ' While more in buffer. Remaining& = Remaining& - BufSize& SaveCr& = 0 LOOP END IF BufEnd: Reading& = 0: Done& = -1: CALL FClose(hFile&) END FUNCTION FUNCTION WinMain& (BYVAL CurInst&, BYVAL PrvInst&, CmdL AS ASCIIZ PTR, BYVAL CmdShow&) EXPORT hOutput& = GetStdHandle(%STD_OUTPUT_HANDLE) FilName$ = "BUFIN.BAS" DO X$ = Bufin$(FilName$, Done&) + CHR$(13,10) Buffer& = STRPTR(X$) WriteConsole hOutput&, BYVAL Buffer&, LEN(X$), Written&, BYVAL 0& LOOP UNTIL Done& CALL Bufin$("", Done&) ' This can be used to close the handle ' before full file completion END FUNCTION
-------------
Patrice Terrier
mailto
[email protected][email protected]</A>