xHarbour

Projeto Harbour

 Harbour Project / xHarbour

Estava faltando descomplicar...

O Projeto Harbour é uma linguagem de programação baseada em xBase compatível com o Clipper que trouxe interatividade ao Windows nunca vista antes. É uma obra fantástica que trouxe o Clipper para Open Source, como o Linux, e promete ser totalmente compatível com a versão 5.x do Clipper, além de ser Freeware! Grátis!

Sem embargo, nem tudo são flores... encontrei problemas desde o download dos arquivos necessários e, principalmente, na configuração, portanto, decidi colaborar com esta página especial com um guia completo.

 

Estava cansado de encontrar tanta coisa dizendo nada sobre o Harbour... Agora eu consegui compilar um .EXE e até uma .LIB, agora é a sua vez ! AVANÇA BRASIL!

Em nome de todos os clippeiros, agradeço a ajuda de Taibnis S. Vieira da empresa Futura Tecnologia em Brasília por revelar o caminho das pedras... Agradeço a todos os outros que também colaboraram para manter esta página o mais operacional possível !

Se você quer saber mais sobre a história do Projeto Harbour, visite: http://pt.wikipedia.org/wiki/Projeto_Harbour


 

A diferença aqui neste novo site é que o usuário registrado poderá adicionar suas informações e ver tudo publicado automaticamente, pois para o usuário registrado aparecerá o link "Nova subpágina" e "Comentar" no rodapé desta página onde o mesmo poderá começar a interagir. Participe! Inclua suas folhas neste livro, anexe exemplos, programas etc.

Download do xHarbour

Harbour Project / xHarbour

Projeto Harbour

 Harbour Project

Estava faltando descomplicar...

 

DOWNLOAD DOS ARQUIVOS

As versões mais novas sempre saem primeiro pelo CVS.

NOVO: http://free.xharbour.com Esse instalador faz tudo sozinho para você!

 

Este tutorial foi feito para a instalação do xHarbour específico para compilação com o Borland C++ Compiler v5.5.

Clique nos links abaixo para fazer o download dos arquivos e passe para a página de instalação.

 

xHARBOUR Binários C:\ ( 4.44Mb) Binaries for Windows BCC 5.5

 http://www.xharbour.org >Download Binaries >Windows >xHarbour Binaries for Borland C++ 5.5.1

xHARBOUR Libs C:\ ( 813Kb)  (link já está ok! Só aqui!)

 http://www.xharbour.org >Download Binaries >Windows > xHarbour Contributions Libraries for Borland C++ 5.5.1 (Não está mostrando no site ainda)
ATENÇÃO: Para fazer o downloads do xHarbour acima funcionarem, pode ser que você tenha que clicar com o botão direito do mouse e escolher "Salvar destino como...".
-Acreditamos que seja um problema esporádico da SourceForge.
Borland C++ Compiler 5.5 c:\bcc55 ( 8.7Mb)
 http://www.borland.com.br >Downloads >C++ Builder >Compiler (Clique em "New User" e registre-se)
 Você precisará preencher um formulário de cadastro; Consentir em receber informações da Borland com "I hereby consent" na página seguinte; preencher um formulário de pesquisa; Concordar com termos e condições com "I agree" para então mostrar a página com os links do download...

 

UPX Freeware

Compactador do executável (do seu aplicativo gerado pelo xharbour).

-Coloque o UPX.EXE no C:\BCC55\BIN

 
Harbour_cfg.zip c:\bcc55\bin  ( 287Bytes)

Documentação completa do xHarbour ( 4.268Kb) OPCIONAL

Norton Guide do xHarbour (antigo)c:\ng ( 173Kb) OPCIONAL

 

  TODOS OS ARQUIVOS ACIMA SÃO FREEWARE, GRATUITOS!

Abaixo dos dois primeiros links estão instruções de como baixar os arquivos diretamente do site em caso de os links acima estiverem "quebrados".


 

Instalação

Projeto Harbour

 Harbour Project

Estava faltando descomplicar...

 

DICAS DE INSTALAÇÃO

1. Descompacte o xHarbour (Binários e LIBs) no diretório raíz do C:\ e já será criado a pasta C:\XHARBOUR com os subdiretórios.

2. Instale o Borland C++ 5.5 no diretório C:\BCC55 

3. Descompacte o arquivo harbour_cfg.zip dentro do subdiretório C:\BCC55\bin

Estes são os arquivos BCC32.CFG e ILINK.CFG.

O arquivo BCC32.CFG contém:

-IC:\bcc55\include;C:\xharbour\include

-LC:\bcc55\lib;C:\xharbour\lib

Enquanto que o arquivo ILINK.CFG contém:

-LC:\BCC55\LIB;C:\XHARBOUR\LIB

Veja que dentro deles estão o caminho de instalação do BCC55 e do xHarbour. O "-I" para arquivos "include" e "-L" para "lib". Se estes caminhos não estiverem corretos, não funcionará! Por isso que tem que instalar nas pastas recomendadas.

4. Inclua no AUTOEXEC.BAT o caminho para C:\XHARBOUR\BIN e C:\BCC55\BIN na variável PATH.

4.1 Localize a linha SET PATH

4.2 Abaixo da linha SET PATH, inclua a seguinte linha:

SET PATH=%PATH%;C:\XHARBOUR\BIN;C:\BCC55\BIN

5. Inclua no AUTOEXEC.BAT, da mesma forma que no passo anterior, as seguintes linhas: 

SET LIB=%LIB%;C:\XHARBOUR\LIB;C:\BCC55\LIB

SET INCLUDE=%INCLUDE%;C:\XHARBOUR\INCLUDE;C:\BCC55\INCLUDE

 

Outra forma de incluir variáveis de ambiente no Windows 2000/XP/NT (principalmente se o Windows não puxou estas variáveis de ambiente do AUTOEXEC.BAT), é seguir os seguintes passos:

INICIAR PAINEL DE CONTROLE SISTEMA AVANÇADO

VARIÁVEIS DE AMBIENTE

Clique no menu "Iniciar", depois em "Painel de Controle". Escolha então "Sistema".

Na janela que abrir, clique na aba "Avançado" e depois no botão "Variáveis de Ambiente".

Na próxima tela, clique no botão "Nova" do quadro "Variáveis do sistema".

Coloque o nome da variável no primeiro campo e o valor no segundo.

 

 

 

 

 

 

 ATENÇÃO! Não altere os diretórios de instalação sugeridos aqui para não complicar sua instalação!

 

Para testar se conseguiu configurar as variáveis de ambiente, use o comando SET no prompt do DOS.

Talvez você precise dar uma pausa para enxergar tudo, então use: SET |MORE ou então mande a saída do comando para um arquivo e abra com o Edit ou Notepad, use o parâmetro ">nome do arquivo" com o comando, assim: SET >AMBI.TXT, depois é só abrir o arquivo criado AMBI.TXT e ver todas as variáveis de ambiente criadas. Talvez você queira mandar esse arquivo para um amigo ou postá-la num fórum para mostrar como está seu ambiente e pedir mais ajuda.

 

Caso você queira deixar o Clipper e o xHarbour rodando quando quiser, observe que as definições do Clipper vem antes do xHarbour, caso contrário não funcionará com ambos.

Exemplo:

SET INCLUDE=C:\COMPILER\CLIPPER5\INCLUDE;C:\Bcc55\include;C:\xHarbour\include

SET LIB=C:\COMPILER\CLIPPER5\LIB;C:\COMPILER\BLINKER\LIB;C:\Bcc55\lib;C:\xHarbour\lib

SET PATH=%PATH%;C:\COMPILER\CLIPPER5\BIN;C:\COMPILER\BLINKER;C:\XHARBOUR\BIN;C:\BCC55\BIN

Funcionamento

Projeto Harbour

 Harbour Project

Estava faltando descomplicar...

 

DICAS DE FUNCIONAMENTO

Como criar um EXEcutável:

É obrigatório a existência de um FUNCTION MAIN() dentro do seu sistema, isso você já sabe, mas no xHarbour, mesmo que você esteje compilando um único PRG, será necessário começar com FUNCTION MAIN() também!

 

O programa HBMAKE é uma ferramenta que cria um arquivo com a extensão ".BC" que equivale aos arquivos "*.RMK" e "*.LNK", facilitando a sua vida. Os principais parâmetros são:

/EX  = Cria o arquivo .BC destinado a constituir um EXE.

/ELX = Cria o arquivo .BC destinado a constituir uma LIB.

/F   = Força a recompilação da lista de programas que compõem o sistema.

Se não for informado nenhum parâmetro, vai compilar só os programas listados no arquivo .BC que foram modificados desde a última compilação.

 

