BlackTDN :: BTDNReguaTXT : Régua para arquivo Texto

Postado por иαldσ dj agosto 26, 2012

BlackTDN :: BTDNReguaTXT : Régua para arquivo Texto

Dias desses precisei desenvolver uma rotina para importação de um arquivo texto com muitas colunas e o editor de texto que estava utilizando para verificar o arquivo não possuía uma régua que me possibilitasse verificar o posicionamento das colunas e, em função disto, desenvolvi os três programas abaixo para me auxiliar na criação de uma régua que seria “plotada” no arquivo texto de forma a facilitar a identificação das colunas. O interessante nos programas são:

Compilação condicional;
Verificação de limites; e
Formas diferentes de obter o mesmo resultado.

Ei-los:

u_regua01.prg

   1: #IFDEF TOTVS

   2:     #include "totvs.ch"

   3: #ELSE

   4:     #IFDEF PROTHEUS

   5:         #include "protheus.ch"

   6:     #ELSE

   7:         //compile:

   8:         //http://harbour-project.sourceforge.net/

   9:         //set include=%include%;c:\hb32\include\

  10:         //c:\hb32\bin\hbmk2.exe u_regua /dHARBOUR

  11:         //c:\hb32\bin\upx.exe u_regua.exe

  12:         #include "hb.ch"

  13:         #include "common.ch"

  14:         #include "fileio.ch"

  15:     #ENDIF

  16: #ENDIF

  17: #IFNDEF CRLF

  18:     #IFDEF HARBOUR

  19:         #DEFINE CRLF HB_OsNewLine()

  20:     #ELSE

  21:         #DEFINE CRLF CHR(13)+CHR(10)

  22:     #ENDIF

  23: #ENDIF

  24: /*

  25:     Programa    : U_Regua

  26:     Função      : Main/U_Regua

  27:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

  28:     Data        : 17/08/2012

  29:     Uso         : Regua para Arquivo Texto

  30: */

  31: #IFDEF HARBOUR

  32: Function Main( uBuffer )

  33:     #DEFINE MAX_BUFFER Int(((784384766*8)-(1073741824*3.68))/8) //(  Unrecoverable error 9009: hb_xrealloc can't reallocate memory )

  34:     Local nBuffer

  35:     DEFAULT uBuffer TO 220

  36: #ELSE

  37: User Function Regua01( uBuffer )

  38:     #DEFINE MAX_BUFFER (1048575) //( + 1: String size overflow! )

  39:     Local nBuffer

  40:     DEFAULT uBuffer := 220

  41: #ENDIF

  42:     if (ValType(uBuffer)=="C")

  43:         uBuffer := Val(uBuffer)

  44:     endif

  45:     nBuffer := Min(MAX_BUFFER,uBuffer)

  46: Return( Regua( nBuffer ) )

  47: /*

  48:     Programa    : U_Regua

  49:     Função      : Regua

  50:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

  51:     Data        : 17/08/2012

  52:     Uso         : Regua para Arquivo Texto

  53: */

  54: Static Function Regua(nBuffer)

55:

  56:     Local aB

57:

  58:     Local c05

  59:     Local c10

60:

  61:     Local cfH

62:

  63:     Local cCRLF

  64:     Local cRegua

65:

  66:     Local l05

  67:     Local l10

68:

  69:     Local n05

  70:     Local n10

  71:     Local n10I

72:

  73:     Local nfH

  74:     Local nRep

75:

  76:     n10     := (nBuffer/10)

  77:     n10I    := Int(n10)

  78:     nRep    := (n10I+(((n10)-n10I)*10))

  79:     nRep    := Min(nRep,9999999999)

  80:     cRegua  := SubStr(Replicate("1234567890",nRep),1,nBuffer)

  81:     aB      := StrToKArr(cRegua,"0")

82:

  83:     aFill(aB,NIL)

84:

  85:     c05     := ""

  86:     c10     := ""

87:

  88:     n05     := 0

  89:     n10     := 0

90:

  91:     aEval(aB,{|x,y| n05 := (y*5) ,;

  92:                     n10 := (y*10),;

  93:                     l05 := ( n05 <= 99999 ),;

  94:                     IF( l05 , c05 += Transform(n05,"99999") , NIL ),;

  95:                     l10 := ( n10 <= 9999999999 ),;

  96:                     IF( l10 , c10 += Transform(n10,"9999999999") , NIL );

  97:               };

  98:     )

