Página 1 de 1
Como Fazer essa PRG ? Tem como?
Enviado: 02 Jun 2006 09:45
por kristo
Bom dia amigos, ka estou eu novamente, com mais um problema.
Como eu já disse eu não manjo nada de clipper mais gosto de aprender a lidar com ele.
Tenho um trabalho para fazer, e está tomando muito meu tempo, não sei se com o clipper pode me ajudar.
Preciso de um PRG com o seguinte intuito.
Tenho uma DBF com 4 milhoes de nomes, se chama Cadasso.DBF
Preciso que a PRG leia essa DBF e pegue 1 nomes a cada 1000 registro lidos e jogue esse nome para uma outra dbf (que pode ter o nome de "NOVA.DBF )contendo a mesma estrutura, e pra dificultar ainda mais eu preciso que na DBF com os dados de origem seja marcado no campo chamado "USO" o número "1" !!
Será que isso é possível? o Numero "1" tem que ser marcado na DBF original e na nova DBF criada.
E se for possível que eu possa informar a partir de que número a PRG vai começar a ler.
Ex. eu fiz do número 1 a 500.000, a proxima será da 500.001 à 1000.000.
Pessoal se alguém por mizericordia puder montar isso para mim, eu fico muito grato.....lembrando que não me achem folgado ou abusado, é que realmente não tenho a quem recorrer.
Abaixo segue os campos da DBF principal:
USO,NOME,ENDERECO,BAIRRO,CIDADE,ESTADO,DDD,TELEFONE,CEP
Lembrando que os dados não podem ser movidos ou seja apagados da dbf original, e sim apenas copiado.
Alguém ai tem um patrão Francês?
Eu tenho, o cara me apronta cada uma.
Conto com o forum. Um forte abraço
Kristo
Esqueci de falar, e se caso nessa leitura a prg encontrar o numero 1 no campo USO, ela ignorar e não pegar esse dado.
Enviado: 02 Jun 2006 12:08
por gvc
Não sei se entendi direito o que vc quer fazer, mas veja se este código atende sua necessidade. Boa sorte.
reg_ini := reg_fim := 0
n_cont := 0
aesc := array(30)
@ 05,05 say 'Inicio:' get reg_ini
@ 06,05 say 'Fim:' get reg_fim
read
dbgotop()
copy struct to nova
use nova new
select cadasso
dbgotop()
while !cadasso->(eof())
n_cont++
if n_cont > reg_fim
exit
end
if n_cont < reg_ini
cadasso->(dbskip())
loop
end
if cadasso->uso = '1'
cadasso->(dbskip())
loop
end
cadasso->uso := '1'
aeval(aesc, {|val, pos| aesc[pos] := cadasso->(fieldget(pos))})
nova->(dbappend())
aeval(aesc, {|val, pos| nova->(fieldput(pos, val))})
cadasso->(dbskip())
end
dbcloseall()
return
Enviado: 02 Jun 2006 13:23
por Augusto
Eu entendi assim... veja o código:
Código: Selecionar todos
copy file CADASSO.DBF to NOVA.DBF
sele 1
use CADASSO // Não seria "CADASTRO" ??
sele 2
use NOVA
zap
inicio=1000
fim=0
@ 05,05 say 'Inicio:' get inicio pict '99999999'
read
if lastkey() = 27
close data
return
endif
@ 06,05 say 'Fim:' get fim pict '99999999' valid fim > inicio
read
if lastkey() = 27
close data
return
endif
sele 1
go inicio
do while recno() <= fim
do while USO="1"
skip
enddo
repl USO with "1" // Se o campo for "string", senão tire as aspas
sele 2
appe blan
repl USO with CADASSO->USO
repl NOME with CADASSO->NOME
repl ENDERECO with CADASSO->ENDERECO
repl BAIRRO with CADASSO->BAIRRO
repl CIDADE with CADASSO->CIDADE
repl ESTADO with CADASSO->ESTADO
repl DDD with CADASSO->DDD
repl TELEFONE with CADASSO->TELEFONE
repl CEP with CADASSO->CEP
sele 1
skip 1000
enddo
close data
return
É "feijão c/ arroz" mas funciona...
Enviado: 04 Jun 2006 14:06
por kristo
Meu amigo, vc cozinha muito bem, nunca comi um arroz com feijão tão bom!!
Valeu mesmo irmão.
Agora me diz uma coisa, tem como eu colocar nessa rotima uma terceira opção de pesquisa, pois aparece o inicio e o fim certo?
teria como eu informar a "Cidade" que eu quero os nomes?
ex:
Inicio:...............
Fim:..................
Cidade:.............
Augusto escreveu:Eu entendi assim... veja o código:
Código: Selecionar todos
copy file CADASSO.DBF to NOVA.DBF
sele 1
use CADASSO // Não seria "CADASTRO" ??
sele 2
use NOVA
zap
inicio=1000
fim=0
@ 05,05 say 'Inicio:' get inicio pict '99999999'
read
if lastkey() = 27
close data
return
endif
@ 06,05 say 'Fim:' get fim pict '99999999' valid fim > inicio
read
if lastkey() = 27
close data
return
endif
sele 1
go inicio
do while recno() <= fim
do while USO="1"
skip
enddo
repl USO with "1" // Se o campo for "string", senão tire as aspas
sele 2
appe blan
repl USO with CADASSO->USO
repl NOME with CADASSO->NOME
repl ENDERECO with CADASSO->ENDERECO
repl BAIRRO with CADASSO->BAIRRO
repl CIDADE with CADASSO->CIDADE
repl ESTADO with CADASSO->ESTADO
repl DDD with CADASSO->DDD
repl TELEFONE with CADASSO->TELEFONE
repl CEP with CADASSO->CEP
sele 1
skip 1000
enddo
close data
return
É "feijão c/ arroz" mas funciona...
Enviado: 04 Jun 2006 15:11
por Augusto
Lá vai...
Código: Selecionar todos
copy file CADASSO.DBF to NOVA.DBF
sele 1
use CADASSO // Não seria "CADASTRO" ??
sele 2
use NOVA
zap
inicio=1000
fim=0
mcid=space(XX) // Coloque em "XX" o tamanho do campo "CIDADE" que está no CADASSO.DBF
@ 05,05 say 'Inicio:' get inicio pict '99999999'
read
if lastkey() = 27
close data
return
endif
@ 06,05 say 'Fim:' get fim pict '99999999' valid fim > inicio
read
if lastkey() = 27
close data
return
endif
@ 07,05 say 'Cidade:' get mcid
read
if lastkey() = 27
close data
return
endif
sele 1
go inicio
do while recno() <= fim
do while USO="1" .or. alltrim(CIDADE) # alltrim(mcid)
skip
enddo
repl USO with "1" // Se o campo for "string", senão tire as aspas
sele 2
appe blan
repl USO with CADASSO->USO
repl NOME with CADASSO->NOME
repl ENDERECO with CADASSO->ENDERECO
repl BAIRRO with CADASSO->BAIRRO
repl CIDADE with CADASSO->CIDADE
repl ESTADO with CADASSO->ESTADO
repl DDD with CADASSO->DDD
repl TELEFONE with CADASSO->TELEFONE
repl CEP with CADASSO->CEP
sele 1
skip 1000
enddo
close data
return
Enviado: 05 Jun 2006 10:42
por kristo
Sem palavras, muito obrigado mesmo amigo. Você me ajudou muito, pode acreditar.
So tire uma dúvida minha por favor.
Nesse mesmo banco de dados que vc já conhece eu tenho muito nomes de EMPRESAS, existe alguma forma de limpar esse banco de dados, ou seja copiar as empresas para outra dbf com a mesma estrutura e automaticamente excluir essas Empresas da DBF original?
Não sei se isso é possivel, pois o único campo que tenho é o NOME creio que se tivesse um campo contendo o CGC essa busca ficaria bem mais fácil.
Teria como eu especificar tipo tudo que tenha "LTDA" "CIA""ADVOCACIA" etc... e fazer a coleta através disso?
Grato pela atenção
Enviado: 05 Jun 2006 10:48
por Augusto
Vc diz separar PESSOA FÍSICA de PESSOA JURÍDICA testando o campo "NOME"??
É isso ??
Enviado: 05 Jun 2006 11:27
por kristo
Augusto escreveu:Vc diz separar PESSOA FÍSICA de PESSOA JURÍDICA testando o campo "NOME"??
É isso ??
Isso mesmo meu amigo!
Enviado: 05 Jun 2006 13:41
por Augusto
Seria +/- assim:
Código: Selecionar todos
copy file CADASSO.DBF to PJURID.DBF
sele 1
use CADASSO
sele 2
use PJURID
zap
sele 1
do while .not. eof()
if at("LTDA",NOME) # 0 .or. at("CIA",NOME) # 0 .or. at("ADVOCACIA",NOME) # 0 // Aqui vc continua igual para outros testes
sele 2
appe blan
repl USO with CADASSO->USO
repl NOME with CADASSO->NOME
repl ENDERECO with CADASSO->ENDERECO
repl BAIRRO with CADASSO->BAIRRO
repl CIDADE with CADASSO->CIDADE
repl ESTADO with CADASSO->ESTADO
repl DDD with CADASSO->DDD
repl TELEFONE with CADASSO->TELEFONE
repl CEP with CADASSO->CEP
endif
sele 1
skip
enddo
close data
return
Enviado: 05 Jun 2006 14:14
por kristo
Funcionou meu amigo, mais reparei que que o banco de dados original "cadasso" ainda continua com as Empresas que foram copiadas, tem algum modo de serem apagadas ou que fiquem marcadas como deletadas para depois eu ir pelo DBU e dar um PACK ?
Valeu
Enviado: 05 Jun 2006 17:05
por Augusto
Ai meu Jesus "Kristinho"... Lá vai...
Código: Selecionar todos
copy file CADASSO.DBF to PJURID.DBF
sele 1
use CADASSO
sele 2
use PJURID
zap
ok=.f.
sele 1
do while .not. eof()
if at("LTDA",NOME) # 0 .or. at("CIA",NOME) # 0 .or. at("ADVOCACIA",NOME) # 0 // Aqui vc continua igual para outros testes
sele 2
appe blan
repl USO with CADASSO->USO
repl NOME with CADASSO->NOME
repl ENDERECO with CADASSO->ENDERECO
repl BAIRRO with CADASSO->BAIRRO
repl CIDADE with CADASSO->CIDADE
repl ESTADO with CADASSO->ESTADO
repl DDD with CADASSO->DDD
repl TELEFONE with CADASSO->TELEFONE
repl CEP with CADASSO->CEP
ok=.t.
endif
sele 1
if ok=.t.
dele
ok=.f.
endif
skip
enddo
pack
close data
return
Enviado: 06 Jun 2006 13:13
por kristo
Primeiramente quero agradecer ao desenvolvedor desse fórum, em segundo a essa pessoa Humana e super paciente que me ajudou.
Mesmo sem te conhecer te considero um amigo, um amigo virtual mais, um amigo.
Não falo isso por ter se esforçado para me ajudar, sei que as vezes é difícil e até mesmo chato fazer coisas que muitos julgam simples e sem importância, mais são pessoas assim como vc que ainda nos faz acreditar na boa vontadade do ser humano.
Valeu mesmo.
Fique com Deus, não somente a quem me ajudou mais a todos que ajudam uns aos outros, e acabam fazendo desse Fórum uma comunidade.
Abraços
Kristo.
Enviado: 06 Jun 2006 19:29
por Augusto
Parceiro... não tem o que agradecer...
O objetivo desse fórum é exatamente esse... "AJUDA MÚTUA"...
Quem sabe ensina e quem não sabe aprende... e assim caminha a humanidade...
Pelo incrível que pareça... nessa nossa área não existe aquele papo de "esconder a rapadura"... todo mundo abre o jogo e cada qual vai aumentando seu conhecimento e passando adiante... não devemos guardar para sí aquilo que obtivemos de graça... seria egoísmo...
Sempre que eu puder, ajudarei a vc assim como ajudo e ajudarei outros tantos e, da mesma forma, outros me ajudam também...
Fique a vontade para perguntar e também responder àqueles que vc achar que pode responder...