Vamos compilar o clássico "hello world". Em um editor de texto qualquer, crie o seguinte arquivo:

 

function main()
? "hello world"

 

Salve-o como "OI.prg".

 

Para criar o oi.exe você vai primeiro criar o arquivo da compilação, o oi.bc:

HBMAKE OI.BC /EX

 

Depois você vai compilar assim:

HBMAKE OI.BC

 

 

Veja o passo-a-passo a seguir:

 

Os comandos para criação de um executável são:

 

Para criar um arquivo de compilação de um EXE (aplicativo):

HBMAKE nome.bc /EX

 

...e para compilar o aplicativo:

HBMAKE nome.bc

Irá compilar somente os PRGs alterados desde a última compilação.

 

Para forçar a recompilação de todos os PRGs:

HBMAKE nome.bc /F

Este parâmetro /F também regera o arquivo HARBOUR.CFG, não há problema nisso.

 

Onde "nome.bc" é o nome do script que você vai criar, ponha o nome que quiser, mas deixe a extensão .BC. O arquivo .BC só precisa ser criado uma única vez, a não ser que você deseje incluir novos programas no seu sistema.

No primeiro passo, é criado um arquivo com o nome nome.bc (pode ser qualquer nome, mas a extensão é bc). Este arquivo é um tipo de mescla de RMK e LNK do Clipper. É um roteiro (ou script, como preferir) de compilação.

Nesta primeira chamada é aberta uma janela do DOS com algumas perguntas sobre qual o sistema operacional, compilador, LIB gráfica, RDDs etc.

 

Vamos demonstrar de forma ilustrada os passos básicos para a compilação de um programa comum (sem Libs gráficas ou RDDs) para ser executado na plataforma Windows e compilado usando o Borland C++ que você baixou deste site.

HBMAKE oi.bc /EX

A tela que se apresenta é a seguinte:

 

Basta você ir teclando <Enter> até "[X]Comprimir App"*, marque-o para produzir executáveis menores e até o "Nome Executável", onde você vai por o nome do arquivo .EXE que será gerado. Neste exemplo acima, será gerado OI.EXE.

*Para comprimir o executável, você precisará baixar o UPX.

Após por o Nome do Executável, abrirá outros campos como visto a seguir:

Vá teclando <Enter> até o "[X] Compila apenas o módulo /m", marque-o e continue teclando <Enter> até aparecer uma pequena janela com uma lista de todos os arquivos .PRG do diretório corrente, como na tela seguir:

 

Nesta janela que se abre, você vai selecionar, teclando com a barra de espaços do seu teclado, todos os arquivos .PRG que vão fazer parte do seu sistema e depois deverá teclar <Enter> para finalizar.

Esta janela irá fechar e aparecerá outras opções, mas vá teclando <Enter> até a pergunta "Compilar app?", no canto inferior esquerdo da tela, veja a tela seguinte:

 

Responda com "S" para compilar o seu sistema agora ou "N" para compilar depois com HBMAKE OI.BC no prompt do MS-DOS.

 

Voilà! Está pronto o seu roteiro (ou script, como preferir) para compilar o arquivo EXEcutável. Observe que este processo todo serve apenas para criar o arquivo com a extensão .BC, que nunca mais necessitará ser criado de novo ao menos que você queira incluir um novo arquivo .PRG no seu sistema posteriormente.

 

No segundo passo é feita a criação do executável.

HBMAKE oi.bc

ou

HBMAKE oi.bc /F

Caso seu programa não apresente erros, a tela que se apresenta é a seguinte:

Caso dê algum erro, abra o arquivo com a extensão .OUT ou .LOG para entender o que aconteceu.

 

Para criar uma LIB:

HBMAKE nomedalib.bc /ELX

HBMAKE nomedalib.bc

O programa da LIB deve começar com a criação de uma função qualquer, tipo FUNCTION TESTE(). Não ponha o nome de "MAIN" porque esta função FUNCTION MAIN() é reservada para chamar o programa principal do sistema, ou seja, o programa do sistema que executa primeiro, aquele que prepara o ambiente, a tela e o menu do sistema, por exemplo.

A primeira chamada de HBMAKE cria um arquivo com a extensão .BC, que já falamos anteriormente. Marque apenas a opção: [X] Compila apenas o módulo /m

A segunda chamada de HBMAKE cria a LIB propriamente dita.

Os problemas de programação só aparecem na segunda chamada e podem ser analisados abrindo o arquivo com a extensão .OUT ou .LOG.

 

Exemplo de primeiras linhas de um sistema em xHarbour:

*** SETs SET SCOREBOARD OFF SET DATE BRITISH SET MESSAGE TO 24 SET DELETED ON SET EPOCH TO 1980 SETMODE(25,80) SET OPTIMIZE ON      // otimização de filtros (SET FILTER TO) SETMOUSE(.t.)        // Mostra o cursor do mouse na tela SET EVENTMASK TO 255 // INKEY_ALL = MOUSE NOS GETs SET TIME FORMAT TO "hh:mm" SETCOLOR(cCOR) SET CONFIRM ON

*** DEFINIR IDIOMA PORTUGUÊS *** REQUEST HB_LANG_PT REQUEST HB_CODEPAGE_PT850 HB_LangSelect("PT") HB_SetCodePage("PT850")

#IFDEF __GTWVW__    wvw_setcodepage(,255) // acentos com a lib GTWVW. "__GTWVW__" precisa estar definido. #ENDIF

*** DEFINIR TIPO DE BANCO DE DADOS: DBFCDX Nativo *** REQUEST DBFCDX REQUEST DBFFPT ANNOUNCE FPTCDX RDDSETDEFAULT("DBFCDX") RDDREGISTER( "DBFCDX", 1 ) // RDT_FULL SET AUTOPEN OFF

 Veja mais sobre CDX.

Observe que o "modo de edição rápida" das propriedades da janela do MS-DOS tem que estar desativada para o mouse funcionar, tipo:

Links

Projeto Harbour Project - Download, Dicas de Instalação e Funcionamento.

Projeto Harbour

 Harbour Project

Estava faltando descomplicar...


LINKS

Páginas oficiais:

 

Projeto Harbour - Versão Freeware/Open Source (Compilador)

http://www.harbour-project.org

http://www.xharbour.org

 

Borland C++ Compiler Freeware (Linkador)

http://www.borland.com/products/downloads/download_cbuilder.html

http://www.borland.com

 

Projeto Harbour - Versão Comercial (Compilador+Linkador)

http://www.xharbour.com.br

http://www.xharbour.com

 

 

Grupo de Notícias (Newsgroup) - Obtenha ajuda aqui (Use MS Outlook)

 

news://news.xharbour.org/xHarbour.Spanish.Portuguese

news://news.xharbour.org/xHarbour

 

 

Outros sites sobre o Projeto Harbour etc.

 

How to Projeto Harbour -Outro site com mais dicas de download, instalação e funcionamento.

http://www.susviela.hpg.ig.com.br/hb/ -Dicas para Harbour e curso de Harbour MiniGUI (HMG -Lib gráfica p/ o Harbour)

 

CoreFTP freeware -Melhor FTP grátis. Ao invés de baixar arquivos um a um, selecione as pastas e automatize o download. Útil p/ baixar o DJGPP.

 

Turbo Assembler 5 Freeware (completo)

tasm5_1.zip, tasm5_2.zip e tasm5_3.zip.

 

BISON Freeware

http://www.gnu.org/software/bison/

 

DJGPP Freeware

http://www.delorie.com/djgpp/

 

 

Libs Gráficas

 

HwGUI  (freeware/Open source) -É multi-plataforma!

Quem quiser migrar para Windows gratuitamente, use esta LIB.

 

Visual xHarbour  (Software/Comercial)

Linguagem Visual interativa para Windows e programável para Clipper (xBase).

Quem disse que o navio iria afundar e você iria morrer na praia?! Quem programa em Clipper pode ancorar o navio neste porto!!!

Quem abandonou o navio (Clipper) e está no Delphi ou VB, pode voltar ao porto (Harbour) e entrar no navio (Clipper) de novo!!!

(A linguagem Clipper é simbolizada por um navio e "Harbour" quer dizer "porto")

 

FiveWin for Harbour (FWH) - FiveTech Software  (Software/Comercial)

 

Visual Lib 2.3 (freeware) ( 1429Kb)

A mesma Visual Lib do Clipper agora na versão compatível com o Harbour/xHarbour. Continua sendo uma LIB pseudo visual, fazendo o mesmo que antes. Para conseguir arquivos reais do Windows, use uma das outras LIBs acima.

 

MWVW (Software/Comercial) NOVO!