99:

 100:     aEval(aB,{|x,y| l05 := ( ( n05 += 5 ) <= 99999 ),;

 101:                     IF( l05 , c05 += Transform(n05,"99999") , NIL );

 102:               };

 103:     )

 104:

 105:     aSize(aB,0)

 106:

 107:     aB := NIL

 108:

 109:     c05 := SubStr(c05,1,(Int(Min(99999,nbuffer)/5)*5))

 110:     c10 := SubStr(c10,1,(Int(Min(9999999999,nbuffer)/10)*10))

 111:

 112: #IFDEF HARBOUR

 113:     cfH := GetCurrentFolder()

 114:     IF .NOT.(subStr(cfH,-1)==hb_ps())

 115:         cfH += hb_ps()

 116:     EndIF

 117: #ELSE

 118:     cfH        := GetTempPath()

 119:     IF .NOT.(subStr(cfH,-1)$"\/")

 120:         IF ("/"$cfH)

 121:             cfH += "/"

 122:         Else

 123:             cfH += "\"

 124:         EndIF

 125:     EndIF

 126: #ENDIF

 127:     cfH += ProcName()

 128:     cfH += "-"

 129:     cfH += LTrim(Str(nBuffer))

 130:     cfH += "-"

 131:     cfH += DtoS(Date())

 132:     cfH += "-"

 133:     cfH += StrTran(Time(),":","-")

 134:     cfH += ".txt"

 135:

 136:     nfH        := fCreate(Lower(cfH))

 137:

 138:     if .NOT.(NtoL(fError()))

 139:         cCRLF  := CRLF

 140:         fWrite( nfH , c10 + cCRLF )

 141:         fWrite( nfH , c05 + cCRLF )

 142:         fWrite( nfH , cRegua + cCRLF )

 143:         fWrite( nfH , c05 + cCRLF )

 144:         fWrite( nfH , c10 + cCRLF )

 145:         fClose( nfH )

 146:     endif

 147:

 148: return({cRegua,c05,c10})

 149:

 150: #IFDEF HARBOUR

 151: /*

 152:     Programa    : U_Regua

 153:     Função      : StrToKArr

 154:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

 155:     Data        : 17/08/2012

 156:     Uso         : Transforma String em Array conforme Token

 157: */

 158: Static Function StrToKArr( cString , cToken , bEvalToken )

 159:

 160:     Local aStrTokArr := {}

 161:

 162:     Local cStr

 163:

 164:     Local nATToken

 165:     Local nRealSize

 166:

 167:     DEFAULT cToken        TO "+"

 168:     DEFAULT bEvalToken    TO { || .T. }

 169:

 170:     if ( at( cToken , cString ) > 0 )

 171:         nRealSize    := len( cToken )

 172:         while ( ( nATToken := at( cToken , cString ) ) > 0 )

 173:             if ( nATToken > 1 )

 174:                 cStr := allTrim( subStr( cString , 1 , ( nATToken - 1 ) ) )

 175:                 cString := subStr( cString , ( nATToken + nRealSize ) )

 176:             Else

 177:                 cStr := ""

 178:                 cString := subStr( cString , ( nATToken + nRealSize ) )

 179:             endif

 180:             if eval( bEvalToken , @cStr )

 181:                 aAdd( aStrTokArr , cStr )

 182:             endif

 183:         end while

 184:         if ( len( cString ) > 0 )

 185:             cStr := cString

 186:             if eval( bEvalToken , @cStr )

 187:                 aAdd( aStrTokArr , cStr )

 188:             endif

 189:         endif

 190:     Else

 191:         cStr := cString

 192:         if eval( bEvalToken , @cStr )

 193:             aAdd( aStrTokArr , cStr )

 194:         endif

 195:     endif

 196:

 197: return( aStrTokArr )

 198:

 199: /*

 200:     Programa    : U_Regua

 201:     Função      : NtoL

 202:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

 203:     Data        : 17/08/2012

 204:     Uso         : Numerico para Logico

 205: */

 206: Static Function NtoL(n)

 207: Return(.NOT.(Empty(n)))

 208:

 209: /*

 210:     Programa    : U_Regua

 211:     Função      : GetCurrentFolder

 212:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

 213:     Data        : 17/08/2012

 214:     Uso         : Retornar o Diretorio Corrente

 215: */

 216: Static Function GetCurrentFolder()

 217: Return( hb_CurDrive() + hb_osDriveSeparator() + hb_ps() + CurDir() )

 218:

 219: #ENDIF

