PC Toledo

Código: Selecionar todos

/**

 * Copyright (c) 2001, CAIO Sistemas & M‚todos Ltda

 * Todos os Direitos Reservados

 *

 * CRIASQL.PRG .... Cria um SCRIPT SQL para o INTERBASE

 *                  a partir da estrutura de dados DBF/CDX ou DBF/NTX

 *

 * Autor: Caio Jose Hugueney Lopes de Oliveira

 * Data.: Julho/2001

 *

 * ------------------------------------------------------------------

 * Prezados colegas, vcs. podem usar/alterar esse programa conforme

 * lhes convier, desde que mantenham o cr‚dito do autor original.

 * As melhorias que por ventura sejam realizadas podem ser enviadas

 * para a lista Interbase-br@yahoogrupos.com.br.

 * Abra‡o

 * Caio Oliveira

 * ------------------------------------------------------------------

 *

 */

#Include "Set.ch"

#Include "Dbstruct.ch"

#Include "directry.ch"



#command DISPLAY STRUCTURE [<print: TO PRINTER>] [TO<(file)>] ;

   => fCriaSql(<(file)>, <.print.>)



//function main()



//set century on

//set date to brit



parameters dbfile, tto, dest



IF (dbfile == NIL) .OR. (( tto = 'TO').AND.(dest == NIL))

   Dispusage()

   Return NIL

Endif





// Esse c¢digo eu uso para identificar se a base &#130;

// DBFCDX ou DBFNTX

//if CDXData() .OR. File("CEPEMP01.CDX")

//   REQUEST DBFCDX

//   RDDSETDEFAULT("DBFCDX")

//Endif



if Upper(dbfile) = 'TODOS' .OR. Upper(dbfile) = 'ALL'

   PegaArquivos(tto, dest)

Else

   Estrut2( dbfile, tto, dest )

Endif



Return NIL



/**

 *

 * Localiza os arquivos com extensao

 * .DAT ou DBF do diretorio e adiciona-os no aArqDBF

 *

 */

Static Function PegaArquivos(tto, dest)

LOCAL aArqDBF := DIRECTORY( "*.DBF" )

LOCAL aArqDAT := DIRECTORY( "*.DAT" )

LOCAL nK := 0



For nK := 1 to LEN( aArqDaT )

    AADD( aArqDBF, aArqDat[nK] )

Next



For nK := 1 to LEN( aArqDBF )

   Estrut2( Trim(aArqDBF[nK,F_NAME]), tto, dest )

Next



Return NIL



/**

 *  Chama CriaSQL() para montar/imprimir a estrutura de 'dbffile'

 * 

 */

Function Estrut2(dbfile, tto, dest)



if tto != NIL

   tot := UPPER( tto )

Endif



if (dbfile == NIL) .OR. (( tto = 'TO').AND.(dest == NIL))

   dispusage()

   Return NIL



Endif



if AT('.', dbfile) == 0

   dbfile = dbfile+'.dbf'

endif



USE (dbfile) NEW



DO CASE

CASE  "" == dest .OR. dest == NIL

   DISPLAY STRUCTURE

CASE LEFT(UPPER(dest),4) = "PRIN"

   DISPLAY STRUCTURE TO PRINTER

OTHERWISE

   DISPLAY STRUCTURE TO (dest)

ENDCASE



Use



RETURN NIL



/**

 *

 *

 */

Static Function fCriaSQL()

PARAMETERS file, print



LOCAL nK := 0, aDBFStruct := {}, nItens := 0

LOCAL cNomeArq := Alias()



oldprintf = SET(_SET_PRINTFILE)

oldprint  = SET(_SET_PRINTER)

oldcons   = SET(_SET_CONSOLE)



DO CASE

CASE "" != file .AND. file != NIL

   SET PRINTER TO (file) ADDITIVE

   SET CONSOLE OFF

   SET PRINTER ON

CASE print

   SET CONSOLE OFF

   SET PRINTER ON

ENDCASE



// Inicia construcao do SCRIPT da tabela



QOUT( "CREATE TABLE "+cNomeArq )

QOUT( "(" )



//QOUT( PADR("ID_"+cNomeArq,13)+'   INTEGER,' )



aDbfStruct := DBStruct()

nITens := LEN(aDBFStruct)





For nK := 1 to LEN(aDbfStruct)

       QOUT( PADR( TRIM(iif(TRIM(adbfstruct[nK,DBS_NAME]) == "DESC",;

                    "DESCRICAO", adbfstruct[nK,DBS_NAME])), 13)+;

       '   '+ConvTip(adbfstruct[nK,DBS_TYPE],;           

              adbfstruct[nK,DBS_LEN], adbfstruct[nK,DBS_DEC],;

              adbfstruct[nK,DBS_NAME] )+;

              iif( nK == nITens, '', ',') )

Next



QQOUT( " );")



QOUT()

QOUT()

dbgotop()

do while !eof()

qqout("INSERT INTO "+ cNomeArq +" VALUES (")

	for x=1 to fcount()



		qqout(convdados( &(fieldname(x)) ) ) 

			

		if x=fcount()

			qqout(");")

			QOUT()

			exit

		endif

		qqout(",")

	next

	skip

enddo



// Gera um GENERATOR para a tabela

// Vc. pode ignorar isso



//QOUT()

//QOUT( "CREATE GENERATOR GEN_"+cNomeArq+";" )

//QOUT()



SET(_SET_PRINTER, oldprint )

SET(_SET_PRINTFILE, oldprintf )

SET(_SET_CONSOLE, oldcons )



RETURN NIL



/**

 *

 * Sintaxe 

 *

 */

Function DispUsage()

?? "Sintaxe: Cria_SQL <dbf> [[TO <nome-do-arquivo>] [TO PRIN[TER]]]"

RETURN NIL



/**

 *

 * Funcao de Conversao de Tipo DBF->INTERBASE

 *

 */

Static Function ConvTip( cTipo, nNum, nDec, cNome )

LOCAL cRet := ""



if cNome = 'DATAHORA' .OR. cNome = 'DATAHALT'

   Return "data_hoje"

Endif



if cTipo == "C"

   cRet := "CHAR("+LTRIM(STR(nNum))+")"

ELseif cTipo == "D"

   cRet := "DATE"

ELseif cTipo == "N"

   if nDec > 0

      if nNum > 14

            cRet := "DOUBLE PRECISION"

      Else

            cRet := "NUMERIC("+LTRIM(STR(nNum))+","+LTRIM(STR(nDec))+")"

      Endif

   Else

      if nNum <= 5

      cRet := "SMALLINT"

      Else

      cRet := "INTEGER"

      Endif

   Endif

Elseif cTipo == "L"

      cRet := "CHAR(1) DEFAULT 'N'"

Elseif cTipo == "M"

      cRet := "BLOB SUB_TYPE TEXT segment size 80"

Endif

Return cRet







Function AlltoC(var)

local tipo:=valtype(var)

do case

	case tipo = 'N'

		return str(var)	

	case tipo = 'D'

		return dtoc(var)

	case tipo = 'L'

		if var

			return 'T'

		else

			return 'F'

		endif

end case

return var && Se chegou aqui a variavel ja é C





Function ConvDados(valor)

//alert(valtype(valor))



if valtype(valor) = 'C'

	if alltrim(valor) == ""

		return "null"

	else

		return "'"+alltrim(valor)+"'"

	endif

elseif valtype(valor) = 'D'

	if valor = ctod("  /  /   ")

		return "null"

	else

		return "'"+dtoc(valor)+"'"

	endif

else

	return valor

endif



return