A MWVW.LIB tem como objetivo principal, facilitar na conversão e utilização moderada de recursos gráficos visuais, usando parcialmente o que esta presente na GTWVW.LIB (OpenSource criado por Budyanto Dj).
É destinada para sistemas desenvolvidos em xHarbour modo texto na plataforma Windows (mas poderá usar em conjunto com outras libs gráficas).

 

 

Outras LIBs

 

SIBRAH - Sistema de Impressão BRAsileiro para Harbour  (Software/Trial

Para quem quiser imprimir em qualquer impressora sem precisar aprender muita coisa e aproveitar o melhor do xHarbour! Imprime gráficos, código de barras etc. Já estão embutidos a GDLIB e a FreeImage dentro desta LIB.

 

GDLIB (freeware) CVS: C:\XHARBOUR\CONTRIB\GD

LIB para imprimir em código de barras: EAN13, EAN8 e EAN128 A/B/C. Possui capacidade para desenhar etc.

-Coloque o arquivo bgd.dll no diretório indicado e chame "MAKE_B32.BAT".

*Caso dê erro, abra o arquivo "makefile.bc" e edite a linha "BCC_DIR=C:\XHARBOUR\BCC55".

 

FreeImage (freeware) CVS: C:\XHARBOUR\CONTRIB\FREEIMAGE

LIB para tratamento de imagens. Converte um tipo de imagem em outro etc.

-Coloque o arquivo freeimage.dll no diretório indicado e chame "MAKE_B32.BAT".

*Caso dê erro, abra o arquivo "makefile.bc" e edite a linha "BCC_DIR=C:\XHARBOUR\BCC55".

 

CVS

Projeto Harbour Project - Download, Dicas de Instalação e Funcionamento.

Projeto Harbour

 Harbour Project

Estava faltando descomplicar...


CVS - Compilar o xHARBOUR a partir dos fontes

Tortoise CVS

Só para programadores avançados!

Para compilar o xHarbour a partir dos fontes, você precisa baixar os fontes com o Tortoise CVS e instalar as ferramentas para compilá-lo: o DJGPP; BISON e TASM32.EXE (do Turbo Assembler 5). O Borland C++ Compiler 5.5 também precisa estar instalado, deixe-o no c:\bcc55.

Depois, você configura algumas variáveis de ambiente do MS-DOS e chama dois arquivos de lote (.BAT). Veja a seguir:

 

CVS Freeware/Open Source

http://www.tortoisecvs.org/

Clique em "Downloads", procure uma versão estável (stable), normalmente é o primeiro download listado.

Exemplo:

Stable (for deployment) - TortoiseCVS-1.8.25.exe - 5.67 MB - 11th February 2006

Release announcement, including list of major changes

 

Você será redirecionado para uma página de mirror. Escolha um qualquer (de preferência no Brasil ou mais próximo) e clique no link Download da coluna Download.
 

O Tortoise CVS é o aplicativo por meio do qual você baixa os fontes do xharbour no seu computador.

 

1) Baixe o CVS, instale (sem mudar nada) e reinicie seu computador.

2) Como usar: Execute o "Windows Explorer"; clique com o botão direito do mouse na "unidade C:\"; clique em "Obter módulo" e preencha os dados conforme a figura abaixo; clique em "Ok".

 

Borland C++ Compiler 5.5 c:\bcc55 ( 8.7Mb)
-Baixe e instale no diretório indicado.
 
Harbour_cfg.zip c:\bcc55\bin ( 287Byte)

-Baixe e instale no diretório indicado.

 

O BORLAND C++ 5.5 é o compilador oficial dos fontes do xHarbour para Windows.


 

DJGPP v2.01 Freeware C:\DJGPP

ftp://ftp.delorie.com/pub/djgpp/ (melhor usar FTP)

     - Com FTP, use: Usuário, anonymous e senha, seu email.

http://www.delorie.com/pub/djgpp/current/ (download um a um)

-Baixe e instale no diretório indicado.

 

"Use folder names" deve estar marcado, se você usar o Winzip para descompactação.

*É preciso preservar a estrutura dos diretórios ao descompactar (Leia o arquivo de texto README.1ST em C:\DJGPP para a instalação -está em inglês!)

 

O DJGPP é o compilador oficial dos fontes do xHarbour para DOS.


 

BISON Freeware v2.1

C:\BISON (clique aqui)  

-Baixe e descompacte o .ZIP no diretório indicado.

 

A versão recomendada atualmente é a 2.1.

Instale no C:\BISON e altere o PATH de C:\BISON para C:\BISON\BIN, neste caso.

 

Observação: Eu compilava o xharbour apenas com a primeira sugestão deste download, nunca precisei baixar a versão completa; no entanto, quis baixar a versão completa, mas não mudou em nada; continua compilando do mesmo jeito. Se a sua conexão com a internet é devagar, você deverá preferir baixar só os arquivos necessários do BISON, na primeira sugestão.
 

BISON é o parser (analisador gramatical), usado para construir o compilador xharbour

 


 

Turbo Assembler 5 Freeware

C:\BCC55\Bin\tasm32.exe (só o necessário)  

-Baixe, descompacte o .ZIP e copie o arquivo no diretório indicado.

 


 

UPX Freeware

Compactador do executável (do seu aplicativo gerado pelo xharbour).

-Coloque o UPX.EXE no C:\BCC55\BIN

 


 

Defina as seguintes variáveis de ambiente:

(Crie um arquivo de lote ou insira estas linhas no AUTOEXEC.BAT)

SET PATH=%PATH%;C:\BCC55\BIN;c:\bison\bin;c:\xharbour;c:\xharbour\bin;C:\DJGPP\BIN
SET INCLUDE=%INCLUDE%;c:\Bcc55\include;c:\xHarbour\include
SET LIB=%LIB%;c:\Bcc55\lib;c:\xHarbour\lib
SET HB_LEX=SIMPLEX
SET BISON_SIMPLES=c:/bison/bison.simple
SET CFLAGS= -5 -OS -a8
SET HB_PATH=C:\XHARBOUR

SET DJGPP=C:\DJGPP\DJGPP.ENV
(grifos cinza para
ficar mais legível, não significa nada)

 


 

Chamar os arquivos de lote (.BAT) a seguir; na ordem:

MAKE_B32 clean

MAKE_B32 all

-Estes arquivos de lote estão no diretório "C:\xharbour".

Estes arquivos de lote é que executarão a compilação dos fontes do xHarbour.

 


Caso tenha problemas, compare as pastas instaladas com as pastas indicadas nas variáveis de ambiente (listadas nos arquivos ".BAT" ou ".CFG") ou busque ajuda no Grupo de Notícias (Newsgroup).

 


ADS - Advantage Data Server

1. INSTALAÇÃO

 

1.1 Faça o download das DLLs requeridas no link abaixo:

Advantage Client Engine API 8.1 (for Windows)

É preciso se cadastrar para fazer o download, mas é muito fácil e rápido. Depois, aparece na tela todos os links para download. Não precisa ficar esperando nada por email.

 

1.2 Depois de instalar, você irá copiar as DLLs da pasta: C:\Arquivos de programas\Extended Systems\Advantage 8.1\acesdk

     Para a pasta: c:\Windows\System32

 

1.3 Copie o arquivo ads.ch da pasta: C:\xharbour\contrib\rdd_ads

     Para a pasta: c:\xharbour\include

 

1.4 Executar o comando:  implib c:\xharbour\lib\ace32.lib c:\windows\system32\ace32.dll

 

 

2. UTILIZAÇÃO

 

2.1 Inclua as seguintes linhas no seu programa principal:

 

REQUEST ADS
rddRegister( "ADS", 1 )
rddsetdefault( "ADS" )
SET SERVER LOCAL

REQUEST HB_CODEPAGE_PT850 &&& PARA INDEXAR CAMPOS ACENTUADOS
HB_SETCODEPAGE("PT850")   &&& PARA INDEXAR CAMPOS ACENTUADOS

 

2.2 Edite o seu arquivo de compilação do HBMAKE para incluir o seguinte:

Rdd Terceiros: RddAds

2.3 Você precisará do arquivo RDDADS.LIB que vem na pasta CONTRIB do xHarbour em CVS, se você estiver baixado o xHarbour pelos binários não terá este arquivo, portanto baixe-o no link abaixo:

RDDADS.LIB ( 28,8Kb)

 

3. DICAS

 

3.1 Para deixar a abertura dos DBFs mais rápida, use: AdsRightsCheck( .F. )
 

3.2 Para evitar que o arquivo de índice (CDX) seja aberto automaticamente (impedindo a reindexação), use: SET AUTOPEN OFF
 

***Você pode querer usar o comando acima apenas na rotina de reindexação dos arquivos, ou seja, SET AUTOPEN OFF no início da rotina e SET AUTOPEN ON no final dela.

 