u_regua02.prg

   1: #IFDEF TOTVS

   2:     #include "totvs.ch"

   3: #ELSE

   4:     #IFDEF PROTHEUS

   5:         #include "protheus.ch"

   6:     #ELSE

   7:         //compile:

   8:         //http://harbour-project.sourceforge.net/

   9:         //set include=%include%;c:\hb32\include\

  10:         //c:\hb32\bin\hbmk2.exe u_regua /dHARBOUR

  11:         //c:\hb32\bin\upx.exe u_regua.exe

  12:         #include "hb.ch"

  13:         #include "common.ch"

  14:         #include "fileio.ch"

  15:     #ENDIF

  16: #ENDIF

  17: #IFNDEF CRLF

  18:     #IFDEF HARBOUR

  19:         #DEFINE CRLF HB_OsNewLine()

  20:     #ELSE

  21:         #DEFINE CRLF CHR(13)+CHR(10)

  22:     #ENDIF

  23: #ENDIF

  24: /*

  25:     Programa    : U_Regua

  26:     Função      : Main/U_Regua

  27:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

  28:     Data        : 17/08/2012

  29:     Uso         : Regua para Arquivo Texto

  30: */

  31: #IFDEF HARBOUR

  32: Function Main( uBuffer )

  33:     #DEFINE MAX_BUFFER Int(((784384766*8)-(1073741824*3.68))/8) //(  Unrecoverable error 9009: hb_xrealloc can't reallocate memory )

  34:     Local nBuffer

  35:     DEFAULT uBuffer TO 220

  36: #ELSE

  37: User Function Regua02( uBuffer )

  38:     #DEFINE MAX_BUFFER (1048575) //( + 1: String size overflow! )

  39:     Local nBuffer

  40:     DEFAULT uBuffer := 220

  41: #ENDIF

  42:     if (ValType(uBuffer)=="C")

  43:         uBuffer := Val(uBuffer)

  44:     endif

  45:     nBuffer := Min(MAX_BUFFER,uBuffer)

  46: Return( Regua( nBuffer ) )

  47: /*

  48:     Programa    : U_Regua

  49:     Função      : Regua

  50:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

  51:     Data        : 17/08/2012

  52:     Uso         : Regua para Arquivo Texto

  53: */

  54: Static Function Regua(nBuffer)

55:

  56:     Local c05

  57:     Local c10

58:

  59:     Local cfH

60:

  61:     Local cCRLF

  62:     Local cRegua

63:

  64:     Local l05

  65:     Local l10

66:

  67:     Local nAT

68:

  69:     Local n05

  70:     Local n10

  71:     Local n10I

72:

  73:     Local nfH

  74:     Local nRep

75:

  76:     n10     := (nBuffer/10)

  77:     n10I    := Int(n10)

  78:     nRep    := (n10I+(((n10)-n10I)*10))

  79:     nRep    := Min(nRep,9999999999)

  80:     cRegua  := SubStr(Replicate("1234567890",nRep),1,nBuffer)

81:

  82:     c05     := ""

  83:     c10     := ""

84:

  85:     n05     := 0

  86:     n10     := 0

  87:     nAT     := 0

88:

  89:     l05 := .T.

