Erro Dbstruct()
Enviado: 14 Mar 2015 10:10
Bom dia...
Tô tendo um erro com o dbstruct(). Estou fazendo uma função que abre o dbf lê a estrutura do arquivo e imprime a estrutura. Estou usando em uma pasta com 60 arquivos, e não todos os arquivos que apresenta o erro. abaixo tem uma imagem do erro e na sequencia tá o programa.
Se alguém puder dar uma olhada e falar o que estou fazendo de errado...
Obrigado
Rubens
Formulário
Obrigado
Rubens
Tô tendo um erro com o dbstruct(). Estou fazendo uma função que abre o dbf lê a estrutura do arquivo e imprime a estrutura. Estou usando em uma pasta com 60 arquivos, e não todos os arquivos que apresenta o erro. abaixo tem uma imagem do erro e na sequencia tá o programa.
Se alguém puder dar uma olhada e falar o que estou fazendo de errado...
Obrigado
Rubens
Código: Selecionar todos
#include <minigui.ch>
#include "fileio.ch"
#include "directry.ch"
#include "dbstruct.ch"
REQUEST HB_LANG_PT
REQUEST HB_CODEPAGE_PT850
FUNCTION Main
PUBLIC cDirProg := GetCurrentFolder()
AMBIENTE()
HB_LANGSELECT("PT")
HB_SETCODEPAGE("PT850")
LOAD WINDOW Converte
Converte.Center
Converte.Activate
RETURN( NIL )
********************************************************************************
FUNCTION VERIFICA()
// PASTA DO PROGRAMA DATASAC PDVLITE
cDIRPROG := Converte.TEXTBOX_1.VALUE
nPag := 0
FIRST := .T.
aARQS := Directory( cDIRPROG+'\*.DBF' )
// 1 cNome F_NAME
// 2 cTamanho F_SIZE
// 3 dData F_DATE
// 4 cHora F_TIME
// 5 cAtributos F_ATT
FOR X = 1 TO LEN( aARQS )
cFILE := cDIRPROG+'\'+aARQS[X,1]
USE &cFILE EXCL
PACK
M1 := DBSTRUCT()
// 1 cNome DBS_NAME
// 2 cTipo DBS_TYPE
// 3 nTamanho DBS_LEN
// 4 nDecimais DBS_DEC
cARQSQL := SUBSTR( aARQS[X,1],0,LEN(aARQS[X,1])-4)
cARQSQL := cDIRPROG+'\SQL\'+cARQSQL+'.SQL'
CONVERTE.PROGRESSBAR_1.RANGEMAX := LASTREC()
SETPROPERTY( 'CONVERTE', 'LABEL_1','VALUE', cFILE )
SETPROPERTY( 'CONVERTE', 'TEXT_1' ,'VALUE', cARQSQL )
DBGOTOP()
WHILE !EOF()
CONVERTE.PROGRESSBAR_1.VALUE := RECNO()
SETPROPERTY( 'CONVERTE', 'LABEL_3' ,'VALUE', STRZERO( RECNO(),6))
DBSKIP()
ENDDO
SET PRINTER TO &cARQSQL
SET DEVICE TO PRINT
Y := 0
IF LEN( M1 ) > 0
FOR Y = 1 TO LEN( M1 )
@ PROW()+1,00 SAY M1[Y,1]
@ PROW() ,12 SAY M1[Y,2]
@ PROW() ,22 SAY M1[Y,3]
@ PROW() ,32 SAY M1[Y,4]
NEXT
ELSE
MSGINFO( 'ARQUIVO COM PROBLEMA: '+cFILE+' TAMANHO M1: '+STR( LEN(M1) ) )
ENDIF
SET DEVICE TO SCREEN
SET PRINTER TO
USE
* ShellExecute( 0, "open", 'NOTEPAD', cARQPRN , , 1 )
NEXT
MSGINFO('Conversao finalizada')
CONVERTE.BUTTON_4.SETFOCUS
RETURN NIL
********************************************************************************
FUNCTION AMBIENTE()
SET TALK OFF
SET CENT ON
SET EPOC TO 1930
SET DATE BRIT
SET DATE FORMAT TO "DD/MM/YYYY"
SET STAT OFF
SET CURSOR OFF
SET DELETED ON
SET AUTOPEN ON
SETBLINK(.F.)
SET AUTOADJUST ON
SET BROWSESYNC ON
SET MULTIPLE OFF WARNING
SET TOOLTIPBALLOON ON
SET NAVIGATION EXTENDED
RETURN NIL
********************************************************************************
// Gravar sem o Fim de arquivo do DOS Chr(26)
FUNCTION hb_MemoWrit( cFileName, cText )
RETURN MemoWrit( cFileName, cText, .F. )
********************************************************************************
// CRLF
FUNCTION HB_EOL()
RETURN HB_OsNewLine()
********************************************************************************
function MYRUN( cComando )
********************************************************************************
local oShell, RET
oShell := CreateObject( "WScript.Shell" )
RET := oShell:Run( "%comspec% /c " + cComando, 0, .T. )
oShell := NIL
return iif( RET = 0, .T., .F. )
Código: Selecionar todos
DEFINE WINDOW TEMPLATE AT 206 , 305 WIDTH 755 HEIGHT 320 TITLE "Convertendo tabelas dbf para Banco MySql" ICON "D:\PROGS\DATASAC\HMG\TESTANFC\MDV.ICO" MAIN BACKCOLOR {192,192,192}
DEFINE STATUSBAR FONT "Arial" SIZE 12
STATUSITEM "Conversor de DBF/MySql"
KEYBOARD WIDTH 90
DATE WIDTH 100
CLOCK WIDTH 80
END STATUSBAR
DEFINE FRAME Frame_1
ROW 10
COL 10
WIDTH 713
HEIGHT 71
FONTNAME 'Arial'
FONTSIZE 10
FONTBOLD .T.
CAPTION "Escolha pasta com os arquivos DBF"
OPAQUE .T.
END FRAME
DEFINE BUTTON Button_1
ROW 40
COL 660
WIDTH 43
HEIGHT 30
ACTION {|| Converte.Textbox_1.Value := GetFolder("Selecione a pasta onde estão os arquivos de dados",Converte.Textbox_1.Value) }
FONTNAME 'Arial'
TOOLTIP ''
PICTURE "OPEN.BMP"
END BUTTON
DEFINE TEXTBOX Textbox_1
ROW 40
COL 20
WIDTH 626
HEIGHT 28
FONTNAME 'Arial'
VALUE cDirProg
END TEXTBOX
DEFINE FRAME Frame_3
ROW 80
COL 10
WIDTH 714
HEIGHT 99
FONTNAME 'Arial'
FONTSIZE 10
FONTBOLD .T.
OPAQUE .T.
END FRAME
DEFINE BUTTON Button_3
ROW 190
COL 410
WIDTH 152
HEIGHT 60
ACTION { || Verifica() }
CAPTION "&Converte Arquivos"
FONTNAME 'Arial'
TOOLTIP ''
END BUTTON
DEFINE PROGRESSBAR ProgressBar_1
ROW 143
COL 20
WIDTH 602
HEIGHT 30
RANGEMIN 1
RANGEMAX 10
TOOLTIP ''
END PROGRESSBAR
DEFINE BUTTON Button_4
ROW 190
COL 570
WIDTH 155
HEIGHT 60
ACTION { || Converte.RELEASE }
CAPTION "&Sair"
FONTNAME 'Arial'
TOOLTIP ''
END BUTTON
DEFINE LABEL Label_1
ROW 97
COL 20
WIDTH 690
HEIGHT 40
VALUE ""
FONTSIZE 18
FONTBOLD .T.
BACKCOLOR {0,0,255}
FONTCOLOR {255,255,255}
CENTERALIGN .T.
END LABEL
DEFINE LABEL Label_2
ROW 190
COL 10
WIDTH 200
HEIGHT 25
VALUE "Nome do aquivo de Saida"
FONTSIZE 12
FONTBOLD .T.
END LABEL
DEFINE TEXTBOX Text_1
ROW 220
COL 10
WIDTH 310
HEIGHT 30
FONTNAME 'Arial'
FONTSIZE 12
FONTBOLD .T.
FONTCOLOR {0,0,255}
VALUE cDirProg
END TEXTBOX
DEFINE BUTTON Button_2
ROW 190
COL 330
WIDTH 71
HEIGHT 62
ACTION {|| Converte.Text_1.Value := GetFolder("Selecione o local para Salvar o arquivo",Converte.Text_1.Value) }
FONTNAME 'Arial'
TOOLTIP ''
PICTURE "OPEN.BMP"
END BUTTON
DEFINE LABEL Label_3
ROW 143
COL 630
WIDTH 80
HEIGHT 30
VALUE ""
FONTSIZE 12
FONTBOLD .T.
FONTCOLOR {255,0,0}
CENTERALIGN .T.
END LABEL
END WINDOW
Rubens