/***
* Fbrwsdef.ch
*
* Translates para simular la sub-clase del browse de ficheros
*/
#xtranslate :fileHandle => :cargo\[1\]
#xtranslate :fileLine => :cargo\[2\]
#xtranslate :lineOffset => :cargo\[3\]
* Futils.ch
// Posici¢n actual del fichero
#xtranslate FTell(<fHandle>) => FSeek(<fHandle>, 0, 1)
IF SINO = 1
FIN_REP()
IF !EMPTY(ARCH_EXP)
bDEVICE = SET(20)
COPY FILE (VER_REP) TO (ARCH_EXP)+".TXT"
MENSAJE("SE CREO EL ARCHIVO "+ALLTRIM(ARCH_EXP)+".TXT"+" "+"EN EL DIRECTORIO "+CURDIR())
ENDIF
VER(VER_REP, 0,0,22,79)
ELSE
RUN NODOSIMP &WREPORTE
CERRAR('R_ANTSDO')
ENDIF
SELECT 99
USE
FERASE(NEWDBF1)
FERASE(NEWNTX1)
FERASE(VER_REP)
ENDIF
**************************************************************
*--------- FUNCION QUE LEE ARCHIVOS ASCI A 64 BITS ----------*
**************************************************************
#include "Fbrwsdef.ch"
// El nombre del fichero es pasado como par metro
*-----------------------------------------
FUNCTION VER(cFname, LIN1,COL1, LIN2,COL2)
LOCAL COLORc:=SetColor('W/N ,N/W,,,W/B')
LOCAL oTbr, oTbc
LOCAL lExitRequested := .F.
LOCAL cSearcher, nSavefPos
LOCAL nKey
LOCAL GetList := {}
SET SCOREBOARD OFF
IF cFname == NIL .OR. !File(cFname)
Alert("Sintaxis: FBTest <cFileName>")
QUIT
ENDIF
SUBSTm:='P_'+SUBSTR(cFNAME,3,10)
*COPY FILE (cFNAME) TO (SUBSTm)
* @ 23,1 SAY "F2-B£squeda adelante F3-B£squeda atr s Pgup-Arriba PgDn-Abajo " COLOR 'N/W'
CAJACONV(LIN1,COL1,LIN2,COL2,'W+/W','N/W','')
@ 23,1 SAY "F2-B£squeda adelante F3-B£squeda atr s Pgup-Arriba PgDn-Abajo " COLOR 'N/W'
IF (oTbr := FBrowseNew()) != NIL
FBrowseOpen(oTbr, cFname)
oTbr:nTop := 1
oTbr:nLeft := 1
oTbr:nBottom := 21
oTbr:nRight := 78
oTbc:= TBColumnNew(, {|| SubStr(oTbr:fileLine, oTbr:lineOffset) })
*oTbr:colorSpec ="G/N,W+/R,N,N,B/W,R/B,B/R,R/B,B/R"
oTbr:colorSpec ="W/B,W+/R,N,N,B/W,R/B,B/R,R/B,B/R"
oTbc:width := 78
oTbr:addColumn(oTbc)
cSearcher := Space(20)
DO WHILE !lExitRequested
DO WHILE !oTbr:stabilize()
ENDDO
SET CURSOR OFF
nKey := InKey(0)
DO CASE
CASE nKey == 27
lExitRequested := .T.
CASE nKey == 19 //IZQUIERDA
IF oTbr:lineOffset > 1
oTbr:lineOffset--
oTbr:refreshall()
ENDIF
CASE nKey == 4 // DERECHA
IF oTbr:lineOffset < len(oTbr:fileLine)
oTbr:lineOffset++
oTbr:refreshall()
ENDIF
CASE nKey == 1 // INICIO
oTbr:lineOffset := 1
oTbr:refreshall()
CASE nKey == 6 // FIN
oTbr:lineOffset := Max(1, Len(oTbr:fileLine) - oTbc:width + 1)
oTbr:refreshAll()
CASE nKey == 9 // TABULADOR
IF oTbr:lineOffset <= Len(oTbr:fileLine) - 10
oTbr:lineOffset += 10
oTbr:refreshAll()
ENDIF
CASE nKey == 271 // TABULADOR
oTbr:lineOffset := MAX(1, oTbr:lineOffset - 10)
oTbr:refreshall()
CASE nKey == -1 // F2
SET CURSOR ON
@ 24, 0
@ 24, 10 SAY "Introduzca la clave de b£squeda hacia delante" GET cSearcher PICT '@K'
READ
@ 24, 0
IF FrwdSrch(oTbr, Trim(cSearcher))
oTbr:refreshAll()
ELSE
MENSAJE('No Encontrado')
ENDIF
CASE nKey == -2 // F3
SET CURSOR ON
@ 24, 0
@ 24, 10 SAY "Introduzca la clave de b£squeda hacia atras" GET cSearcher PICT '@K'
READ
@ 24, 0
IF BkwdSrch(oTbr, Trim(cSearcher))
nSavefPos := FilePos(oTbr)
oTbr:refreshAll()
DO WHILE !oTbr:stabilize()
ENDDO
DO WHILE FilePos(oTbr) != nSavefPos
oTbr:up()
DO WHILE !oTbr:stabilize()
ENDDO
ENDDO
ELSE
MENSAJE('No Encontrado')
ENDIF
*CASE nKey == -4 // F5
*TYPE (SUBSTm) TO PRINTER
*CASE nKey == -8 // F9
* LB_CALCULADORA()
OTHERWISE
IF StdMeth(oTbr, nKey)
// Manejador est ndar de teclas
ELSE
// Se ignoran otras
ENDIF
ENDCASE
ENDDO
* FERASE(SUBSTm)
SET CURSOR ON
SETCOLOR(COLORc)
CLEAR SCREEN
SET PRINTER TO
ENDIF
RETURN NIL
*--------------------
FUNCTION FilePos(oTbr)
RETURN FTell(oTbr:fileHandle)
*-------------------
FUNCTION FBrowseNew
LOCAL oTbr := TBrowseNew()
oTbr:cargo := Array(3)
oTbr:lineOffset := 1
oTbr:goTopBlock := {| | FileGoFirst(oTbr) }
oTbr:goBottomBlock := {| | FileGoLast(oTbr) }
oTbr:skipBlock := {|n| FileSkip(n, oTbr) }
RETURN (oTbr)
*------------------------------------
FUNCTION FBrowseOpen(oTbr, cFileName)
LOCAL fHandle := FOpen(cFileName)
IF fHandle >= 0
oTbr:fileHandle := fHandle
FileGoFirst(oTbr)
ENDIF
RETURN ( fHandle > 0 )
// Ir a la primera l¡nea del fichero y leerla en oTbr:fileLine
*----------------------------------
STATIC PROCEDURE FileGoFirst(oTbr)
LOCAL cLine
LOCAL fHandle := oTbr:fileHandle
FSeek(fHandle, 0, 0)
* * FReadLn(fHandle, @cline, 256) * ( * MODIFICADO ADRIANO * )
FReadLn(fHandle, @cline, 512)
oTbr:fileLine := cLine
FSeek(fHandle, 0, 0)
RETURN NIL
// Ir a la £ltima l¡nea del fichero y leerla en oTbr:fileLine
*--------------------------------
STATIC PROCEDURE FileGoLast(oTbr)
FSeek(oTbr:fileHandle, 0, 2)
GoPrevLn(oTbr)
RETURN NIL
// Salta n l¡neas en el fichero. n puede ser positivo o negativo.
// Devuelve el n£mero de l¡neas que se ha movido
*---------------------------------
STATIC FUNCTION FileSkip(n, oTbr)
LOCAL nSkipped := 0
SET COLOR TO 'G/N'
IF n > 0
DO WHILE nSkipped != n .AND. GoNextLn(oTbr)
nSkipped++
ENDDO
ELSE
DO WHILE nSkipped != n .AND. GoPrevLn(oTbr)
nSkipped--
ENDDO
ENDIF
RETURN (nSkipped)
// Intenta moverse a la siguiente l¡nea del fichero
// Devuelve .T. si lo consigue, sino .F.
// Tiene que ser p£bica por la rutina de b£squeda
*-----------------------
FUNCTION GoNextLn(oTbr)
LOCAL fHandle := oTbr:fileHandle
LOCAL nSavePos := FTell(fHandle), cBuff := "", lMoved, nNewPos
FSeek(fHandle, Len(oTbr:fileLine) + 2, 1)
nNewPos := FTell(fHandle)
* * IF FReadLn(fHandle, @cBuff, 256) * ( * MODIFICADO ADRIANO * )
IF FReadLn(fHandle, @cBuff, 512)
lMoved := .T.
oTbr:fileLine := cBuff
FSeek(fHandle, nNewPos, 0)
ELSE
lMoved := .F.
FSeek(fHandle, nSavePos, 0)
ENDIF
RETURN (lMoved)
// Tiene que ser p£blica por las rutinas de b£squeda
*----------------------
FUNCTION GoPrevLn(oTbr)
LOCAL fHandle := oTbr:fileHandle
LOCAL nOrigPos := FTell(fHandle), nMaxRead, nNewPos, ;
lMoved, cBuff, nWhereCrLf, nPrev, cTemp
IF nOrigPos == 0
lMoved := .F.
ELSE
lMoved := .T.
// Comprobar los 2 caracteres precedentes para CR / LF
FSeek(fHandle, -2, 1)
cTemp := Space(2)
FRead(fHandle, @cTemp, 2)
IF cTemp == CHR(13)+CHR(10)
FSeek(fHandle, -2, 1)
ENDIF
nMaxRead := MIN(512, FTell(fHandle))
cBuff := Space(nMaxRead)
nNewPos := FSeek(fHandle, -nMaxRead, 1)
FRead(fHandle, @cBuff, nMaxRead)
nWhereCrLf := Rat(CHR(13)+CHR(10), cBuff)
IF nWhereCrLf == 0
nPrev := nNewPos
oTbr:fileLine := cBuff
ELSE
nPrev := nNewPos + nWhereCrLf + 1
oTbr:fileLine := SubStr(cBuff, nWhereCrLf + 2)
ENDIF
FSeek(fHandle, nPrev, 0)
ENDIF
RETURN (lMoved)
// Devuelve si lo encotr¢ o no - busca hacia adelante
// Si lo encuentra, asigna a cLine la l¡nea actual y
// coloca el puntero al comienzo de lo encontrado
// Si no se encuentra, no hay cambios
*-------------------------------
FUNCTION FrwdSrch(oTbr, cString)
LOCAL fHandle := oTbr:fileHandle
LOCAL lFound := .F.
LOCAL nSavePos := FTell(oTbr:fileHandle)
LOCAL cSavecLine := oTbr:fileLine
DO WHILE !lFound .AND. GoNextLn(oTbr)
lFound := cString $ oTbr:fileLine
ENDDO
IF !lFound
FSeek(fHandle, nSavePos, 0)
oTbr:fileLine := cSavecLine
ENDIF
RETURN (lFound)
// Devuelve si lo encotr¢ o no - busca hacia atras
// Si lo encuentra, asigna a cLine la l¡nea actual y
// coloca el puntero al comienzo de lo encontrado
// Si no se encuentra, no hay cambios
*--------------------------------
FUNCTION bkwdSrch(oTbr, cString)
LOCAL lFound := .F.
LOCAL fHandle := oTbr:fileHandle
LOCAL nSavePos := FTell(fHandle)
LOCAL cSavecLine := oTbr:fileLine
DO WHILE !lFound .AND. GoPrevLn(oTbr)
lFound := cString $ oTbr:fileLine
ENDDO
IF !lFound
FSeek(fHandle, nSavePos, 0)
oTbr:fileLine := cSavecLine
ENDIF
RETURN (lFound)
/***
* FReadLn(fHandle, cBuffer, nMaxLine)
*
* --> Lógico - .T. Si se ha leido total o parcialmente.
* .F. implica fin de fichero
*
* fHandle - El devuelto por FOpen()
* cBuffer - Buffer para la l¡nea (pasado por referencia)
* nMaxLine - Longitud de la l¡nea m s larga
*
* La funci¢n intenta leer una l¡nea del fichero especificado
* por fHandle. Supone que la l¡nea esta terminada por un CR/LF.
* Devuelve la l¡nea en el par metro cBuffer, que debe ser
* pasado por referencia. Esta versi¢n utiliza un buffer para
* mejorar el rendimiento.
*/
*--------------------------------------------
FUNCTION FReadLn(fHandle, cBuffer, nMaxLine)
LOCAL cLine, nEol, nNumRead, nSavePos
cLine := Space(nMaxLine)
cBuffer := ""
// Guardar la posici¢n actual para b£squeda posterior
nSavePos := FTell(fHandle)
nNumRead := FRead(fHandle, @cLine, nMaxLine)
IF (nEol := At(CHR(13)+CHR(10), SubStr(cLine, 1, nNumRead))) == 0
cBuffer := cLine
ELSE
cBuffer := SubStr(cLine, 1, nEol - 1) // Copiar hasta fin de l¡nea
// Nos posicionamos en la siguiente l¡nea (saltamos LF)
FSeek(fHandle, nSavePos + nEol + 1, 0)
ENDIF
RETURN (nNumRead != 0) //NOTA: Si no se pudo leer la £ltima l¡nea, eof
*---------------------------
FUNCTION StdMeth(oTbr, nKey)
LOCAL lKeyHandled := .T.
DO CASE
CASE nKey == 24; oTbr:down()
CASE nKey == 5; oTbr:up()
CASE nKey == 3; oTbr:pageDown()
CASE nKey == 18; oTbr:pageUp()
CASE nKey == 31; oTbr:goTop()
CASE nKey == 30; oTbr:goBottom()
CASE nKey == 4; oTbr:right()
CASE nKey == 19; oTbr:left()
CASE nKey == 1; oTbr:home()
CASE nKey == 6; oTbr:end()
CASE nKey == 26; oTbr:panLeft()
CASE nKey == 2; oTbr:panRight()
CASE nKey == 29; oTbr:panHome()
CASE nKey == 23; oTbr:panEnd()
OTHERWISE; lKeyHandled := .F.
ENDCASE
RETURN lKeyHandled