Código: Selecionar todos
#include <hbclass.ch>
#include <fileio.ch>
#include <ferror.ch>
#define true .T.
#define false .F.
#define _CRLF chr(13) + chr(10)
#define ESC 27
CLASS TIni
export:
VAR File INIT ""
VAR Handle INIT 0
VAR Aberto INIT false
VAR Separador INIT ""
VAR Ferror INIT 0
VAR FileExist INIT false
VAR WriteOpen INIT 0
VAR WriteCount INIT 0
VAR WriteSuccess INIT false
VAR ReadSuccess INIT false
export:
METHOD New CONSTRUCTOR
DESTRUCTOR Destroy()
METHOD ReadBool
METHOD ReadInteger
METHOD ReadString
METHOD ReadDate
METHOD WriteIni
METHOD Close
METHOD Open
METHOD ShowVar
MESSAGE Write METHOD WriteIni
MESSAGE WriteBool METHOD WriteIni
MESSAGE WriteInteger METHOD WriteIni
MESSAGE WriteString METHOD WriteIni
MESSAGE WriteDate METHOD WriteIni
MESSAGE Free METHOD Close
MESSAGE Create METHOD New
ENDCLASS
METHOD ShowVar()
/*
AlertaPy(;
"Variaveis TINI;-;" + ;
" ::file # " + ::file + ';' + ;
" ::handle # " + formatavar(::Handle) + ';' + ;
" ::aberto # " + formatavar(::Aberto) + ';' + ;
" ::ferror # " + formatavar(::Ferror) + ';' + ;
" ::fileexist # " + formatavar(::FileExist)+ ';' + ;
" ::writeopen # " + formatavar(::WriteOpen)+ ';' + ;
" ::writecount # " + formatavar(::WriteCount)+ ';' + ;
"::writeSuccess # " + formatavar(::WriteSuccess)+ ';' + ;
"::readSuccess # " + formatavar(::ReadSuccess)+ ';' + ;
" ::separator # " + formatavar(::Separador), 31, false ;
)
*/
return self
METHOD Destroy( cFile )
self := nil
return self
METHOD New( cFile )
*******************
::File := cFile
::Separador := ';'
if rat( ".", ::File ) == 0
::File := alltrim( cFile ) + ".ini"
endif
::Open()
//::Close()
return self
METHOD Close()
*****************
fclose(::Handle)
::Ferror := ferror()
::Aberto := false
return( ::Ferror == 0 )
METHOD Open()
***************
if (::Handle := fopen( ::File, FO_READWRITE + FO_SHARED) ) == F_ERROR
::Ferror := ferror()
endif
if ::Ferror == FERROR_FILENOTFOUND .OR. !(file(::File))
::Handle := Fcreate( ::File, 0 )
::Ferror := ferror()
endif
::FileExist := file(::File)
::Aberto := true
return(::Aberto)
METHOD WriteIni( cSection, cKey, xValue )
*****************************************
LOCAL lRetCode, ;
cType, ;
cOldValue, ;
cNewValue, ;
cBuffer, ;
nFileLen, ;
nSecStart, ;
nSecEnd, ;
nSecLen, ;
cSecBuf, ;
nKeyStart, ;
nKeyEnd, ;
nKeyLen, ;
lProceed, ;
cChar
if LEFT( cSection, 1 ) <> chr(91) // [
cSection := chr(91) + cSection
endif
if RIGHT( cSection, 1 ) <> chr(93) // ]
cSection += chr(93) //"]"
endif
lProceed := lRetCode := false
nSecLen := 0
cType := VALTYPE( xValue )
DO CASE
CASE cType == "C"
cNewValue := ALLTRIM(xValue)
CASE cType == "N"
cNewValue := ALLTRIM( STR( xValue ))
CASE cType == "L"
cNewValue := if( xValue, "1", "0" )
CASE cType == "D"
cNewValue := DTOS( xValue )
OTHERWISE
cNewValue := hb_valtostr(xValue)
ENDCASE
if !(::Aberto)
::Open()
::Aberto := true
endif
if ::Handle > 0
::WriteOpen++
nFileLen := fseek( ::Handle, 0, FS_END )
fseek( ::Handle, 0 , FS_SET )
cBuffer := Space( nFileLen )
if fread( ::Handle, @cBuffer, nFileLen ) == nFileLen
nSecStart := AT( cSection, cBuffer )
if nSecStart > 0
nSecStart += LEN( cSection ) + 2 // Length of cSection + CR/LF
cSecBuf := RIGHT( cBuffer, nFileLen - nSecStart + 1 )
if !EMPTY( cSecBuf )
nSecEnd := AT( chr(91), cSecBuf )
if nSecEnd > 0
cSecBuf := LEFT( cSecBuf, nSecEnd - 1 )
endif
nSecLen := LEN( cSecBuf )
nKeyStart := AT( cKey, cSecBuf )
if nKeyStart > 0
nKeyStart += LEN( cKey ) + 1
nKeyEnd := nKeyStart
cOldValue := cChar := ""
while cChar <> CHR(13)
cChar := SUBSTR( cSecBuf, nKeyEnd, 1 )
if cChar <> CHR(13)
cOldValue += cChar
++ nKeyEnd
endif
enddo
nKeyLen := LEN( cOldValue )
cSecBuf := STUFF( cSecBuf, nKeyStart, nKeyLen, cNewValue )
lProceed := .T.
else
cSecBuf := cKey + "=" + cNewValue + _CRLF + cSecBuf
lProceed := .T.
endif
endif
else
cSecBuf := cSection + _CRLF + cKey + "=" + cNewValue + _CRLF + _CRLF
lProceed := .T.
endif
endif
if lProceed
if nSecStart == 0
nSecStart := LEN( cBuffer )
endif
cBuffer := STUFF( cBuffer, nSecStart, nSecLen, cSecBuf )
fseek( ::Handle, 0 , FS_SET )
//if !FTruncate( ::Handle )
// ::Close()
// ::Handle := Fcreate( ::File, 0 )
//endif
if fwrite( ::Handle, cBuffer ) == LEN( cBuffer )
::WriteSuccess := true
::WriteCount++
lRetCode := .T.
endif
endif
endif
//::Close()
return lRetCode
METHOD ReadString( cSection, cKey, cDefault, nPos )
***************************************************
LOCAL cString, cBuffer, nFileLen, nSecPos
LOCAL cSecBuf, nKeyPos, cChar
LOCAL xTemp
LOCAL lRetCode := false
if LEFT( cSection, 1 ) <> "["
cSection := "[" + cSection
endif
if RIGHT( cSection, 1 ) <> "]"
cSection += "]"
endif
if cDefault == NIL
cDefault := ""
endif
cString := cDefault
if !(::Aberto)
::Open()
::Aberto := true
endif
if ::Handle > 0
nFileLen := fseek(::Handle, 0, FS_END )
fseek( ::Handle, 0 , FS_SET )
cBuffer := SPACE( nFileLen )
if fread( ::Handle, @cBuffer, nFileLen ) == nFileLen
nSecPos := AT( cSection, cBuffer )
if nSecPos > 0
cSecBuf := RIGHT( cBuffer, nFileLen - ( nSecPos + LEN( cSection )))
if !EMPTY( cSecBuf )
nSecPos := AT( chr(91), cSecBuf )
if nSecPos > 0
cSecBuf := LEFT( cSecBuf, nSecPos - 1 )
endif
nKeyPos := AT( cKey, cSecBuf )
if nKeyPos > 0
nKeyPos += LEN( cKey ) + 1
cString := cChar := ""
while cChar <> CHR(13)
cChar := SUBSTR( cSecBuf, nKeyPos, 1 )
if cChar <> CHR(13)
cString += cChar
++ nKeyPos
endif
ENDDO
endif
endif
endif
endif
//::Close()
endif
if nPos = nil .or. nPos = 0
::readSuccess := false
lRetCode := true
return cString
else
xTemp := StrExtract( cString, ::Separador, nPos )
if Empty( xTemp )
::readSuccess := false
return( cDefault )
endif
::readSuccess := true
return( xTemp )
endif
METHOD ReadBool( cSection, cKey, lDefault, nPos )
*************************************************
LOCAL cValue, cDefault, nValue
if lDefault == NIL
lDefault := FALSO
endif
cValue := ::ReadString( cSection, cKey, nPos )
if EMPTY( cValue )
return( lDefault )
endif
return ( nValue := VAL( cValue )) == 1
METHOD ReadDate( cSection, cKey, dDefault, nPos )
*******************************************
LOCAL cDateFmt, cValue, cDefault, dDate
if VALTYPE( dDefault ) <> "D"
dDefault := CTOD( "" )
endif
dDate := dDefault
cDefault := ALLTRIM( DTOS( dDefault ))
cValue := ::ReadString( cSection, cKey, cDefault, nPos )
if !EMPTY( cValue )
dDate := CTOD( cValue )
if EMPTY( dDate )
cDateFmt := SET(_SET_DATEFORMAT, "mm/dd/yy" )
dDate := CTOD( SUBSTR( cValue, 5, 2 ) + "/" + RIGHT( cValue, 2 ) + "/" + LEFT( cValue, 4 ))
SET(_SET_DATEFORMAT, cDateFmt )
endif
endif
return dDate
METHOD ReadInteger( cSection, cKey, nDefault, nPos )
****************************************************
LOCAL cValue, cDefault, nValue
if nDefault == NIL
nDefault := 0
endif
nValue := nDefault
cDefault := ALLTRIM( STR( nDefault ))
cValue := ::ReadString( cSection, cKey, cDefault, nPos )
if !EMPTY( cValue )
nValue := VAL( cValue )
endif
return nValue
Function TIniNew( cFile )
*************************
return( TIni():New( cFile ))
static function StrExtract( string, delims, ocurrence )
**************************************************
LOCAL nInicio := 1
LOCAL nConta := GT_StrCount(delims, string)
LOCAL aArray := {}
LOCAL aNum := {}
LOCAL nLen := Len(delims)
LOCAL cChar := Repl('%',nLen)
LOCAL cNewStr := String
LOCAL nPosIni := 1
LOCAL aPos
LOCAL nFim
LOCAL x
LOCAL nPos
if cChar == delims
cChar := Repl("*",nLen)
endif
if nConta = 0 .AND. ocurrence > 0
return(string)
endif
aPos := aStrPos(string, Delims)
nConta := Len(aPos)
For x := 1 to nConta
nInicio := aPos[x]
if x = 1
cString := Left(String, nInicio-1)
else
nFim := aPos[x-1]
cString := SubStr(String, nFim+1, nInicio-nFim-1)
endif
Aadd( aArray, cString)
Next
nConta := Len(aArray)
if ocurrence > nConta .OR. oCurrence = 0
return(string)
endif
return(aArray[ocurrence])
static function aStrPos(string, delims)
***************************************
LOCAL nConta := GT_StrCount(delims, string)
LOCAL nLen := Len(delims)
LOCAL cChar := Repl("%",nLen)
LOCAL aNum := {}
LOCAL x
if cChar == delims
cChar := Repl("*",delims)
endif
if nConta = 0
return(aNum)
endif
FOR x := 1 To nConta
nPos := At( Delims, string )
string := Stuff(string, nPos, 1, cChar)
Aadd( aNum, nPos)
Next
Aadd( aNum, Len(string)+1)
return(aNum)
function main()
Exemplo1()
Exemplo2()
Exemplo3()
function Exemplo1()
LOCAL cFile := 'exemplo.ini'
LOCAL oEtiqueta := TIniNew( cFile)
LOCAL nCampos := oEtiqueta:ReadInteger('configuracao', 'Campos', 8)
LOCAL aGets := {}
LOCAL nX := 0
for nX := 1 To nCampos
Aadd( aGets, nX )
next
oEtiqueta:WriteDate('sistema', 'DataInicio', Date())
oEtiqueta:WriteBool('sistema', 'Registrado', true)
oEtiqueta:WriteString('configuracao', 'Campos', StrZero( nCampos, 2))
oEtiqueta:WriteString('configuracao', 'Tamanho', StrZero( aGets[1], 3))
oEtiqueta:WriteString('configuracao', 'Margem', StrZero( aGets[2], 3))
oEtiqueta:WriteString('configuracao', 'Linhas', StrZero( aGets[3], 2))
oEtiqueta:WriteString('configuracao', 'Espacos', StrZero( aGets[4], 3))
oEtiqueta:WriteString('configuracao', 'Carreira', StrZero( aGets[5], 2))
oEtiqueta:WriteString('configuracao', 'Comprimir', StrZero( aGets[6], 1))
oEtiqueta:WriteString('configuracao', 'Vertical', StrZero( aGets[7], 1))
oEtiqueta:Close()
return nil
function Exemplo2()
LOCAL GetList := {}
LOCAL cScreen := SaveScreen()
LOCAL cFile := 'cfop.ini'
LOCAL cFop := Space(05)
LOCAL cNatu := Space(20)
LOCAL nTx_Icms := 0
LOCAL nCampos := 0
LOCAL cBuffer
LOCAL oCfop
//oMenu:Limpa()
cls
while true
cFop := Space(05)
cNatu := Space(20)
nTx_Icms := 0
DispBox( 10, 10, 14, 52 )
@ 11, 11 Say "Cfop..............:" Get cFop Pict '9.999' //Valid VerCfop( cFop )
@ 12, 11 Say "Natureza Operacao.:" Get cNatu Pict '@!' //Valid oFn:Valid({||!Empty(cNatu)}, nil)
@ 13, 11 Say "Taxa Icms.........:" Get nTx_Icms Pict '99.99' //Valid oFn:Valid({||!Empty(nTx_Icms)}, nil)
Read
if LastKey() = ESC
return
endif
if hb_alert('Pergunta: Incluir registro ?', {"Sim", "Nao"}, 31, 0) == 1
oCfop := TIniNew( cFile )
nCampos := oCfop:ReadInteger("configuracao", "campos", 0 )
nCampos++
cTx_Icms := Tran( nTx_Icms, '99.99')
cBuffer := cFop
cBuffer += ';'
cBuffer += cTx_Icms
cBuffer += ';'
cBuffer += cNatu
oCfop:WriteInteger("configuracao", "campos", nCampos )
oCfop:WriteString("campos","campo" + StrZero( nCampos, 3 ), cBuffer )
oCFop:Close()
//oCFop:ShowVar()
endif
enddo
function Exemplo3()
LOCAL cFile := 'cfop.ini'
LOCAL aCfop := {'0.000','5.102','6.102','5.915', '6.915'}
LOCAL nCampos := 0
LOCAL n := 0
LOCAL cCfop := ''
LOCAL oCfop
oCfop := TIniNew( cFile )
nCampos := oCfop:ReadInteger("configuracao", "campos", 8 )
for n := 1 To nCampos
cCfop := oCfop:ReadString("campos", "campo" + StrZero(n, 3), "", 1)
cNatu := oCfop:ReadString("campos", "campo" + StrZero(n, 3), "", 2)
nIcms := oCfop:ReadInteger("campos", "campo" + StrZero(n, 3), 0, 3)
Aadd( acfop, cCFop )
Qout(n, '=>', cCFop, cNatu, nIcms)
next
oCfop:Close()
return( acFop )