Pronto! Agora é só tratar os DBF como se fossem RDDCDX, com indices CDX. Veja mais.

Conectando na web via xHarbour

Projeto Harbour

 Harbour Project

Estava faltando descomplicar...

Vide exemplo de minha autoria que baixa um arquivo da internet... talvez ficar milionário!

Para trabalhar com as funções HB_UNZIPFILE e HB_ZIPFILE você precisa linkar as LIBs: hbzip.lib; hbmzip.lib; zlib.lib.

 

Estamos anexando o programa para download no rodapé.

 

 

 

 

FUNCTION MAIN()
*** definições iniciais ***-------------------------------------------------
SETMODE(60,132)
*** SETs
SET SCOREBOARD OFF
SET DATE BRITISH
SET(36, 23)
SET(37, .F.)
SET DELETED ON
SET EPOCH TO 1980
SETMODE(25,80)
SET MESSAGE TO 24
SET OPTIMIZE ON
SETMOUSE(.t.)
SET(39,159) // MOUSE NOS GETs
SET TIME FORMAT TO "hh:mm"
SET CENTURY ON
SET CONFIRM ON

REQUEST HB_LANG_PT
HB_LangSelect("PT")
HB_SetCodePage("PT850")

#IFDEF __GTWVW__
   wvw_setcodepage(,255)
#ENDIF

*** DEFINIR TIPO DE BANCO DE DADOS: DBFCDX Nativo ***
REQUEST DBFCDX
REQUEST DBFFPT
ANNOUNCE FPTCDX
RDDSETDEFAULT("DBFCDX")
RDDREGISTER( "DBFCDX", 1 ) // RDT_FULL
SET AUTOPEN OFF

*** DEFINIR IDIOMA PORTUGUÊS ***
REQUEST HB_CODEPAGE_PT850 &&& PARA INDEXAR CAMPOS ACENTUADOS
HB_SETCODEPAGE("PT850")   &&& PARA INDEXAR CAMPOS ACENTUADOS

*** LIMPA A TELA E MOSTRA PRIMEIRAS INFORMAÇÕES
CLS
? "*** MEGASENA ***"
? "SORTEIOS SÃO REALIZADOS ÀS QUARTAS E SÁBADOS"
?
dBANCO := FILEDATE("SENA.DBF") // DATA DE GERAÇÃO DO ARQUIVO SENA.DBF
? "HOJE: "+DTOC(DATE()) + " - ÚLTIMA CARGA: "+DTOC(dBANCO)
?

