Como Fazer essa PRG ? Tem como?

[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.

[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

[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...

[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:.............

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...

[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

[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

[Augusto]

Vc diz separar PESSOA FÍSICA de PESSOA JURÍDICA testando o campo "NOME"??
É isso ??

[kristo]

Vc diz separar PESSOA FÍSICA de PESSOA JURÍDICA testando o campo "NOME"??
É isso ??

Isso mesmo meu amigo!

[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

[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

[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 

[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.

[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...