Olá pessoal…
Hoje vou mostrar uma função desenvolvida, com o intuito de migrar várias tabelas de uma base de dados para outra utilizando o AdvPL e o SQL Server.
Primeiramente quero agradecer a ajuda do Marcos Guaraná, por me ajudar na lógica e desenvolvimento da rotina.
A rotina basicamente, tem a intenção de copiar dados de uma base para outra, como por exemplo, dados da Produção para a base de Testes, sem precisar migrar todas as tabelas, e somente algumas.
Basicamente, é verificado as tabelas que tem dados (conforme informado a base da origem), então a tabela no destino (onde o Protheus está aberto) os dados são zerados, e depois é feito um “append” de todas as informações da origem, conforme os campos que existem em ambas as tabelas.
Ao executar a rotina, basta informar a base de origem, e qual é a tabela inicial e final no processo.
Abaixo o fonte desenvolvido.
//Bibliotecas #Include "Protheus.ch" #Include "TopConn.ch" /*/{Protheus.doc} zAppend Função de Append em bloco de uma base para outra @type function @author Atilio @since 16/08/2016 @version 1.0 @example u_zAppend() @obs Feito conforme lógica e ajuda de Marcos Guaraná /*/ User Function zAppend() Local aArea := GetArea() Local cPerg := PadR("X_ZAPPEND", 10) Private cDBOrigem := "" Private cTabDe := "" Private cTabAt := "" //Cria as perguntas fValidPerg(cPerg) //Se a pergunta for confirmada (com o schema de origem, ex.: P11) If Pergunte(cPerg, .T.) cDbOrigem := MV_PAR01 cTabDe := MV_PAR02 cTabAt := MV_PAR03 //Chama a rotina de cópia If !Empty(cDbOrigem) Processa({|| fAtualiza()}, "Processando...") EndIf EndIf RestArea(aArea) Return /*---------------------------------------------------------------------* | Func: fAtualiza | | Autor: Daniel Atilio | | Data: 16/08/2016 | | Desc: Função que atualiza os dados do Destino conforme a Origem | *---------------------------------------------------------------------*/ Static Function fAtualiza() Local cQry := "" Local cQryDad := "" Local nTotal := 0 Local nAtual := 0 Local nAux := 0 Local cBase := cDbOrigem Local cAliAtu := "" Local cSQL := "" Local cLogErr := "" Local nErr := 0 Local aEstrut := {} //Faz consulta das tabelas que tem dados cQry += " SELECT " cQry += " esquemas.Name AS Esquema_Nome, " cQry += " tabelas.NAME AS Tabela_Nome, " cQry += " particoes.rows AS Numero_Linhas, " cQry += " SUM(alocacao.total_pages) * 8 AS Espaco_KB_Total, " cQry += " SUM(alocacao.used_pages) * 8 AS Espaco_KB_Usado, " cQry += " (SUM(alocacao.total_pages) - SUM(alocacao.used_pages)) * 8 AS Espaco_KB_Sem_Uso " cQry += " FROM " cQry += " "+cBase+".sys.tables tabelas " cQry += " INNER JOIN "+cBase+".sys.schemas esquemas ON ( " cQry += " esquemas.schema_id = tabelas.schema_id " cQry += " ) " cQry += " INNER JOIN "+cBase+".sys.indexes indices ON ( " cQry += " tabelas.OBJECT_ID = indices.object_id " cQry += " ) " cQry += " INNER JOIN "+cBase+".sys.partitions particoes ON ( " cQry += " indices.object_id = particoes.OBJECT_ID " cQry += " AND indices.index_id = particoes.index_id " cQry += " ) " cQry += " INNER JOIN "+cBase+".sys.allocation_units alocacao ON ( " cQry += " particoes.partition_id = alocacao.container_id " cQry += " ) " //Filtra somentes tabelas, filtra somente as criadas por usuário cQry += " WHERE " cQry += " tabelas.NAME NOT LIKE 'dt%' " cQry += " AND tabelas.is_ms_shipped = 0 " cQry += " AND indices.OBJECT_ID > 255 " cQry += " AND alocacao.used_pages != 0 " cQry += " AND tabelas.NAME >= '"+cTabDe+cEmpAnt+"0' " cQry += " AND tabelas.NAME <= '"+cTabAt+cEmpAnt+"0' " //Agrupando pela Tabela, Esquema e Número de linhas cQry += " GROUP BY " cQry += " tabelas.Name, esquemas.Name, particoes.Rows " //Ordenando pelo esquema, seguido pelas tabelas cQry += " ORDER BY " cQry += " Esquema_Nome, Tabela_Nome " TCQuery cQry New Alias "QRY_ORI" Count To nTotal nAtual := 0 ProcRegua(nTotal) Begin Transaction //Enquanto houver dados na query QRY_ORI->(DbGoTop()) While ! QRY_ORI->(EoF()) nAtual++ cAliAtu := SubStr(QRY_ORI->Tabela_Nome, 1, 3) DbSelectArea(cAliAtu) aEstrut := (cAliAtu)->(DbStruct()) IncProc("Processando "+cAliAtu+" ("+cValToChar(nAtual)+" de "+cValToChar(nTotal)+")...") //Deleta tudo que existe na tabela destino cSQL := "DELETE FROM "+RetSQLName(cAliAtu)+" " nErr := TcSqlExec(cSQL) //Se houve Erro If nErr != 0 cLogErr += "- Tabela "+cAliAtu+Chr(13)+Chr(10) Else //Seleciona os dados da origem cQryDad := " SELECT " cQryDad += " * " cQryDad += " FROM " cQryDad += " "+cBase+"."+QRY_ORI->Esquema_Nome+"."+QRY_ORI->Tabela_Nome+" TAB " cQryDad += " WHERE " cQryDad += " TAB.D_E_L_E_T_ = ' ' " TCQuery cQryDad New Alias "QRY_DAD" For nAux := 1 To Len(aEstrut) If aEstrut[nAux][2] == 'D' TCSetField("QRY_DAD", aEstrut[nAux][1], aEstrut[nAux][2]) EndIf Next //Enquanto houver dados While !QRY_DAD->(EoF()) //Faz reclock no destino RecLock(cAliAtu, .T.) //Percorre a SX3 do destino, e puxa os dados da origem For nAux := 1 To Len(aEstrut) If QRY_DAD->(FieldPos(aEstrut[nAux][1])) > 0 .And. (cAliAtu)->(FieldPos(aEstrut[nAux][1])) > 0 &(aEstrut[nAux][1]) := &("QRY_DAD->"+aEstrut[nAux][1]) EndIf Next (cAliAtu)->(MsUnlock()) QRY_DAD->(DbSkip()) EndDo QRY_DAD->(DbCloseArea()) EndIf QRY_ORI->(DbSkip()) EndDo QRY_ORI->(DbCloseArea()) End Transaction //Se houve erro If !Empty(cLogErr) Aviso('Atenção', "Houveram erros nas tabelas: "+Chr(13)+Chr(10)+cLogErr, {'Ok'}, 03) Else MsgInfo("Processo terminado!", "Atenção") EndIf Return /*---------------------------------------------------------------------* | Func: fValidPerg | | Autor: Daniel Atilio | | Data: 16/08/2016 | | Desc: Função para criação do grupo de perguntas | *---------------------------------------------------------------------*/ Static Function fValidPerg(cPerg) //( cGrupo, cOrdem, cPergunt, cPergSpa, cPergEng, cVar, cTipo, nTamanho, nDecimal, nPreSel, cGSC, cValid, cF3, cGrpSXG, cPyme, cVar01, cDef01, cDefSpa1, cDefEng1, cCnt01, cDef02, cDefSpa2, cDefEng2, cDef03, cDefSpa3, cDefEng3, cDef04, cDefSpa4, cDefEng4, cDef05, cDefSpa5, cDefEng5, aHelpPor, aHelpEng, aHelpSpa, cHelp) PutSx1(cPerg, "01", "Base de Dados Origem?", "", "", "mv_ch0", "C", 060, 0, 0, "G", "", "", "", "", "mv_par01", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", {}, {}, {}, "") PutSx1(cPerg, "02", "Alias De?", "", "", "mv_ch1", "C", 003, 0, 0, "G", "", "", "", "", "mv_par02", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", {}, {}, {}, "") PutSx1(cPerg, "03", "Alias Até?", "", "", "mv_ch2", "C", 003, 0, 0, "G", "", "", "", "", "mv_par03", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", "", {}, {}, {}, "") Return
Bom pessoal, por hoje é só.
Abraços e até a próxima.
Danilo,
Parabéns pelo seu trabalho, é de grande valor para nossa comunidade. Obrigado!
Por favor, gostaria de saber se no caso do uso dessa função eu tiver um ambiente produção com SGBD SQL Server e uma base de testes apontando para um SGBD Oracle, vai funcionar da mesma maneira?
Grato!
Marcelo.
Bom dia Marcelo, tudo bem?
Então, nesse fonte montado, a consulta de origem executada com TCQuery, é feita totalmente com comandos para SQL Server.
O restante usa o AdvPL e comandos padrões, então se sua origem for SQL Server, acho que não dará nenhum problema.
Um grande abraço.
Bom dia, Danilo
Sabe me dizer se nesta função é possível inserir algo que copie uma tabala de uma empresa para outra dentro do protheus ?
Na verdade o que preciso é fazer a copia de alguns clientes de uma empresa para outra, e não posso deixar compartilhada estas tabelas
Bom dia Cleberson, tudo bem?
Então, essa função faz a migração dos dados de uma base para outra, ai o que você pode fazer é filtrar apenas a SA1 e colocar os filtros que você quer na cópia.
Um grande abraço.