90:

  91:     While NtoL( AT("0",subStr(cRegua,nAT+=10 ) ) )

  92:         l05 := ( nAT <= 99999 )

  93:         IF ( l05 )

  94:             c05 += Transform(n05+=5,"99999")

  95:         EndIF

  96:         l10 := ( nAT <= 9999999999 )

  97:         IF .NOT.( l10 )

  98:             Exit

  99:         EndIF

 100:         c10  += Transform(n10+=10,"9999999999")

 101:     End While

 102:

 103:     nAT  := 0

 104:     IF ( l05 )

 105:     While NtoL( AT("0",subStr(cRegua,nAT+=10 ) ) )

 106:         n05 += 5

 107:         c05 += Transform(n05,"99999")

 108:     End While

 109:     ENDIF

 110:

 111:     c05 := SubStr(c05,1,(Int(Min(99999,nbuffer)/5)*5))

 112:     c10 := SubStr(c10,1,(Int(Min(9999999999,nbuffer)/10)*10))

 113:

 114: #IFDEF HARBOUR

 115:     cfH := GetCurrentFolder()

 116:     IF .NOT.(subStr(cfH,-1)==hb_ps())

 117:         cfH += hb_ps()

 118:     EndIF

 119: #ELSE

 120:     cfH := GetTempPath()

 121:     IF .NOT.(subStr(cfH,-1)$"\/")

 122:         IF ("/"$cfH)

 123:             cfH += "/"

 124:         Else

 125:             cfH += "\"

 126:         EndIF

 127:     EndIF

 128: #ENDIF

 129:     cfH += ProcName()

 130:     cfH += "-"

 131:     cfH += LTrim(Str(nBuffer))

 132:     cfH += "-"

 133:     cfH += DtoS(Date())

 134:     cfH += "-"

 135:     cfH += StrTran(Time(),":","-")

 136:     cfH += ".txt"

 137:

 138:     nfH := fCreate(Lower(cfH))

 139:

 140:     if .NOT.(NtoL(fError()))

 141:         cCRLF := CRLF

 142:         fWrite( nfH , c10 + cCRLF )

 143:         fWrite( nfH , c05 + cCRLF )

 144:         fWrite( nfH , cRegua + cCRLF )

 145:         fWrite( nfH , c05 + cCRLF )

 146:         fWrite( nfH , c10 + cCRLF )

 147:         fClose( nfH )

 148:     endif

 149:

 150: return({cRegua,c05,c10})

 151:

 152: #IFDEF HARBOUR

 153: /*

 154:     Programa    : U_Regua

 155:     Função      : NtoL

 156:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

 157:     Data        : 17/08/2012

 158:     Uso         : Numerico para Logico

 159: */

 160: Static Function NtoL(n)

 161: Return(.NOT.(Empty(n)))

 162:

 163: /*

 164:     Programa    : U_Regua

 165:     Função      : GetCurrentFolder

 166:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

 167:     Data        : 17/08/2012

 168:     Uso         : Retornar o Diretorio Corrente

 169: */

 170: Static Function GetCurrentFolder()

 171: Return( hb_CurDrive() + hb_osDriveSeparator() + hb_ps() + CurDir() )

 172:

 173: #ENDIF

u_regua03.prg

   1: #IFDEF TOTVS

   2:     #include "totvs.ch"

   3: #ELSE

   4:     #IFDEF PROTHEUS

   5:         #include "protheus.ch"

   6:     #ELSE

   7:         //compile:

   8:         //http://harbour-project.sourceforge.net/

   9:         //set include=%include%;c:\hb32\include\

  10:         //c:\hb32\bin\hbmk2.exe u_regua /dHARBOUR

  11:         //c:\hb32\bin\upx.exe u_regua.exe

  12:         #include "hb.ch"

  13:         #include "common.ch"

  14:         #include "fileio.ch"

  15:     #ENDIF

  16: #ENDIF

  17: #IFNDEF CRLF

  18:     #IFDEF HARBOUR

  19:         #DEFINE CRLF HB_OsNewLine()

  20:     #ELSE

  21:         #DEFINE CRLF CHR(13)+CHR(10)

  22:     #ENDIF

  23: #ENDIF

  24: /*

  25:     Programa    : U_Regua

  26:     Função      : Main/U_Regua

  27:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

  28:     Data        : 17/08/2012

  29:     Uso         : Regua para Arquivo Texto

  30: */

  31: #IFDEF HARBOUR

  32: Function Main( uBuffer )

  33:     #DEFINE MAX_BUFFER Int(((784384766*8)-(1073741824*3.68))/8) //(  Unrecoverable error 9009: hb_xrealloc can't reallocate memory )

  34:     Local nBuffer

  35:     DEFAULT uBuffer TO 220

  36: #ELSE

  37: User Function Regua03( uBuffer )

  38:     #DEFINE MAX_BUFFER (1048575) //( + 1: String size overflow! )

  39:     Local nBuffer

  40:     DEFAULT uBuffer := 220

  41: #ENDIF

  42:     if (ValType(uBuffer)=="C")

  43:         uBuffer := Val(uBuffer)

  44:     endif

  45:     nBuffer := Min(MAX_BUFFER,uBuffer)

  46: Return( Regua( nBuffer ) )

  47: /*

  48:     Programa    : U_Regua

  49:     Função      : Regua

  50:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

  51:     Data        : 17/08/2012

  52:     Uso         : Regua para Arquivo Texto

  53: */

  54: Static Function Regua(nBuffer)

55:

  56:     Local c05

  57:     Local c10

58:

  59:     Local cfH

60:

  61:     Local cCRLF

  62:     Local cRegua

63:

  64:     Local l05

  65:     Local l10