IF EMPTY(dBANCO) .OR. DATE() # dBANCO
   IF (ALERT("ATUALIZA ARQUIVOS AGORA?", {"SIM", "NÃO"}))=1

      *** BAIXA ARQUIVO COM OS RESULTADOS DA INTERNET AUTOMATICAMENTE
      cURL := "http://www1.caixa.gov.br/loterias/_arquivos/loterias/D_megase.zip"
      oHTTP := TIpClientHttp():new( cURL )
      cARQ := "D_MEGA.HTM" // ARQUIVO COM OS RESULTADOS DOS SORTEIOS
      cZIP := "D_megase.zip"
      IF oHTTP:OPEN()
         ? "BAIXANDO ARQUIVO COM OS RESULTADOS DA INTERNET..."
         ? cURL
         ?
         cBIN := oHttp:readAll() // BAIXA ARQUIVO E GRAVA EM cBIN
         oHTTP:CLOSE()
         Memowrit( cZIP, cBIN )  // CRIA ARQUIVO COM cBIN

         IF FILE(cZIP)
            ? cZIP, ALLTRIM(STR( HB_FSIZE(cZIP)/1024 ))+"Kb", FILEDATE(cZIP)
            ? "SUCESSO!"
            ?
         ENDIF

         ? "DESCOMPACTANDO O ARQUIVO '"+cARQ+"' DE 'D_megase.zip'"
         IF HB_UNZIPFILE(cZIP,,,,".\",cARQ)
            ? cARQ, ALLTRIM(STR( HB_FSIZE(cARQ)/1024 ))+"Kb", FILEDATE(cARQ)
            ? "SUCESSO!"
            ?
         ELSE
            ? "NÃO FOI POSSÍVEL DESCOMPACTAR O ARQUIVO '"+cARQ+"' AUTOMATICAMENTE"
            ? "DESCOMPACTE-O MANUALMENTE AQUI NESTA PASTA DO PROGRAMA"
            ?
         ENDIF
      ELSE
         ? "Erro de conexão:", oHttp:lastErrorMessage()
         ? "BAIXE O ARQUIVO "+cURL+ " MANUALMENTE DA INTERNET E DESCOMPACTE ELE NA PASTA DESTE PROGRAMA."
      ENDIF

      IF !FILE(cARQ)
         ? "NÃO É POSSÍVEL ATUALIZAR SEM O ARQUIVO '"+cARQ+"'."
         ? "ABORTANDO PROGRAMA..."
         QUIT
      ENDIF

      *** RECIPIENTE DO ARQUIVO IMPORTADO
      ? TIME()+" - CRIANDO BANCO DE DADOS RECIPIENTE DO ARQUIVO D_MEGA.HTM..."
      RUN ("DEL SENA.DBF")
      aDBF = {}
      aadd(aDBF, {"TAG",   "C",    4, 0})
      aadd(aDBF, {"DATA",  "C",   10, 0}) // PEGAR DATA SORTEIO COMO MARCO INICIAL
      aadd(aDBF, {"RESTO", "C", 3000, 0})
      dbcreate("SENA.DBF", aDBF)

      ? TIME()+" - RENOMEANDO O ARQUIVO D_MEGA.HTM P/ D_MEGA.TXT P/ IMPORTAÇÃO DAS INFORMAÇÕES..."
      IF FILE("D_MEGA.HTM")
         RUN ("DEL D_MEGA.TXT")
         RUN RENAME D_MEGA.HTM D_MEGA.TXT
      ELSEIF !FILE("D_MEGA.TXT")
             ? "ALERTA: FALTA BAIXAR ARQUIVO COM OS RESULTADOS DA MEGASENA"
             ? "ABORTANDO..."
             QUIT
      ENDIF

      ? TIME()+" - IMPORTANDO TODAS AS INFORMAÇÕES DO ARQUIVO D_MEGA.HTM PARA SENA.DBF..."
      USE SENA ALIAS SE EXCLUSIVE NEW
      APPEND FROM D_MEGA.TXT SDF

      ? TIME()+" - CRIANDO ARQUIVO SORTEIOS.DBF P/ ARMAZENAR SÓ AS DEZENAS JÁ SORTEADAS..."
      IF FILE("SORTEIOS.DBF")
         RUN ("DEL SORTEIOS.DBF")
      ENDIF
      aDBF = {}
      aadd(aDBF, {"DEZ1", "N", 2, 0})
      aadd(aDBF, {"DEZ2", "N", 2, 0})
      aadd(aDBF, {"DEZ3", "N", 2, 0})
      aadd(aDBF, {"DEZ4", "N", 2, 0})
      aadd(aDBF, {"DEZ5", "N", 2, 0})
      aadd(aDBF, {"DEZ6", "N", 2, 0})
      dbcreate("SORTEIOS.DBF", aDBF)

      ? TIME()+" - LENDO O ARQUIVO SENA.DBF PARA GRAVAR AS DEZENAS SORTEADAS EM SORTEIOS.DBF..."
      USE SORTEIOS ALIAS DEZ EXCLUSIVE NEW
      SELECT SE // SENA.DBF
      SE->(DBGOTOP()) // POSICIONA NO 1° REGISTRO

      DO WHILE !SE->(EOF()) // FAÇA ENQUANTO NÃO É FIM DO ARQUIVO
         dSORTEIO := CTOD(SE->DATA) // TRANSFORMA CAMPO CARACTER PARA DATA, SE FOR DATA.
         IF !EMPTY(dSORTEIO)
            // SE TRANSFORMOU, O CAMPO É DATA. NO CASO, A DATA DO SORTEIO.
            // AS 6 LINHAS SEGUINTES SÃO AS DEZENAS SORTEADAS.
            SE->(DBSKIP()) // PULA P/ PROXIMA LINHA

            DEZ->(DBAPPEND()) // INSERE REGISTRO EM BRANCO

            // AS 6 LINHAS SEGUINTES SÃO AS DEZENAS SORTEADAS
            DEZ->DEZ1 := VAL( LEFT(SE->DATA,2) )
            SE->(DBSKIP()) // PULA P/ PROXIMA LINHA

            DEZ->DEZ2 := VAL( LEFT(SE->DATA,2) )
            SE->(DBSKIP())

            DEZ->DEZ3 := VAL( LEFT(SE->DATA,2) )
            SE->(DBSKIP())

            DEZ->DEZ4 := VAL( LEFT(SE->DATA,2) )
            SE->(DBSKIP())

            DEZ->DEZ5 := VAL( LEFT(SE->DATA,2) )
            SE->(DBSKIP())

            DEZ->DEZ6 := VAL( LEFT(SE->DATA,2) )
         ENDIF
         SE->(DBSKIP())
      ENDDO
      SE->(DBCOMMIT()) // DESPEJA CACHE NO DISCO, FORÇA GRAVAÇÃO.

      ? TIME()+" - CRIANDO ARQUIVO RANKING.DBF P/ RANKING DAS DEZENAS MAIS SORTEADAS..."
      RUN ("DEL RANKING.DBF")
      RUN ("DEL RANKING.CDX")

      // AS 6 DEZENAS NEM SEMPRE CONTÉM OS NÚMEROS MAIS SORTEADOS
      // POR ISSO FAREMOS UM RANKING PARA CADA UMA DAS 6 DEZENAS
      // ASSIM AUMENTAMOS A CHANCE
      aDBF = {}
      aadd(aDBF, {"DEZ1", "N", 2, 0}) // DEZENA
      aadd(aDBF, {"RPT1", "N", 5, 0}) // VEZES QUE ELA SE REPETE
      aadd(aDBF, {"RNK1", "N", 2, 0}) // RANKING: POSIÇÃO EM QUE OCUPA ENTRE AS MAIS SORTEADAS
      aadd(aDBF, {"DEZ2", "N", 2, 0})
      aadd(aDBF, {"RPT2", "N", 5, 0})
      aadd(aDBF, {"RNK2", "N", 2, 0})
      aadd(aDBF, {"DEZ3", "N", 2, 0})
      aadd(aDBF, {"RPT3", "N", 5, 0})
      aadd(aDBF, {"RNK3", "N", 2, 0})
      aadd(aDBF, {"DEZ4", "N", 2, 0})
      aadd(aDBF, {"RPT4", "N", 5, 0})
      aadd(aDBF, {"RNK4", "N", 2, 0})
      aadd(aDBF, {"DEZ5", "N", 2, 0})
      aadd(aDBF, {"RPT5", "N", 5, 0})
      aadd(aDBF, {"RNK5", "N", 2, 0})
      aadd(aDBF, {"DEZ6", "N", 2, 0})
      aadd(aDBF, {"RPT6", "N", 5, 0})
      aadd(aDBF, {"RNK6", "N", 2, 0})
      dbcreate("RANKING.DBF", aDBF)

      USE RANKING ALIAS RNK EXCLUSIVE NEW
      // CRIANDO ARQUIVO DE ÍNDICES
      INDEX ON STRZERO(DEZ1,2) TAG DEZ1 TO RANKING
      INDEX ON DESCEND( STRZERO(RPT1,2) )   TAG RPT1 TO RANKING
      INDEX ON STRZERO(RNK1,2) TAG RNK1 TO RANKING
      INDEX ON STRZERO(DEZ2,2) TAG DEZ2 TO RANKING
      INDEX ON DESCEND( STRZERO(RPT2,2) )   TAG RPT2 TO RANKING
      INDEX ON STRZERO(RNK2,2) TAG RNK2 TO RANKING
      INDEX ON STRZERO(DEZ3,2) TAG DEZ3 TO RANKING
      INDEX ON DESCEND(STRZERO(RPT3,2)  )   TAG RPT3 TO RANKING
      INDEX ON STRZERO(RNK3,2) TAG RNK3 TO RANKING
      INDEX ON STRZERO(DEZ4,2) TAG DEZ4 TO RANKING
      INDEX ON DESCEND(STRZERO(RPT4,2)  )   TAG RPT4 TO RANKING
      INDEX ON STRZERO(RNK4,2) TAG RNK4 TO RANKING
      INDEX ON STRZERO(DEZ5,2) TAG DEZ5 TO RANKING
      INDEX ON DESCEND(STRZERO(RPT5,2)  )   TAG RPT5 TO RANKING
      INDEX ON STRZERO(RNK5,2) TAG RNK5 TO RANKING
      INDEX ON STRZERO(DEZ6,2) TAG DEZ6 TO RANKING
      INDEX ON DESCEND(STRZERO(RPT6,2) )   TAG RPT6 TO RANKING
      INDEX ON STRZERO(RNK6,2) TAG RNK6 TO RANKING
      SET INDEX TO RANKING // ABRINDO ARQUIVO DE ÍNDICES

      ? TIME()+" - LEVANTANDO INFORMAÇÕES SOBRE CADA BOLA SORTEADA..."

      // VAMOS CRIAR 60 REGISTROS EM BRANCO P/ GUARDAR AS INFORMAÇÕES
      FOR X=1 TO 60
          RNK->(DBAPPEND())
      NEXT

      ? "1ª BOLA:"
      ? TIME()+" - VERIFICANDO QUANTAS VEZES CADA DEZENA FOI SORTEADA..."
      RNK->(ORDSETFOCUS("DEZ1")) // POR ORDEM DE DEZENA
      DEZ->(DBGOTOP())
      RNK->(DBGOTOP())
      DO WHILE !DEZ->(EOF())
         IF !RNK->(DBSEEK( STRZERO(DEZ->DEZ1,2) ))
            RNK->(DBGOTOP()) // POSICIONA NO INICIO DO ARQUIVO
            DO WHILE !EMPTY(RNK->DEZ1) // DESCE ATÉ ACHAR UM CAMPO EM BRANCO
               RNK->(DBSKIP())
            ENDDO

            RNK->DEZ1 := DEZ->DEZ1
            RNK->RPT1 := 1
         ELSE
            RNK->RPT1++
         ENDIF
         DEZ->(DBSKIP())
      ENDDO

      ? TIME()+" - FAZENDO O RANKING DAS MAIS SORTEADAS..."
      RNK->(ORDSETFOCUS("RPT1")) // POR ORDEM DE REPETIÇÃO DA DEZENA
      RNK->(DBGOTOP())
      nRANK := 1
      DO WHILE !RNK->(EOF())
         RNK->RNK1 := nRANK++
         RNK->(DBSKIP())
      ENDDO

      ? "2ª BOLA:"
      ? TIME()+" - VERIFICANDO QUANTAS VEZES CADA DEZENA FOI SORTEADA..."
      RNK->(ORDSETFOCUS("DEZ2")) // POR ORDEM DE DEZENA
      DEZ->(DBGOTOP())
      RNK->(DBGOTOP())
      DO WHILE !DEZ->(EOF())
         IF !RNK->(DBSEEK( STRZERO(DEZ->DEZ2,2) ))
            RNK->(DBGOTOP()) // POSICIONA NO INICIO DO ARQUIVO
            DO WHILE !EMPTY(RNK->DEZ2) // DESCE ATÉ ACHAR UM CAMPO EM BRANCO
               RNK->(DBSKIP())
            ENDDO

            RNK->DEZ2 := DEZ->DEZ2
            RNK->RPT2 := 1
         ELSE
            RNK->RPT2++
         ENDIF
         DEZ->(DBSKIP())
      ENDDO

      ? TIME()+" - FAZENDO O RANKING DAS MAIS SORTEADAS..."
      RNK->(ORDSETFOCUS("RPT2")) // POR ORDEM DE REPETIÇÃO DA DEZENA
      RNK->(DBGOTOP())
      nRANK := 1
      DO WHILE !RNK->(EOF())
         RNK->RNK2 := nRANK++
         RNK->(DBSKIP())
      ENDDO

      ? "3ª BOLA:"
      ? TIME()+" - VERIFICANDO QUANTAS VEZES CADA DEZENA FOI SORTEADA..."
      RNK->(ORDSETFOCUS("DEZ3")) // POR ORDEM DE DEZENA
      DEZ->(DBGOTOP())
      RNK->(DBGOTOP())
      DO WHILE !DEZ->(EOF())
         IF !RNK->(DBSEEK( STRZERO(DEZ->DEZ3,2) ))
            RNK->(DBGOTOP()) // POSICIONA NO INICIO DO ARQUIVO
            DO WHILE !EMPTY(RNK->DEZ3) // DESCE ATÉ ACHAR UM CAMPO EM BRANCO
               RNK->(DBSKIP())
            ENDDO

            RNK->DEZ3 := DEZ->DEZ3
            RNK->RPT3 := 1
         ELSE
            RNK->RPT3++
         ENDIF
         DEZ->(DBSKIP())
      ENDDO

      ? TIME()+" - FAZENDO O RANKING DAS MAIS SORTEADAS..."
      RNK->(ORDSETFOCUS("RPT3")) // POR ORDEM DE REPETIÇÃO DA DEZENA
      RNK->(DBGOTOP())
      nRANK := 1
      DO WHILE !RNK->(EOF())
         RNK->RNK3 := nRANK++
         RNK->(DBSKIP())
      ENDDO

      ? "4ª BOLA:"
      ? TIME()+" - VERIFICANDO QUANTAS VEZES CADA DEZENA FOI SORTEADA..."
      RNK->(ORDSETFOCUS("DEZ4")) // POR ORDEM DE DEZENA
      DEZ->(DBGOTOP())
      RNK->(DBGOTOP())
      DO WHILE !DEZ->(EOF())
         IF !RNK->(DBSEEK( STRZERO(DEZ->DEZ4,2) ))
            RNK->(DBGOTOP()) // POSICIONA NO INICIO DO ARQUIVO
            DO WHILE !EMPTY(RNK->DEZ4) // DESCE ATÉ ACHAR UM CAMPO EM BRANCO
               RNK->(DBSKIP())
            ENDDO

            RNK->DEZ4 := DEZ->DEZ4
            RNK->RPT4 := 1
         ELSE
            RNK->RPT4++
         ENDIF
         DEZ->(DBSKIP())
      ENDDO

      ? TIME()+" - FAZENDO O RANKING DAS MAIS SORTEADAS..."
      RNK->(ORDSETFOCUS("RPT4")) // POR ORDEM DE REPETIÇÃO DA DEZENA
      RNK->(DBGOTOP())
      nRANK := 1
      DO WHILE !RNK->(EOF())
         RNK->RNK4 := nRANK++
         RNK->(DBSKIP())
      ENDDO

      ? "5ª BOLA:"
      ? TIME()+" - VERIFICANDO QUANTAS VEZES CADA DEZENA FOI SORTEADA..."
      RNK->(ORDSETFOCUS("DEZ5")) // POR ORDEM DE DEZENA
      DEZ->(DBGOTOP())
      RNK->(DBGOTOP())
      DO WHILE !DEZ->(EOF())
         IF !RNK->(DBSEEK( STRZERO(DEZ->DEZ5,2) ))
            RNK->(DBGOTOP()) // POSICIONA NO INICIO DO ARQUIVO
            DO WHILE !EMPTY(RNK->DEZ5) // DESCE ATÉ ACHAR UM CAMPO EM BRANCO
               RNK->(DBSKIP())
            ENDDO

            RNK->DEZ5 := DEZ->DEZ5
            RNK->RPT5 := 1
         ELSE
            RNK->RPT5++
         ENDIF
         DEZ->(DBSKIP())
      ENDDO

      ? TIME()+" - FAZENDO O RANKING DAS MAIS SORTEADAS..."
      RNK->(ORDSETFOCUS("RPT5")) // POR ORDEM DE REPETIÇÃO DA DEZENA
      RNK->(DBGOTOP())
      nRANK := 1
      DO WHILE !RNK->(EOF())
         RNK->RNK5 := nRANK++
         RNK->(DBSKIP())
      ENDDO

      ? "6ª BOLA:"
      ? TIME()+" - VERIFICANDO QUANTAS VEZES CADA DEZENA FOI SORTEADA..."
      RNK->(ORDSETFOCUS("DEZ6")) // POR ORDEM DE DEZENA
      DEZ->(DBGOTOP())
      RNK->(DBGOTOP())
      DO WHILE !DEZ->(EOF())
         IF !RNK->(DBSEEK( STRZERO(DEZ->DEZ6,2) ))
            RNK->(DBGOTOP()) // POSICIONA NO INICIO DO ARQUIVO
            DO WHILE !EMPTY(RNK->DEZ6) // DESCE ATÉ ACHAR UM CAMPO EM BRANCO
               RNK->(DBSKIP())
            ENDDO

            RNK->DEZ6 := DEZ->DEZ6
            RNK->RPT6 := 1
         ELSE
            RNK->RPT6++
         ENDIF
         DEZ->(DBSKIP())
      ENDDO

      ? TIME()+" - FAZENDO O RANKING DAS MAIS SORTEADAS..."
      RNK->(ORDSETFOCUS("RPT6")) // POR ORDEM DE REPETIÇÃO DA DEZENA
      RNK->(DBGOTOP())
      nRANK := 1
      DO WHILE !RNK->(EOF())
         RNK->RNK6 := nRANK++
         RNK->(DBSKIP())
      ENDDO

      RNK->(DBCOMMIT())
      CLOSE ALL
      ?
      ? "INFORMAÇÕES COMPLETAS!"
      ? "PRESSIONE UMA TECLA P/ CONTINUAR"
      INKEY(0)
   ENDIF
ENDIF


*** PARTE DO PROGRAMA QUE SORTEIA OS NÚMEROS ***-------------------------

USE RANKING ALIAS RNK EXCLUSIVE NEW
SET INDEX TO RANKING

RNK->(ORDSETFOCUS("RPT1")) // POR REPETIÇÃO/OCORRENCIA
RNK->(DBGOTOP())

CLS
@ 00,00 SAY PADC("*** Ranking da MEGA SENA ***",80)
@ 01,00 SAY PADC("Sorteia no Ranking dos sorteios",80)

nAPOSTAS := nDE := nATE := nDEZENAS := 0
@ 03,10 SAY "QUANTAS APOSTAS?.............:" GET nAPOSTAS PICT "999"

* @ 04,10 SAY "CARTELA DE (6-10)............:" GET nDEZENAS RANGE 6,10 PICT "99"
@ 04,10 SAY "CARTELA DE 6 DEZENAS"; nDEZENAS := 6

@ 05,10 SAY "CLASSIFICAÇÃO ENTRE..........:" GET nDE  PICT "99"
@ 05,44 SAY "E" GET nATE PICT "99" VALID nATE > nDE
READ

@ 07,00 SAY "Números sorteados entre "+str(nDE,2)+" e "+STR(nATE,2)+" do Ranking:"
LL := 9
SETPOS(LL,00)
aCARTELA := {} // CONTROLAR NUMEROS DA CARTELA PARA NAO REPETIR
aJOGOS   := {}
aEMPATE  := {}

FOR X=1 TO nAPOSTAS

    FOR S=1 TO nDEZENAS
        // aCARTELA TERÁ <nDEZENAS> DEZENAS

        DO WHILE .T.
           RNK->(ORDSETFOCUS("RNK"+STR(S,1) ))
           RNK->(DBGOTOP())

           // SORTEIA ENTRE A CLASSIFICAÇÃO DO RANKING ESCOLHIDA
           nSORTE := HB_RANDOMINT(nDE, nATE )
           nSORTE := STRZERO(nSORTE,2)

           RNK->(DBSEEK(nSORTE)) // POSICIONA NA DEZENA DE NÚMERO <nSORTE> DO RANKING

           bDEZ := &( "{|| RNK->DEZ"+STR(S,1)+" }" ) // CODEBLOCK COM O NOME DO CAMPO
           nDEZ := EVAL( bDEZ ) // VALOR DO CAMPO

           // TESTA SE HÁ EMPATADOS NO RANKING
           bRPT := &( "{|| RNK->RPT"+STR(S,1)+" }" ) // CODEBLOCK COM O NOME DO CAMPO
           nRPT := EVAL( bRPT ) // VALOR QUE A DEZENA SE REPETIU P/ OCUPAR ESTE LUGAR NO RANKING

           RNK->(ORDSETFOCUS("RPT"+STR(S,1) ))
           RNK->(DBGOTOP())
           RNK->(DBSEEK( STRZERO(nRPT,2) )) // POSICIONA NA 1ª DEZENA QUE SE REPETIU IGUAL A DEZENA SORTEADA DO RANKING

           RNK->(DBSKIP())

           IF EVAL(bRPT) = nRPT // HÁ EMPATADOS?

              DO WHILE EVAL(bRPT) = nRPT // FAÇA ENQUANTO MESMA REPETIÇÃO DA DEZENA NO RANKING
                 aADD(aEMPATE, EVAL(bDEZ) )
                 RNK->(DBSKIP())
              ENDDO

              nEMPATES := LEN(aEMPATE)
              IF nEMPATES > 0 // HÁ EMPATES NO RANKING
                 nSORTE := HB_RANDOMINT(1, nEMPATES )
                 nDEZ   := aEMPATE[nSORTE] // SORTEIA UM ENTRE OS EMPATADOS DO RANKING
              ENDIF

              aEMPATE := {} // ZERA MATRIZ DE EMPATES
           ENDIF

           IF aSCAN(aCARTELA, nDEZ) > 0
              // JÁ SORTEIOU ESTA DEZENA NESTA CARTELA
              LOOP // VOLTA
           ENDIF
           aADD(aCARTELA, nDEZ)
           EXIT
        ENDDO
    NEXT

    aSORT(aCARTELA) // COLOCA MATRIZ DAS 6 DEZENAS EM ORDEM CRESCENTE
                    // FACILITA IDENTIFICAÇÃO E ANULAÇÃO DE CARTELAS IGUAIS

    *** MOSTRA DEZENAS SORTEADAS NA TELA
    FOR T=1 TO nDEZENAS
        @ LL,COL()+2 SAY aCARTELA[T]
    NEXT

    SETPOS(++LL,0)

    *** TESTA SE NÃO HÁ CARTELAS IGUAIS
    IF aSCAN(aJOGOS, aCARTELA) > 0 // SE JÁ TEM aCARTELA EM aJOGOS
       LOOP // SE JÁ TEM, VOLTA E REPETE SORTEIO DA CARTELA
    ENDIF

    aADD(aJOGOS, aCARTELA) // ACRESCENTA aCARTELA EM aJOGOS
    aCARTELA := {}         // NOVA CARTELA ZERADA
NEXT
INKEY(0)

AnexoTamanho
sena.zip4.84 KB

Enviando emails pelo xHarbour

Projeto Harbour

 Harbour Project

Estava faltando descomplicar...


 

Para enviar emails pelo xHarbour é melhor utilizar a função SendMail que estamos anexando a esta matéria no rodapé para download.

Veja sua sintaxe:

FUNCTION HB_SendMail( cServer, nPort, cFrom, aTo, aCC, aBCC, cBody, cSubject, aFiles, cUser, cPass, cPopServer, nPriority, lRead, lTrace, lPopAuth, lnoauth, nTimeOut)
/*
cServer    -> Obrigatório. IP ou domínio do servidor de emails
nPort      -> Opcional. Porta usada pelo servidor de emails

cFrom      -> Obrigatório. Email do remetente
aTo        -> Obrigatório. String ou array de endereços de email para serem enviados
aCC        -> Opcional. String ou array de endereços de email para CC (Carbon Copy)
aBCC       -> Opcional. String ou array de endereços de email para BCC (Blind Carbon Copy)
cBody      -> Opcional. A mensagem do corpo do email como texto ou arquivo HTML

cSubject   -> Opcional. Assunto do email

aFiles     -> Opcional. Array de arquivos para serem enviados como anexo
cUser      -> Obrigatório. Nome de usuário do servidor POP3
cPass      -> Obrigatório. Senha do cUser
cPopServer -> Obrigatório. Nome ou endereço do servidor de emails POP3 [sic][Usa-se o SMTP para enviar email]
nPriority  -> Opcional. Prioridade do Email: 1=Alta, 3=Normal (Padrão), 5=Baixa
lRead      -> Opcional. Se for .T., uma requisição de confirmação será solicitada. Por padrão é .F.
lTrace     -> Opcional. Se for .T., um arquivo de log é criado (sendmail<nNr>.log). O padrão é .F.
lnoauth    -> Opcional. Desativa método de autenticação
nTimeOut   -> Opcional. Número de milisegundos para esperar. O padrão é 20000 (20s).
*/

 

Veja dois exemplos de minha autoria para enviar emails pelo xHarbour com o SendMail:

 

IF (ALERT("ENVIA ARQUIVOS POR EMAIL AGORA?", {"Sim", "Não"})) = 1
   @ 24,00 SAY PADC("Preparando email... AGUARDE!",80) COLOR "W+/BG"

   // ARQUIVOS A SEREM ENVIADOS
   aFILES := {cPASTA+cARQLC, cPASTA+cARQLI, cPASTA+cARQCON}

   // COMPACTA ARQUIVOS
   fZIP := cPASTA+"Portal.zip"
   IF FILE(fZIP)
      RUN ("DEL "+fZIP) // APAGA ZIP ANTERIOR
   ENDIF
   HB_ZIPFILE(fZIP, aFILES) // COMPACTA OS 3 ARQUIVOS EM PORTAL.ZIP

   // preparing data for eMail
   cSubject  := "Aqui vai o assunto do seu email"
   cFrom     := "email@remetente.com.br"    // email do remetente
   cMAILUSER := "usuariodoemail"            // login de acesso do seu email
   cPASSWORD := "senhadoemail"              // sua senha de email
   cSMTP     := "smtp.seudominio.com.br"    // seu domínio do email
   cTo       := "email@destinatario.com.br" // email do destinatário
   cCC       := cFrom                       // manda cópia carbono pra você mesmo ter certeza que deu certo
   aAttach   := {fZIP}                      // sempre array


   cBody := "Prezados,"+HB_OsNewLine()+HB_OsNewLine()+;
            HB_OemToAnsi("Estamos encaminhando as informações da STU-MAC/CBTU para o Portal da Transparência referente ao período de ";

            +DTOC(dINIPROC)+" a "+DTOC(dFIMPROC)+".")+HB_OsNewLine()+;
            "Atenciosamente,"+HB_OsNewLine()+HB_OsNewLine()+;
            "Fulano de Tal"+HB_OsNewLine()+;
            "Cargo/empresa"+HB_OsNewLine()+;
            "Fone: (99) 9999-9999"

   nEMAILSIZE := HB_FSIZE(fZIP) / 1024
   @ 24,00 SAY PADC("Enviando arquivo Portal.zip por email... ("+ALLTRIM(STR(nEMAILSIZE))+"Kb) AGUARDE!",80) COLOR "W+/BG"

   IF HB_SENDMAIL(cSMTP,, cFROM, cTO, cCC,, cBODY, cSUBJECT, aAttach, cMAILUSER, cPASSWORD, cSMTP, 1, .T., .T.)
      ALERT("ARQUIVOS ENVIADOS COM ÊXITO.")
   ELSE
      ALERT("Falha ao enviar o email.")
   ENDIF
ENDIF
 

Enviar emails pelo sistema pode ser útil quando você tem que mandar um email para vários destinatários, ninguém pode conhecer o email do outro (para evitar conluios) e você precisa do comprovante de envio (prova de pesquisa de mercado). Assim, não adianta mandar via BCC, pois não vai ter comprovante.

Veja outro exemplo de minha autoria para resolver esse problema:

 

#INCLUDE "COMMON.CH"
FUNCTION ORCAMENTO()
PRIVATE LL, nMAXPROW
SAVE SCREEN TO cTEL
nSIGN := 0

ABREDBF("GRUPOS", "GRP")
ABREDBF("SUBGRUPO", "SGR")
ABREDBF("USUARIOS", "US")
ABREDBF("UNIDADE", "UG")
ABREDBF("CADASTRO", "CRC")
ABREDBF("ESPECIAL", "ESP")
ABREDBF("PROCESSO", "PRO")

US->(ORDSETFOCUS("CODIGO"))
US->(DBSEEK(xOPERADOR))

cEMAIL := LOWER(US->EMAIL)
cTELEFONE := TRANSFORM(US->TELEFONE, "@R (99) 9999-9999")

@ 01,00 SAY PADC("SOLICITAÇÃO DE ORÇAMENTO POR EMAIL",80) COLOR "N/W+*"

nGRP := nESP := 0
DO WHILE .T.
   SETCOLOR("W+/W,W/N")
   @ 02,00 CLEA TO 22,79
   WIN(02,00,05,79, "ESPECIALIDADE DAS EMPRESAS CADASTRADAS")
   * ESPECIALIDADE
   @ 03,02 SAY "Grupo........:" GET nGRP PICT "99" VALID { |oGET| VALGRP(oGET, .T.) }
   @ 04,02 SAY "Especialidade:" GET nESP PICT "99" VALID { |oGET| VALSUB2(oGET, .T.) }

   @ 24,00 SAY PADC( ALLTRIM(GRP->NOME)+" | "+ALLTRIM(SGR->NOMESGRP)+".", 80) COLOR "W+/BG"

   @ 22,00 SAY PADC(PRO->OBJETO, 80) COLOR "W/BG"
   @ 06,00 CLEA TO 22,79
   @ 24,00 SAY PADC("Preparando email... AGUARDE!",80) COLOR "W+/BG"

   WIN(06,00,21,79, "DADOS DO EMAIL")
   @ 22,00 SAY PADC( ALLTRIM(LEFT(PRO->OBJETO,80)), 80) COLOR "W/B"
 

   // preparing data for eMail
   cSubject := "CONTRATAÇÃO DE: "+SPACE(60)
   cFrom := cEMAIL
   cMAILUSER := SUBSTR(cEMAIL, 1, (AT("@", cEMAIL))-1 )
   cPASSWORD := SPACE(15)
   cSMTP := "smtp.cbtu.gov.br"
   cFILE := "C:\"+SPACE(97)

   @ 07,02 SAY "Email remetente.:" GET cFROM MESSAGE "Informe o email do remetente desta mensagem eletrônica."
   @ 08,02 SAY "Usuário do email:" GET cMAILUSER MESSAGE "Informe nome do usuário deste email."
   READ MSG AT 24,00,79 MSG COLOR "W+/BG"

   cPASSWORD := GetSecret( cPASSWORD, 09, 02, .T., "Senha do email..:")
   cPASSWORD := ALLTRIM(cPASSWORD)

   @ 10,02 SAY "Assunto:" GET cSUBJECT MESSAGE "Informe o objeto da cotação." PICT "@S60"
   @ 11,02 SAY "Arquivo:" GET cFILE MESSAGE "Informe o caminho do arquivo (path) a anexar. Se vários, compate-os." PICT "@S60"
   READ MSG AT 24,00,79 MSG COLOR "W+/BG"
   IF LASTKEY()=27
      RETURN
   ENDIF

   cFROM := ALLTRIM(LOWER(cFROM))
   cFILE := ALLTRIM(cFILE)
   aFILES := {}
   IF FILE(cFILE)
      IF RIGHT(cFILE,3) # "ZIP"
         nZIP := ALERT("COMPACTA ARQUIVO PARA EMAIL?", {"Sim", "Não"})
         IF nZIP = 1
            cFILEZIP := SUBSTR(cFILE, 1, LEN(cFILE)-3)
            cFILEZIP += "ZIP"
            HB_ZIPFILE(cFILEZIP, cFILE)
            cFILE := cFILEZIP
         ENDIF
      ENDIF
      aADD(aFILES, cFILE)
      nEMAILSIZE := HB_FSIZE(cFILE) / 1024
   ELSE
      nEMAILSIZE := 1 // 1KB
   ENDIF

   cBody := "Prezados,"+HB_OsNewLine()+HB_OsNewLine()+;
            "Estamos solicitando cotação do objeto epigrafado no assunto deste email cujas especificações constam no anexo."+HB_OsNewLine()+;
            "O recurso orçamentário está previsto no Plano Interno _______ e Natureza de Despesa ________."+HB_OsNewLine()+;
            "Abra o anexo deste email para verificar se sua empresa trabalha com o objeto que possa atender as nossas necessidades."+HB_OsNewLine()+;
            "Todos os custos devem estar incluídos na proposta (Frete, diferença de ICMS etc.)"+HB_OsNewLine()+;
            "A Administração contratará com a proposta mais vantajosa, o critério é 'menor preço'."+HB_OsNewLine()+;
            "A Nota de Empenho do recurso orçamentário é sua garantia de pagamento!"+HB_OsNewLine()+;
            "Gentileza confirmar o recebimento deste email e manifestar interesse em participar."+HB_OsNewLine()+;
            "Atenciosamente,"+HB_OsNewLine()+HB_OsNewLine()+;
            ALLTRIM(US->NOME)+HB_OsNewLine()+;
            ALLTRIM(US->CARGO)+"/"+ALLTRIM(US->LOTACAO)+"/STU-MAC/CBTU"+HB_OsNewLine()+;
            cTELEFONE

   @ 12,02 SAY "Corpo do email"
   @ 24,00 SAY PADC( "Alt+W = Termina edição com mudanças. Esc = Termina sem mudanças.", 80) COLOR "W+/BG"
   SETCOLOR("W/N")
   cBODY := MEMOEDIT(cBODY, 13,02,20,78)

   ALERT("Emails serão enviados a todas as empresas cadastradas no Grupo "+;
         STRZERO(nGRP,2)+" e Especialidade "+STRZERO(nESP,2)+".")

   nCONF := ALERT("CONFIRMA O ENVIO DESTE EMAIL?", {"Sim", "Não"})
   aTO := {}
   IF nCONF = 1 // CONFIRMA
      cCC := cFrom
      aFALHA := {}

      * FILTRA DADOS = APENAS POSICAO DESTA LICITACAO
      cRANDOM := ALLTRIM(STR(RAN(9999)))
      fINDEX := xTEMP+"TEMP" + cRANDOM
      SELECT ESP
      INDEX ON CNPJ TAG TEMP TO (fINDEX) ;
            FOR ESP->GRUPO=nGRP .AND. ESP->SUBGRUPO=nESP ;
            ADDITIVE TEMPORARY
      ESP->(DBGOTOP())
      DO WHILE !ESP->(EOF())
         CRC->(DBSEEK(ESP->CNPJ))
         IF EMPTY(CRC->EMAIL1)
            aADD(aFALHA, TRANSFORM(ESP->CNPJ, "@R 99.999.999/9999-99")+" não tem email cadastrado.")
            ESP->(DBSKIP())
            LOOP
         ENDIF

         aTO := {}
         aADD(aTO, LOWER(ALLTRIM(CRC->EMAIL1)) )
         IF !EMPTY(CRC->EMAIL2)
            aADD(aTO, LOWER(ALLTRIM(CRC->EMAIL2)) )
         ENDIF

         @ 24,00 SAY PADC("Enviando email ("+ALLTRIM(STR(nEMAILSIZE))+"Kb) para "+ALLTRIM(CRC->RAZAO)+". AGUARDE!", 80) COLOR "W+/BG"

         cEMPRESA := TRANSFORM(ESP->CNPJ, "@R 99.999.999/9999-99")+" "+;
                     ALLTRIM(CRC->RAZAO)+HB_OsNewLine()+;
                     IIF(!EMPTY(CRC->CONTATO), "Att.: "+ALLTRIM(CRC->CONTATO), "")+;
                     ALLTRIM(CRC->CELULAR)+" "+ALLTRIM(CRC->TELEFONE)+" "+ALLTRIM(CRC->FAX)+HB_OsNewLine()+HB_OsNewLine()

         cBODY2 := HB_OemToAnsi(cEMPRESA+cBODY)
         cSUBJECT2 := HB_OemToAnsi(cSUBJECT)

         IF !HB_SENDMAIL(cSMTP,, cFROM, aTO, cCC,, cBODY2, cSUBJECT2, aFILES,;
            cFROM, cPASSWORD, cSMTP, 1, .T., .T.)
            // cMAILUSER, cPASSWORD, cSMTP, 1, .T., .T.)
            aADD(aFALHA, "Email para "+TRANSFORM(ESP->CNPJ, "@R 99.999.999/9999-99")+" "+ALLTRIM(CRC->RAZAO)+" falhou.")
         ENDIF

         ESP->(DBSKIP())
         RELEASE aTO
      ENDDO

      IF EMPTY(aFALHA)
         MSGBOX("TODOS OS EMAILS FORAM ENVIADOS COM SUCESSO.","SUCESSO!","W+/G","G*/W")
      ELSE
         // GERA ARQUIVO DE LOG
         cARQUIVO := xPATH+"ORCAMENT.LOG"
         @ 24,00 SAY PADC("Preparando arquivo "+cARQUIVO+" com erros encontrados... AGUARDE!",80) COLOR "W+/BG"

         // GRAVA ARQUIVO DE LOG C/ VICIOS DO ARQUIVO
         IF FILE(cARQUIVO)
            RUN ("DEL "+cARQUIVO)
         ENDIF
         nHANDLE := FCREATE(cARQUIVO)
         FWRITE(nHANDLE, HB_OemToAnsi("SOLICITAÇÃO DE ORÇAMENTO"+HB_OsNewLine()))
         FWRITE(nHANDLE, HB_OemToAnsi("FALHA NO ENVIO DE EMAIL P/ AS SEGUINTES EMPRESAS:"+HB_OsNewLine()+HB_OsNewLine()))
         FOR X=1 TO LEN(aFALHA)
             FWRITE(nHANDLE, HB_OemToAnsi(aFALHA[X]+HB_OsNewLine()))
         NEXT
         FCLOSE(nHANDLE)
         @ 24,00 SAY SPACE(80) COLOR "W+/BG"

         // EXIBE O RELATÓRIO DE ERROS NA TELA
         WIN(06,00,21,79, "FALHAS NO ENVIO DE EMAIL")
         cRLT := MEMOREAD(cARQUIVO)
         @ 24,00 SAY "TECLE [ESC] P/ SAIR" COLOR "W+/BG"
         MEMOEDIT(cRLT,07,01,20,78)
         RELEASE cRLT, cARQUIVO
      ENDIF
   ENDIF
   SETCOLOR("W+/W")
   @ 06,00 CLEAR TO 22,79
ENDDO
RESTORE SCREEN FROM cTEL
RETURN

AnexoTamanho
SENDMAIL.zip6.5 KB