66:

  67:     Local nAT

68:

  69:     Local n05

  70:     Local n10

  71:     Local n10I

72:

  73:     Local nfH

  74:     Local nRep

75:

  76:     n10     := (nBuffer/10)

  77:     n10I    := Int(n10)

  78:     nRep    := (n10I+(((n10)-n10I)*10))

  79:     nRep    := Min(nRep,9999999999)

  80:     cRegua  := SubStr(Replicate("1234567890",nRep),1,nBuffer)

81:

  82:     c05     := ""

  83:     c10     := ""

84:

  85:     n05     := 0

  86:     n10     := 0

  87:     nAT     := 0

88:

  89:     l05 := .T.

90:

  91:     While ("0"==subStr(cRegua,nAT+=10,1))

  92:         l05 := ( nAT <= 99999 )

  93:         IF ( l05 )

  94:             c05 += Transform(n05+=5,"99999")

  95:         EndIF

  96:         l10 := ( nAT <= 9999999999 )

  97:         IF .NOT.( l10 )

  98:             Exit

  99:         EndIF

 100:         c10        += Transform(n10+=10,"9999999999")

 101:     End While

 102:

 103:     nAT  := 0

 104:     IF ( l05 )

 105:         While ("0"==subStr(cRegua,nAT+=10,1))

 106:             l05 := ( nAT <= 99999 )

 107:             IF .NOT.( l05 )

 108:                 Exit

 109:             EndIF

 110:             c05 += Transform(n05+=5,"99999")

 111:         End While

 112:     ENDIF

 113:

 114:     c05 := SubStr(c05,1,(Int(Min(99999,nbuffer)/5)*5))

 115:     c10 := SubStr(c10,1,(Int(Min(9999999999,nbuffer)/10)*10))

 116:

 117: #IFDEF HARBOUR

 118:     cfH := GetCurrentFolder()

 119:     IF .NOT.(subStr(cfH,-1)==hb_ps())

 120:         cfH += hb_ps()

 121:     EndIF

 122: #ELSE

 123:     cfH := GetTempPath()

 124:     IF .NOT.(subStr(cfH,-1)$"\/")

 125:         IF ("/"$cfH)

 126:             cfH += "/"

 127:         Else

 128:             cfH += "\"

 129:         EndIF

 130:     EndIF

 131: #ENDIF

 132:     cfH += ProcName()

 133:     cfH += "-"

 134:     cfH += LTrim(Str(nBuffer))

 135:     cfH += "-"

 136:     cfH += DtoS(Date())

 137:     cfH += "-"

 138:     cfH += StrTran(Time(),":","-")

 139:     cfH += ".txt"

 140:

 141:     nfH := fCreate(Lower(cfH))

 142:

 143:     if .NOT.(NtoL(fError()))

 144:         cCRLF := CRLF

 145:         fWrite( nfH , c10 + cCRLF )

 146:         fWrite( nfH , c05 + cCRLF )

 147:         fWrite( nfH , cRegua + cCRLF )

 148:         fWrite( nfH , c05 + cCRLF )

 149:         fWrite( nfH , c10 + cCRLF )

 150:         fClose( nfH )

 151:     endif

 152:

 153: return({cRegua,c05,c10})

 154:

 155: #IFDEF HARBOUR

 156: /*

 157:     Programa    : U_Regua

 158:     Função      : NtoL

 159:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

 160:     Data        : 17/08/2012

 161:     Uso         : Numerico para Logico

 162: */

 163: Static Function NtoL(n)

 164: Return(.NOT.(Empty(n)))

 165:

 166: /*

 167:     Programa    : U_Regua

 168:     Função      : GetCurrentFolder

 169:     Autor       : Marinaldo de Jesus [ http://www.blacktdn.com.br ]

 170:     Data        : 17/08/2012

 171:     Uso         : Retornar o Diretorio Corrente

 172: */

 173: Static Function GetCurrentFolder()

 174: Return( hb_CurDrive() + hb_osDriveSeparator() + hb_ps() + CurDir() )

 175:

 176: #ENDIF

Para obter os originais clique aqui.

[]s
иαldσ dj

Pesquisar este blog

BlackTDN

BlackTDN :: BTDNReguaTXT : Régua para arquivo Texto

Comentários

Postar um comentário

Postagens mais visitadas

BlackTDN :: RLeg ~ Desvendando a Função ParamBox

Protheus :: Chamando Funções do Menu Diretamente e sem a Necessidade de Login