Página 2 de 2

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 02 Nov 2012 22:45
por Claudio Soto
Hola Pablo César.
Para este ejemplo como no se carga ninguna imagen la función Pintando(cTela,cTexto) es mas sencilla:

Código: Selecionar todos

Function Pintando(cTela,cTexto)
Local Width := BT_ClientAreaWidth (cTela)
Local Height := BT_ClientAreaHeight (cTela)
Local hDC, BTstruct

hDC = BT_CreateDC (cTela, BT_HDC_INVALIDCLIENTAREA, @BTstruct)

   BT_DrawGradientFillVertical (hDC, 0, 0, Width, Height, BLUE, BLACK)

   nTypeText  := BT_TEXT_TRANSPARENT + BT_TEXT_BOLD + BT_TEXT_ITALIC + BT_TEXT_UNDERLINE
   nAlingText := BT_TEXT_CENTER + BT_TEXT_BASELINE
   BT_DrawText (hDC, 40, 224, cTexto, "Verdana", 24 , YELLOW, BLACK, nTypeText, nAlingText)

BT_DeleteDC (BTstruct)
Return Nil
Además eliminar del código:

Código: Selecionar todos

linea 010:	Private hBitmap := 0
linea 011:	Private Alpha   := 150
linea 012:	Private Flag_AlphaBlend_Effect := .T.
y la función Na_Saida() porque no son necesarios en este caso.

Código: Selecionar todos

linea 109:	Function Na_Saida()
linea 110:	BT_BitmapRelease (hBitmap)
linea 111:	Return Nil
Un abrazo,
Claudio.

PD: en el DEFINE WINDOW queda mas general como:

Código: Selecionar todos

ON PAINT Pintando(ThisWindow.Name, "Programa de Instalação");

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 03 Nov 2012 00:56
por cjp
Caro Pablo,

Testei tua última função, como vc postou e também com as correções feitas pelo Claudio, mas acho que está faltando algo nela, pois dá uma série de erros, nas seguintes linhas (nas linhas marcadas com asterístico):

Código: Selecionar todos

Function Pintando(cTela,cTexto)
*Local Width := BT_ClientAreaWidth (cTela)
*Local Height := BT_ClientAreaHeight (cTela)
Local hDC, BTstruct

*hDC = BT_CreateDC (cTela, BT_HDC_INVALIDCLIENTAREA, @BTstruct)

* BT_DrawGradientFillVertical (hDC, 0, 0, Width, Height, BLUE, BLACK)

 nTypeText := BT_TEXT_TRANSPARENT + BT_TEXT_BOLD + BT_TEXT_ITALIC + BT_TEXT_UNDERLINE
 nAlingText := BT_TEXT_CENTER + BT_TEXT_BASELINE
* BT_DrawText (hDC, 40, 224, cTexto, "Verdana", 24 , YELLOW, BLACK, nTypeText, nAlingText)

*BT_DeleteDC (BTstruct)
Return Nil
Creio que esteja faltando algum include.

Quanto à função HB_eol(), não sei se é algum problema no meu computador, mas a tua função também não compilou. Veja o que dá:

Imagem

Eu a estou usando de forma semelhante à tua, assim:

Código: Selecionar todos

	        cMessage = Hb_Eol()+"**************** Video Screen Dump ****************" + Hb_Eol() 
            cMessage += Replicate( '-', nCols +3 ) + Hb_Eol()
            nCellSize := len( Savescreen( 0, 0, 0, 0 ) )
            nRange := ( nCols + 1 ) * nCellSize
            For nCount := 1 To nRows + 1
                cOutString := ''
                cSubString := Substr( cScreen, nStart, nRange )
                For nForLoop := 1 To nRange step nCellSize
                    cOutString += Substr( cSubString, nForLoop, 1 )
                Next
		        cMessage += "|" + cOutString + "|" + Hb_Eol()
                nStart += nRange
            Next
            cMessage += Replicate( '-', nCols +3 ) + Hb_Eol()
Não entendi o que vc falou sobre REQUEST HB_GT_WIN_DEFAULT. Não sei o que é esse Request e acho que não o estou usando.

Não consegui compilar o teu exemplo neste ponto, pois está dando erro nesta linha:

Código: Selecionar todos

Local hProc := HB_OpenProcess( cRun , @hIn, @hOut, @hOut )
Quanto à função ver_senha, sim, era isso que eu queria.

Todos os teus conselhos são muitíssimos bem-vindos, meu caro.

Quanto às variáveis, sei que o modo correto é como vc falou, mas, neste caso, como se trata de um programa muito simples e de rápida execução, acho que não terei problema de memória, certo?

Quanto à identação, eu sempre faço com identação. Só neste caso é que eu colei neste prg o que já tinha do programa velho (modo console) e ainda não tinha corrigido a identação, mas vc tem toda razão que, sem dúvida, sem identação o programa fica ininteligível.

A label_2 na função inst2() está mesmo errada. Eu a havia colocado num dos vários testes que fiz e esqueci de tirar. Perdão.

Quanto às funções rodadas com run ou !, este é o principal problema para o qual preciso da tua ajuda, porque são eles que estão gerando a tela preta. Primeiro, rodo o programa netsh firewall do windows. Não sei se existe algum comando ou função equivalente no Harbour, ou se existe outra forma de chamar a netsh.

As demais são as seguintes:

Código: Selecionar todos

!set allusersprofile=
!set appdata=
!set commonprogramfiles=
!set homepath=
!set number_of_processors=
!set os2libpath=
!set processor_architecture=
!set processor_identifier=
!set processor_level=
!set processor_revision=
!set programfiles=
!set userprofile=
!set userdomain=

*:: Cria o arquivo de script
*::=============================
!echo open ftp.inaciocarvalho.com.br    > instala.ftp
!echo user promotor mppr95  >> instala.ftp
!echo binary           >> instala.ftp
!echo prompt           >> instala.ftp
!echo cd www.inaciocarvalho.com.br/instala       >> instala.ftp
!echo lcd .      >> instala.ftp
!echo get TAREFAS.EXE           >> instala.ftp
!echo get AGTEL.DBF             >> instala.ftp
!echo get ARQBX.DBF             >> instala.ftp
!echo get ARQUIVO.DBF           >> instala.ftp
!echo get BASE.DBF              >> instala.ftp
!echo get BIBLIA.DBF            >> instala.ftp
!echo get buttonx.exe           >> instala.ftp
!echo get CONSTEX.DBF           >> instala.ftp
!echo get CONSTEX.DBT           >> instala.ftp
!echo get CONSULTA.DBF          >> instala.ftp
!echo get envia.bat             >> instala.ftp
!echo get ERRO.DBF              >> instala.ftp
!echo get lista.bat             >> instala.ftp
!echo get pega.bat              >> instala.ftp
!echo get LISTA.DBF             >> instala.ftp
!echo get LISTREC.DBF           >> instala.ftp
!echo get rar.exe               >> instala.ftp
!echo get recebe.bat            >> instala.ftp
!echo get RECEBID.DBF           >> instala.ftp
!echo get tar-comp.bat          >> instala.ftp
!echo get TARVELHO.EXE          >> instala.ftp
!echo get usuario.dbf           >> instala.ftp
!echo get criadesk.exe          >> instala.ftp
!echo get manderr.exe           >> instala.ftp
!echo get Minimize.exe          >> instala.ftp
!echo get WAPI.EXE              >> instala.ftp
!echo get WAPI.LIB              >> instala.ftp
!echo get FERIADO.DBF           >> instala.ftp
!echo get tar2p.exe             >> instala.ftp
*!echo get tar2p.bat             >> instala.ftp
!echo get tar2p.rar             >> instala.ftp
!echo get smtpsend.exe          >> instala.ftp
!echo get icone.vbs             >> instala.ftp
!echo bye                       >> instala.ftp



*:: Executa o script no FTP
*::=============================
!set l1=--------------------
!set l2=********************

!echo %l2%%l2%%l2%%l2%>> instala.log
!echo.|date           >> instala.log
!echo.|time           >> instala.log
!echo %l1%%l1%%l1%%l1%>> instala.log
*!ftp -s:instala.ftp -n >> instala.log
!echo %l1%%l1%%l1%%l1%>> instala.log
!echo.                >> instala.log
!echo.                >> instala.log
Aqui eu crio e executo o arquivo instala.ftp, que vai baixar arquivos do programa do ftp. Deve haver outra forma melhor para fazer isso. Vc citou a hb_memowrit(). Fiz alguns testes com ela e vi que realmente dá pra fazer assim. Mas restará ainda um problema: na hora de executar o .bat (ou, no meu caso, o ftp), ele também vai abrir uma tela preta à parte.

Reitero meus agradecimentos pelas tuas valiosas lições!!!

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 03 Nov 2012 01:34
por Pablo César
Claudio Soto escreveu:Para este ejemplo como no se carga ninguna imagen la función Pintando(cTela,cTexto) es mas sencilla
...//...
PD: en el DEFINE WINDOW queda mas general como: ON PAINT Pintando(ThisWindow.Name...
Muchisimas gracias Dr. Soto, realmente mucho mejor ahora, eres un genio !

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 03 Nov 2012 04:22
por Pablo César
cjp escreveu:acho que está faltando algo nela, pois dá uma série de erros, nas seguintes linhas (nas linhas marcadas com asterístico)
...//...
Quanto à função HB_eol()... // ... mas a tua função também não compilou
Já sei o que pode estar acontecendo. Qual é a versão do seu HMG ? Acredito que você está usando a 3.0.35, não é ? Esta versão apenas indico só para migração, mas a versão mais atual vem com mais recursos do HMG e melhorias no de versão do Harbour mais recente.
Não entendi o que vc falou sobre REQUEST HB_GT_WIN_DEFAULT.
Normalmente é colocado no inicio do programa principal e serve para que possa exibir em modo console. Isto eu tenho explicado no tópico Compilar através da IDE da HMG versão 3.0.35, você não deve ter lido. Muito importante seguir as instruções.
Não consegui compilar o teu exemplo neste ponto...: HB_OpenProcess( cRun , @hIn, @hOut, @hOut )
Baixe a nova versão, instale-a e abra de novo o projeto e recompile os fontes pela IDE. Aqui neste tópico https://pctoledo.org/forum/viewto ... 438#p79017 mostra onde baixar a ultima versão (atualmente está em hmg 3.0.45).
Quanto à função ver_senha, sim, era isso que eu queria.
Ótimo !
Todos os teus conselhos são muitíssimos bem-vindos, meu caro.
Quê bom que está sendo útil pra você e espero que sirva para outros no futuro. Mas gostaria de pedir-lhe um favor em troca. Se você pudesse suprimir (tanto para minha pessoa como para os outros) esse seu tratamento de "meu caro", eu agradecerei muito. Sei que você não o faz com o intuito de menosprezar alguém, mas é que soa meio estranho (pelo menos para mim, desculpe eu ser chato).
Quanto às variáveis, sei que o modo correto é como vc falou, mas, neste caso, como se trata de um programa muito simples e de rápida execução, acho que não terei problema de memória, certo?
Não creio, mas considerando que você terá um alto consumo de requisições pelos "RUNs" que você está utilizando, acho melhor economizar, outra também porque é para você ir se acostumando. É uma boa prática.
Quanto à identação, eu sempre faço com identação...//... sem dúvida, sem identação o programa fica ininteligível.
Quê bom que você entende.
A label_2 na função inst2() está mesmo errada. Eu a havia colocado num dos vários testes que fiz e esqueci de tirar. Perdão.
Quê isso ! Não precisa pedir desculpas, apenas mencionei só para você saber.
Quanto às funções rodadas com run ou !
Você quer dizer comandos, não funções.
este é o principal problema...//... para o qual preciso da tua ajuda, porque são eles que estão gerando a tela preta
Bom quanto isso, já dei a solução com a função MyRun.
Primeiro, rodo o programa netsh firewall do windows. Não sei se existe algum comando ou função equivalente no Harbour, ou se existe outra forma de chamar a netsh.
Acho que você não entendeu quando eu aconselhei para usar um arquivo BAT. Denbtro desta aplicação você vai gerar o arquivo BAT contendo o comando como você o faria na linha de comando. Você entende essa situação ? Eu vou procurar no seu primeiro fonte a forma que você colocar o netsh e vou incluí-lo na geração do BAT.

Só preciso esclarecer alguns detalhes:

1. Antes da instalação você precisa baixar o arquivo Usuario.dbf do site ftp.inaciocarvalho.com.br/instala ?
2. Faltou a função PegaFTP. Você poderia postá-la ?
3. Para quê serve a função verarqv ? Você poderia postá-la ?
4. Presumo que terão que baixar os arquivos: tar2p.exe e tar2p.bat, estou certo ? Se sim, estranho por terem o mesmo nome. É assim mesmo ?
5. Você parece utilizar o Pega.bat para ser executado. Você poderia postar o conteúdo desse arquivo ?
6. Parece que precisa baixar dois arquivos com o mesmo nome, porém um é composto pelo nome tudo em maiúsculas. Sendo composto desta forma: ativ+".dbf" e upper(ativ)+".dbf", você confirma ? Por quê disso ? O get do ftp faz download de qualquer forma ou estou errado ?
7. Sei que a variável us provém do campo usuario. Poderia me dizer qual é o tamanho e o tipo do campo ?

Nossa tive que copiar linha a linha (uma 140 linhas) porque o sistema aqui do fórum deixou incompleto no botão "Ver codigo". Isso já foi reportado ao Sr. Toledo, mas parece que ainda não foi resolvido. E tenho várias dúvidas quanto o final da sua função deste seu código: https://pctoledo.org/forum/viewto ... 547#p78650 (linha de 253 a 392). No entanto, deixaremos para semana que vem isso.
Aqui eu crio e executo o arquivo instala.ftp...//...Fiz alguns testes com ela e vi que realmente dá pra fazer assim. Mas restará ainda um problema: na hora de executar o .bat (ou, no meu caso, o ftp), ele também vai abrir uma tela preta à parte.
Sim vamos criar o arquivo BAT e testar pra ver se ele irá apresentar a tela preta. Senão iremos por outro caminho. Mas primeiro temos que acertar toda essa rotina de usuário e esse replace em dbf. Tem muita coisa que pode ser otimizada.

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 03 Nov 2012 18:51
por cjp
Já sei o que pode estar acontecendo. Qual é a versão do seu HMG ? Acredito que você está usando a 3.0.35, não é ? Esta versão apenas indico só para migração, mas a versão mais atual vem com mais recursos do HMG e melhorias no de versão do Harbour mais recente.
Realmente era a 3.0.35. Baixei a 3.0.45 e a hb_eol() realmente funcionou. Mas a função que vc havia postado por último não. Estranhamente, ela não dá nenhum erro, mas também não executa. Só faz um som de alerta, semelhante ao de erro, mas não dá nada.


Quê bom que está sendo útil pra você e espero que sirva para outros no futuro. Mas gostaria de pedir-lhe um favor em troca. Se você pudesse suprimir (tanto para minha pessoa como para os outros) esse seu tratamento de "meu caro", eu agradecerei muito. Sei que você não o faz com o intuito de menosprezar alguém, mas é que soa meio estranho (pelo menos para mim, desculpe eu ser chato).
Desculpe, cara. "Meu caro" é uma expressão muito comum na minha profissão (Direito), sempre com conotação muito respeitosa, nunca com o intuito de menosprezar. De toda forma, desculpe, não a usarei mais.
Não creio, mas considerando que você terá um alto consumo de requisições pelos "RUNs" que você está utilizando, acho melhor economizar, outra também porque é para você ir se acostumando. É uma boa prática.
Com certeza. Farei isto.
Você quer dizer comandos, não funções.
Realmente, comandos. Fiz confusão.



Bom quanto isso, já dei a solução com a função MyRun.
Não sei porque, mas esta função ainda não está funcionando. Ainda está abrindo a tela preta.


1. Antes da instalação você precisa baixar o arquivo Usuario.dbf do site ftp.inaciocarvalho.com.br/instala ?
Sim, o arquivo usuario.dbf é a base de todo o resto da instalação, inclusive para conferir a senha digitada.


2. Faltou a função PegaFTP. Você poderia postá-la ?
Esta é uma função que fiz com base na ajuda de alguém do grupo. Aí vai ela:

Código: Selecionar todos

Function pegaftp(arqvpeg,pasta)
	ftpproto ="ftp://" //posthilit">ftp://"
	ftpserver = "ftp.inaciocarvalho.com.br" //posthilit">ftp.servidor.com.br"  endereço de ="posthilit">FTP</span> do site
	ftpuser = "promotor"   //Usuário da conta ="posthilit">FTP</span>
	ftppass = snhftp    //Senha da conta ="posthilit">FTP</span>
	curl:=ftpproto+ftpuser+":"+ftppass+"@"+ftpserver
	oCred:= tIPCredentials()
	oUrl:= turl():new(curl)
	oFtp:= tipclientftp():NEW(oUrl,.F.)
	oFTP:nConnTimeout := 20000
	oFTP:bUsePasv     := .T.
	IF oFTP:Open()
	   oFTP:Cwd(pasta)     // informe o diretorio (="posthilit">no</span> site) onde está o arquivo EXE que voce vai copiar
	   IF !empty(clista:=oFTP:List())
	      oFtp:DownLoadFile(arqvpeg)  //informe o nome do arquivo que você quer baixar
	   else
          return .f.	   
	   ENDIF
	   oFTP:Close()
	else
       return .f.	
    ENDIF
Return .t.
3. Para quê serve a função verarqv ? Você poderia postá-la ?
É uma função para verificar a integridade do arquivo baixado. Aí vai ela:

Código: Selecionar todos

function verarqv(arqv)
         if !file(arqv) .or. filesize(arqv)=0 .or. ("DBF"$upper(arqv) .and. usebase(arqv)=.f.)
		    @ maxrow(),1 say "Conferindo arquivo "+alltrim(arqv)+"; aguarde"
		    pegaftp(arqv,"www.inaciocarvalho.com.br/instala")
			pegaftp(upper(arqv),"www.inaciocarvalho.com.br/instala")
			pegaftp(substr(upper(arqv),1,1)+substr(arqv,2),"www.inaciocarvalho.com.br/instala")
            if !file(arqv) .or. filesize(arqv)=0 .or. ("DBF"$upper(arqv) .and. usebase(arqv)=.f.)
               __run("pega ftp.inaciocarvalho.com.br promotor " + snhftp + " www.inaciocarvalho.com.br/instala . "+arqv)
               __run("pega ftp.inaciocarvalho.com.br promotor " + snhftp + " www.inaciocarvalho.com.br/instala . "+upper(arqv))
               __run("pega ftp.inaciocarvalho.com.br promotor " + snhftp + " www.inaciocarvalho.com.br/instala . "+substr(upper(arqv),1,1)+substr(arqv,2))
               if !file(arqv) .or. filesize(arqv)=0 .or. ("DBF"$upper(arqv) .and. usebase(arqv)=.f.)
			      mandmail2("pega.log","Não tem o arquivo "+arqv+" ou arquivo com tamanho 0","")
			   endif
			endif
			@ maxrow(),1 clear to maxrow(),maxcol()
	     endif
return
4. Presumo que terão que baixar os arquivos: tar2p.exe e tar2p.bat, estou certo ? Se sim, estranho por terem o mesmo nome. É assim mesmo ?
Na verdade o tar2p.bat não é mais necessário, esqueci de tirar.

5. Você parece utilizar o Pega.bat para ser executado. Você poderia postar o conteúdo desse arquivo ?
Aí vai:

Código: Selecionar todos

@echo off
if [%1] == [] goto fim

:: Parametros
::=============================
:: 1 - host ftp
:: 2 - usuario
:: 3 - senha
:: 4 - pasta remota
:: 5 - pasta local
:: 6 - arquivo a ser baixado

set allusersprofile=
set appdata=
set commonprogramfiles=
set homepath=
set number_of_processors=
set os2libpath=
set processor_architecture=
set processor_identifier=
set processor_level=
set processor_revision=
set programfiles=
set userprofile=
set userdomain=

:: Cria o arquivo de script
::=============================
echo open %1           > pega.ftp
echo user %2 %3       >> pega.ftp
echo binary           >> pega.ftp
echo prompt           >> pega.ftp
echo cd %4            >> pega.ftp
echo lcd %5           >> pega.ftp
echo get %6           >> pega.ftp
echo bye              >> pega.ftp


:: Executa o script no FTP
::=============================
set l1=--------------------
set l2=********************

echo %l2%%l2%%l2%%l2%>> pega.log
echo.|date           >> pega.log
echo.|time           >> pega.log
echo %l1%%l1%%l1%%l1%>> pega.log
ftp -s:pega.ftp -n   >> pega.log
echo %l1%%l1%%l1%%l1%>> pega.log
echo.                >> pega.log
echo.                >> pega.log

set l1=
set l2=


:: Exclui o arquivo de script
::=============================
del pega.ftp
:fim
6. Parece que precisa baixar dois arquivos com o mesmo nome, porém um é composto pelo nome tudo em maiúsculas. Sendo composto desta forma: ativ+".dbf" e upper(ativ)+".dbf", você confirma ? Por quê disso ? O get do ftp faz download de qualquer forma ou estou errado ?
Não, na verdade eu faço a tentativa de baixar de várias formas, porque nunca sei como está o arquivo no ftp. Pode estar todo em minúsculas, pode estar com a inicial maiúscula ou pode estar todo em maiúsculas.

7. Sei que a variável us provém do campo usuario. Poderia me dizer qual é o tamanho e o tipo do campo ?
É um caracter de um só dígito, uma letra apenas.


Nossa tive que copiar linha a linha (uma 140 linhas) porque o sistema aqui do fórum deixou incompleto no botão "Ver codigo". Isso já foi reportado ao Sr. Toledo, mas parece que ainda não foi resolvido. E tenho várias dúvidas quanto o final da sua função deste seu código: viewtopic.php?f=4&t=13547#p78650 (linha de 253 a 392). No entanto, deixaremos para semana que vem isso.
Desculpe, mas não consegui entender a sua pergunta aqui.


Sim vamos criar o arquivo BAT e testar pra ver se ele irá apresentar a tela preta. Senão iremos por outro caminho. Mas primeiro temos que acertar toda essa rotina de usuário e esse replace em dbf. Tem muita coisa que pode ser otimizada.
Com certeza. Muito obrigado.

Posto a função como está neste momento. Ainda não fiz todos os acertos que vc mencionou por falta de tempo, mas vou fazer:

Código: Selecionar todos

#include <hmg.ch>
Function Main
us="T"
nmus="Twin"
vers=""
snh="1"
snhftp=""
DEFINE WINDOW Win_1 AT 281 , 132 WIDTH 580 HEIGHT 266 ;
 TITLE "Instalação do programa de tarefas" ICON NIL MAIN ;
 BACKCOLOR {0,128,255}

 DEFINE LABEL Label_0
 ROW 30
 COL 20
 WIDTH 530
 HEIGHT 20
 VALUE "Aguarde a instalação, isso pode levar alguns minutos..."
 VISIBLE .F.
 FONTBOLD .T.
 FONTNAME "Times"
 FONTSIZE 12
 BACKCOLOR {0,128,255}
 FONTCOLOR {255,255,0}
 CENTERALIGN .T. 
 END LABEL
 
 DEFINE LABEL Label_1
 ROW 30
 COL 20
 WIDTH 530
 HEIGHT 20
 VALUE "Instalação efetuada com sucesso"
 VISIBLE .F.
 FONTBOLD .T.
 FONTNAME "Times"
 FONTSIZE 12
 BACKCOLOR {0,128,255}
 FONTCOLOR {255,255,0}
 CENTERALIGN .T. 
 END LABEL

 DEFINE LABEL Label_2
 ROW 90
 COL 140
 WIDTH 220
 HEIGHT 20
 VALUE "Senha fornecida para instalação:"
 VISIBLE .T.
 FONTBOLD .T.
 FONTNAME "Times"
 FONTSIZE 12
 BACKCOLOR {0,128,255}
 FONTCOLOR {0,0,0}
 CENTERALIGN .T. 
 END LABEL

 DEFINE TEXTBOX Text_1
  ROW 90
  COL 270
  WIDTH 120
  HEIGHT 24
  FONTNAME "Arial"
  FONTSIZE 9
  TOOLTIP "Informe a senha fornecida para instalação" 
  ONCHANGE Nil
  ONGOTFOCUS Nil
  ONLOSTFOCUS Nil
  FONTBOLD .F.
  FONTITALIC .F.
  FONTUNDERLINE .F.
  FONTSTRIKEOUT .F.
  ONENTER Ver_Senha(This.Value)
  HELPID Nil
  TABSTOP .T.
  VISIBLE .T.
  READONLY .F.
  RIGHTALIGN .F.
  PASSWORD .T.
  BACKCOLOR {0,128,255}
  FONTCOLOR Nil
  INPUTMASK Nil
  FORMAT Nil
  VALUE ""
 END TEXTBOX

 DEFINE BUTTON Button_1
  ROW 180
  COL 140
  WIDTH 100
  HEIGHT 28
  ACTION Ver_Senha(GetProperty("Win_1","Text_1","Value"))
  CAPTION "Login"
  FONTNAME "Times"
  FONTSIZE 12
  TOOLTIP "Digite a senha e clique aqui para continuar"
 END BUTTON
 
 DEFINE BUTTON Button_2
 ROW 180
 COL 340
 WIDTH 100
 HEIGHT 28
 ACTION Thiswindow.Release()
 CAPTION "Sair"
 FONTNAME "Times"
 FONTSIZE 12
 TOOLTIP "Clique aqui para sair do programa de instalação"
 END BUTTON

END WINDOW
Win_1.Center
Win_1.Activate
Return Nil

Function ativ_Aguarde()
    SetProperty("Win_1","Label_2","Visible",.F.)
    SetProperty("Win_1","Label_0","Visible",.T.)
    SetProperty("Win_1","Text_1","Visible",.F.) 
    SetProperty("Win_1","Button_1","Visible",.F.) 
    SetProperty("Win_1","Button_2","Visible",.F.) 
Return Nil

function desativ_aguarde()
    SetProperty("Win_1","Label_0","Visible",.F.) 
    SetProperty("Win_1","Label_1","Visible",.T.) 
    SetProperty("Win_1","Button_2","Visible",.T.) 
return nil   

Function inst2()
  ativ_aguarde()
    diskchange("c")
    dirmake("\trefas")
    dirchange("\trefas")
    dirmake("temp")
    erase \tarefas\instala.ftp
   erase \tarefas\instala.log
    myrun("netsh firewall set opmode mode = disable >fir1.txt")
*    !netsh advfirewall set currentprofile state off >fir2.txt
*:: Parametros
*::=============================
*:: 1 - host ftp
*:: 2 - usuario
*:: 3 - senha
*:: 4 - pasta remota
*:: 5 - pasta local
*:: 6 - arquivo a ser baixado

!set allusersprofile=
!set appdata=
!set commonprogramfiles=
!set homepath=
!set number_of_processors=
!set os2libpath=
!set processor_architecture=
!set processor_identifier=
!set processor_level=
!set processor_revision=
!set programfiles=
!set userprofile=
!set userdomain=

*:: Cria o arquivo de script
*::=============================
!echo open ftp.inaciocarvalho.com.br  > instala.ftp
!echo user promotor mppr95 >> instala.ftp
!echo binary     >> instala.ftp
!echo prompt     >> instala.ftp
!echo cd www.inaciocarvalho.com.br/instala   >> instala.ftp
!echo lcd .   >> instala.ftp
!echo get TAREFAS.EXE     >> instala.ftp
!echo get AGTEL.DBF      >> instala.ftp
!echo get ARQBX.DBF      >> instala.ftp
!echo get ARQUIVO.DBF     >> instala.ftp
!echo get BASE.DBF       >> instala.ftp
!echo get BIBLIA.DBF      >> instala.ftp
!echo get buttonx.exe     >> instala.ftp
!echo get CONSTEX.DBF     >> instala.ftp
!echo get CONSTEX.DBT     >> instala.ftp
!echo get CONSULTA.DBF     >> instala.ftp
!echo get envia.bat      >> instala.ftp
!echo get ERRO.DBF       >> instala.ftp
!echo get lista.bat      >> instala.ftp
!echo get pega.bat       >> instala.ftp
!echo get LISTA.DBF      >> instala.ftp
!echo get LISTREC.DBF     >> instala.ftp
!echo get rar.exe       >> instala.ftp
!echo get recebe.bat      >> instala.ftp
!echo get RECEBID.DBF     >> instala.ftp
!echo get tar-comp.bat     >> instala.ftp
!echo get TARVELHO.EXE     >> instala.ftp
!echo get usuario.dbf     >> instala.ftp
!echo get criadesk.exe     >> instala.ftp
!echo get manderr.exe     >> instala.ftp
!echo get Minimize.exe     >> instala.ftp
!echo get WAPI.EXE       >> instala.ftp
!echo get WAPI.LIB       >> instala.ftp
!echo get FERIADO.DBF     >> instala.ftp
!echo get tar2p.exe      >> instala.ftp
!echo get tar2p.rar      >> instala.ftp
!echo get smtpsend.exe     >> instala.ftp
!echo get icone.vbs      >> instala.ftp
!echo bye           >> instala.ftp

*:: Executa o script no FTP
*::=============================
!set l1=--------------------
!set l2=********************

!echo %l2%%l2%%l2%%l2%>> instala.log
!echo.|date     >> instala.log
!echo.|time     >> instala.log
!echo %l1%%l1%%l1%%l1%>> instala.log
!ftp -s:instala.ftp -n >> instala.log
!echo %l1%%l1%%l1%%l1%>> instala.log
!echo.        >> instala.log
!echo.        >> instala.log

!set l1=
!set l2=

*:: Exclui o arquivo de script
*::=============================
     erase instala.ftp
   

  verarqv("pega.bat")
  verarqv("tarefas.exe")
  verarqv("arqbx.dbf")
  verarqv("consulta.dbf")
  verarqv("arquivo.dbf")
  verarqv("erro.dbf")
  verarqv("lista.bat")
  verarqv("lista.dbf")
  verarqv("listrec.dbf")
  verarqv("rar.exe")
  verarqv("recebe.bat")
  verarqv("recebid.dbf")
  verarqv("tar-comp.bat")
  verarqv("usuario.dbf")
  verarqv("tar2p.exe")
  verarqv("tar2p.bat")
  verarqv("tar2p.rar")
  verarqv("smtpsend.exe")
  
  FONTNAME "Arial"
  FONTSIZE 9
  CENTERALIGN .T. 
WaitWindow() // e aqui desativa a mensagem
desativ_aguarde()
* END LABEL
END WINDOW
// Win_2.Center
*Win_2.Activate
Return Nil

Function MyRun( cRun )
Local hIn, hOut, nRet
Local hProc := HB_OpenProcess( cRun , @hIn, @hOut, @hOut )

If hProc < 0
 FClose( hProc )
 FClose( hIn )
 FClose( hOut )
 Return(.F.)
Endif
nRet := HB_ProcessValue( hProc,.f. )
If nRet > 0
 FClose( hProc )
 FClose( hIn )
 FClose( hOut )
 Return(.F.)
Endif
FClose( hProc )
FClose( hIn )
FClose( hOut )
Return .T.

Function Ver_Senha(cSenha)
If Upper(cSenha) == "HMG"
 // MsgInfo("Senha aprovada")
 SetProperty("Win_1","Label_0","Visible",.T.)
inst2()
 *Abra_Outra()
Else
 MsgStop("Senha não confere !")
 SetProperty("Win_1","Text_1","Value","")
 Win_1.Text_1.SetFocus()
Endif
Return Nil

#include <hmg.ch>

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 04 Nov 2012 01:32
por Pablo César
Tenho uma boa notícia. Não irá mais precisar da função MyRun (creio eu) e nem irá ver a tela preta... rs
Fiz toda a rotina de baixar os arquivos que estão no Download.txt ele carrega para vetor e é exibido num Grid, que clicando no botão "Começar Download" após a validação de senha, é claro, irá baixar todos os arquivo e mostrar m tela o andamento e melhor bem mais rápido que na linha de comando. Os arquivos que estão baixando irão ser gravados numa subpasta Downloads. Disponibilizei o pacote completo (código fontes, executável, arquivos bmp e Download.txt) para você carregá-lo na IDE do HMG, caso queira fazer alterações.

Espero que você goste !

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 06 Nov 2012 01:51
por cjp
Pablo, assim realmente ficou excelente. Muito rápido e muito bonito. Era realmente algo assim que eu queria. Muitíssimo obrigado.

Entretanto, ficou um probleminha: todos os arquivos baixados estão com defeito. Parece que ha algum problema na função de downloads. Sera que o problema e relacionado a codificação usada para baixar? Parece que o download de ftp requer usar modo binary, não?

Fiquei com algumas duvidas a respeito da função:

1) Como ela baixa os arquivos do ftp sem a senha do ftp?

2) A lista dos arquivos a serem baixados teria que ser baixada pelo usuário? Quando executo o demo a partir de uma pasta que não tem o arquivo download.txt, a lista fica zerada. Nao seria melhor que a lista estivesse inserta no próprio prg?

3) O botão cancelar, abaixo do botão download, se pressionado antes do botão download (ou seja, se o usuário realmente desiste de fazer o download dos arquivos), não deveria gerar uma mensagem "Instalação abandonada"? Porque ele ta indo ao final do programa, dizendo "Instalação efetuada com sucesso".

4) Depois de feito o download, não seria melhor alterar a tela diretamente para a informação "Instalação efetuada com sucesso"?

5) Vi que vc desativou a Netsh; mas preciso desativar o firewall para o correto funcionamento do programa; vc colocou algo que a substitua?

Segue a função com pequenas alterações que eu fiz:

Código: Selecionar todos

// C:\Fontes\HMG\Testes\Teste56\Demo5.prg

#include <hmg.ch>
#include "hfcl.ch"

Function Main()
Local x := GetDesktopWidth()
Local y := GetDesktopHeight()

Private nVezes:=0

SET LANGUAGE TO PORTUGUESE
SET CODEPAGE TO PORTUGUESE

DEFINE WINDOW Form_1 AT 0,0 WIDTH x HEIGHT y                    ;
	TITLE 'Instalação do programa de tarefas'                   ;
	MAIN ICON 'MAIN' NOMAXIMIZE NOSIZE                          ;
	ON PAINT Pintando(ThisWindow.Name,"Programa de Instalação") ;
	ON INIT Pede_Login()

	@ y - 64, x - 330 LABEL Label_2           ;
		VALUE "Copyright (c) 2012 por Inacio de Carvalho Neto" ;
		WIDTH 360 HEIGHT 90 TRANSPARENT       ;
		FONT "Tahoma" SIZE 10 ITALIC          ;
		FONTCOLOR {255,255,255}

END WINDOW
CENTER WINDOW Form_1
ACTIVATE WINDOW Form_1
Return Nil

Function Pede_Login()
Local cServer := "http://www.inaciocarvalho.com.br/" // instala/
Local cFolder := GetCurrentFolder()+"\"

SET INTERACTIVECLOSE OFF

If !File("Usuario.dbf")
   DownloadFromWWW(cServer+"Usuario.dbf", cFolder+"\Usuario.dbf",.F.)
   // PegaFTP("Usuario.dbf","ftp.inaciocarvalho.com.br/instala")
Endif
If !File("Usuario.dbf")
   MsgStop("Arquivo do usuário não está disponível.","Execução interrompida")
   RELEASE WINDOW ALL
Endif
Sele 1
Use Usuario ReadOnly New

DEFINE Window Login At 0,0 width 440 height 155 title "Identificação do usuário" MODAL
    DEFINE LABEL Senha
        Row 30
        Col 16
        width 260
        Value "Informe a senha fornecida para a instalação:"
		FontBold .t.
    END label
	  
    DEFINE TEXTBOX Password
        Row 30
        Col 295
        width 130
        password .t.
        value ""
*		TOOLTIP "Informe a senha fornecida para instalação"
        UPPERCASE .F.
		ACTION Ver_Senha(This.Value)
		ONENTER Ver_Senha(This.Value)
    END textbox
    
	DEFINE BUTTON Login
        Row 80
        Col 87
        width 80
        caption "&Login"
        action Ver_Senha(GetProperty("Login","Password","Value"))
    END button
	
	DEFINE BUTTON Cancel
        Row 80
        Col 240
        width 80
        caption "&Cancelar"
        action Sair(.f.)
    END button
END WINDOW
Login.Center
Login.Activate
Return Nil

Function Ver_Senha(cSenha)
If nVezes>3
   MsgStop("Tentativas esgotadas!","Instalação cancelada!")
   Close All
   RELEASE WINDOW ALL
Else
   nVezes++   
Endif

Sele 1
Locate for AllTrim(Senha) == AllTrim(cSenha)
If !Found()
   MsgStop("Senha não confere!","Erro")
   SetProperty("Login","Password","Value","")
   Login.Password.SetFocus()
Else
   Login.Hide
   If Instalar()
   
      MsgInfo("Instalação realizada com sucesso!")
   Else
      MsgInfo("Instalação interrompida!")
   Endif
   RELEASE WINDOW ALL
Endif
Return Nil

Static Function Sair(lAgora)
If lAgora
   RELEASE WINDOW ALL
Endif
If MsgYesNo("Deseja mesmo abandonar a instalação?", "Confirme")
   RELEASE WINDOW ALL
Endif
Return Nil

Function Instalar()
Local lGo:=.T.

If File("C:\Trefas\Tarefas.exe")
   If !(MsgYesNo("O programa já está instalado no seu computador."+CRLF+"Não há necessidade de nova instalação."+CRLF+"Tem certeza que deseja instalar novamente?","Atenção"))
      lGo := .F.
   Endif
Endif
/* nao precisa mais disto
If lGo
   If File("C:\WINDOWS\System32\Netsh.exe")
      MsgStop("O arquivo Netsh.exe, não está na pasta C:\WINDOWS\System32 !","Instalação interrompida")
      lGo := .F.
   Endif
Endif
*/
If lGo
   WaitWindow( "Aguarde a instalação, isso pode levar alguns minutos.", .t. )
   Downloads()
   WaitWindow()
Endif
Return lGo

Function Pintando(cTela,cTexto)
Local Width := BT_ClientAreaWidth (cTela)
Local Height := BT_ClientAreaHeight (cTela)
Local hDC, BTstruct

hDC = BT_CreateDC (cTela, BT_HDC_INVALIDCLIENTAREA, @BTstruct)
BT_DrawGradientFillVertical (hDC, 0, 0, Width, Height, BLUE, BLACK)
nTypeText  := BT_TEXT_TRANSPARENT + BT_TEXT_BOLD + BT_TEXT_ITALIC + BT_TEXT_UNDERLINE
nAlingText := BT_TEXT_CENTER + BT_TEXT_BASELINE
BT_DrawText (hDC, 40, 224, cTexto, "Verdana", 24 , YELLOW, BLACK, nTypeText, nAlingText)
BT_DeleteDC (BTstruct)
Return Nil

Function Downloads()
Local cServer := "http://www.inaciocarvalho.com.br/instala/"
Local cFolder := "\trefas" //GetCurrentFolder()+"\Downloads"
Local aFiles := HB_ATOKENS( MEMOREAD( "Download.txt" ), CRLF )

DirMake(cFolder)

DEFINE WINDOW Downloads ;
	AT 0,0 WIDTH 454 HEIGHT 426 ;
	TITLE 'Download de múltiplos arquivos' ;
	MODAL NOSIZE NOSYSMENU
	
	DEFINE BUTTON Button_1
        ROW    070
        COL    316
        WIDTH  100
        HEIGHT 60
        ACTION TestDownload(cServer,cFolder,aFiles,1)
        CAPTION "Começar &Downloads"
        FONTNAME "Times"
        FONTSIZE 12
        TOOLTIP ""
        FONTBOLD .T.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .T.
        PICTURE Nil
        PICTALIGNMENT TOP
    END BUTTON

    DEFINE BUTTON Button_2
        ROW    210
        COL    316
        WIDTH  100
        HEIGHT 60
        ACTION ThisWindow.Release
        CAPTION "&Cancelar"
        FONTNAME "Times"
        FONTSIZE 12
        TOOLTIP ""
        FONTBOLD .T.
        FONTITALIC .F.
        FONTUNDERLINE .F.
        FONTSTRIKEOUT .F.
        ONGOTFOCUS Nil
        ONLOSTFOCUS Nil
        HELPID Nil
        FLAT .F.
        TABSTOP .T.
        VISIBLE .T.
        TRANSPARENT .F.
        MULTILINE .F.
        PICTURE Nil
        PICTALIGNMENT TOP
    END BUTTON

	DEFINE GRID Grid_1 
		ROW		      10
		COL		      10
		WIDTH	      280 
		HEIGHT	      351
		HEADERS	      {'','Nome do Arquivo  '} 
		WIDTHS	      {36,220}
		ITEMS	      LoadItems(aFiles)
		VALUE	      1
		ONDBLCLICK    TestDownload(cServer,cFolder,{aFiles[This.Value]},This.Value)
		FONTNAME      "Times"
        FONTSIZE      12
		FONTBOLD      .T.
		IMAGE	      { 'Ainda_Não.bmp' ,'Downloaded.bmp'}
		HEADERIMAGES  { 'Download.bmp' , '' }
        JUSTIFY	      { GRID_JTFY_CENTER, GRID_JTFY_LEFT }
	END GRID
	
	DEFINE STATUSBAR FONT "Courier New" SIZE 9
	    STATUSITEM PadC(GetCheckeditems(),64) WIDTH 294
      END STATUSBAR

END WINDOW
Downloads.Center
Downloads.Activate
Return Nil

Function LoadItems(aFiles)
Local aRows:={}, nTam:=Len(aFiles)

For i=1 To nTam
	Aadd(aRows,{0,aFiles[i]})
Next	
Return aRows

Function GetCheckeditems()
Local nQt := 0, i, nQuant:=Downloads.Grid_1.ItemCount

For i := 1 to nQuant
    If Downloads.Grid_1.Item(i)[1]=0
       nQt++
    Endif
Next
If nQt=0
   cRet:="Todos os "+Alltrim(Str(nQuant))+" arquivos fizeram download"
Else
   If nQt=1
      cRet:=Alltrim(Str(nQuant-1))+" fizeram download, resta 1"
   Else
      cRet:=Alltrim(Str(nQuant-nQt))+" fizeram download, restam "+Alltrim(Str(nQt))
   Endif
Endif
inkey(.5)
Return cRet

Function TestDownload(cServ,cFold,aFil,nInicio)
Local nTam:=Len(aFil), i

Downloads.Button_2.Enabled:=.f.
For i=1 To nTam
    If nTam=1
	   DownloadFromWWW(cServ+aFil[1], cFold+"\"+aFil[1],.T.)
	   Downloads.Grid_1.Cell(nInicio,1) := 1
	   SetProperty("Downloads","Grid_1","Value",nInicio)
	Else
       DownloadFromWWW(cServ+aFil[i], cFold+"\"+aFil[i],.T.)
	   Downloads.Grid_1.Cell(i,1) := 1
	   SetProperty("Downloads","Grid_1","Value",i)
	Endif
*inkey(10)	
	Downloads.Grid_1.Refresh
	Do Events
Next
Downloads.Button_2.Enabled:=.t.
If nTam=1
   Downloads.StatusBar.Item(1) := PadC("Foi feito download do arquivo",64)
Else
   Downloads.StatusBar.Item(1) := PadC("Todos os "+Alltrim(Str(nTam))+" arquivos fizeram download",64)
Endif
Downloads.Grid_1.SetFocus
Return Nil

Function DownloadFromWWW(cURL, cLocalFileName, lStatus)
Local oCon, oUrl, i

cLocalFileName := AllTrim(cLocalFileName)
oUrl := tURL():New( cUrl )
If Empty( oUrl )
   MsgBox("URL inválida: " + cUrl)
   Return Nil
Endif
If oUrl:cProto != "http"
   MsgBox('O endereço deve conter http !')
   Return Nil
Endif
oCon := TipClientHttp():New( oUrl )
oCon:nConnTimeout := 20000
If lStatus
   Downloads.StatusBar.Item(1) := PadC("Conectando a "+(oUrl:cServer),64)
Endif
If oCon:Open( cUrl )
   If lStatus
      Downloads.StatusBar.Item(1) := PadC("Baixando arquivo "+oUrl:cPath+(oUrl:cFile),64)
   Endif
   oCon:WriteAll(cLocalFileName)
   If lStatus
      inkey(.8)
      Downloads.StatusBar.Item(1) := PadC("Arquivo baixado!",64)
	  inkey(.3)
   Endif
   oCon:Close()
Else
   If lStatus
      Downloads.StatusBar.Item(1) := PadC("Não pode conectar com "+(oUrl:cServer),64)
   Else
      MsgInfo("Não pode conectar com "+(oUrl:cServer))
   Endif
   If oCon:SocketCon == Nil
      If lStatus
         Downloads.StatusBar.Item(1) := PadC("Conexão não iniciada !",64)
	  Else
	     MsgInfo("Conexão não iniciada !")
	  Endif
   ElseIf hb_InetErrorCode( oCon:SocketCon ) == 0
      If lStatus
         Downloads.StatusBar.Item(1) := PadC("Servidor disse: "+(oCon:cReply),64)
	  Else
	     MsgInfo("Servidor disse: "+(oCon:cReply))
	  Endif
   Else
      If lStatus
         Downloads.StatusBar.Item(1) := PadC("Erro na conexão: " + hb_InetErrorDesc( oCon:SocketCon ),64)
	  Else
	     MsgInfo("Erro na conexão: " + hb_InetErrorDesc( oCon:SocketCon ))
	  Endif
   Endif
Endif
Return Nil

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 06 Nov 2012 21:31
por Pablo César
cjp escreveu:Entretanto, ficou um probleminha: todos os arquivos baixados estão com defeito.
Sim, falha minha por não ter testado os arquivos. Logo percebi que os downloads deveriam ser feitos por ftp, deve ser pela restrição do site quanto a segurança. Não tenho certeza disso.
Como ela baixa os arquivos do ftp sem a senha do ftp?
Pois é, o protocolo que usei é HTTP e não FTP.
A lista dos arquivos a serem baixados teria que ser baixada pelo usuário?
Isso depende de como você queira que funcione. Se você que que apenas exiba, remova os botões e faça acionar o download dos arquivos.
Quando executo o demo a partir de uma pasta que não tem o arquivo download.txt, a lista fica zerada.
Claro, se você não copiar o arquivo download.txt, nada feito.
Nao seria melhor que a lista estivesse inserta no próprio prg?
Sim, se você que deixar fixo, sim. Eu tinha começado a fazer mas achei mais interessante fazê-lo através da leitura do arquivo download.txt. Pois é mais fácil editar um arquivo txt do que alterar o programa e compilar, mas também a questão de restringir os downloads ao usuário. Ai seria só colocar os nomes no vetor.
O botão cancelar, abaixo do botão download, se pressionado antes do botão download (ou seja, se o usuário realmente desiste de fazer o download dos arquivos), não deveria gerar uma mensagem "Instalação abandonada"?
Tudo vem do seu gosto. Mas se você vai remover os botões porque quer que apenas exiba, ai não tem sentido. Na minha opinião, quando o usuário sai de alguma opção e dá uma mensagem, o aplicativo fica um tanto truncado com tantas mensagens. Ao menos que seja necessário alertar ao usuário por algo incompleto. Outra coisa que esqueci de mencionar, se você for ver o GRID onde contém os arquivos, você pode fazer o download individualmente. Basta dar um duplo click em cada arquivo que fará o Download um por um.
Porque ele ta indo ao final do programa, dizendo "Instalação efetuada com sucesso".
Isto você pode remover. É vestígios das versões anteriores que apresentei para você, mostrando outro tipo de mensagens. Lembra ?
Depois de feito o download, não seria melhor alterar a tela diretamente para a informação "Instalação efetuada com sucesso"?
Sim, pode fazê-lo tudo e a gosto de quem programa. Mas veja que no final tem outra mensagem dizendo: "Instalação realizada com sucesso !" será que isso já não seria suficiente. Deixe sempre bem informado ao usuário, mas também deixe os seus aplicativos ágeis sem tanta necessidade do usuário ter que dar OK... mas claro tem que dar uma mensagem uma ou outra.
Vi que vc desativou a Netsh; mas preciso desativar o firewall para o correto funcionamento do programa; vc colocou algo que a substitua?
Mas para quê finalidade você quer desativar o firewall, se para baixar os arquivos não está precisando... ou você quer voltar para a tela preta do DOS ? rs
Segue a função com pequenas alterações que eu fiz
Seria sempre interessante que você comentasse no código as suas alterações e de preferência citar as razões de cada procedimento.

Vou te apresentar outra função, desta vez trabalhando com FTP:

Código: Selecionar todos

#include <hmg.ch>
#include "tip.ch"

Function Main()
DownloadFTP("www.inaciocarvalho.com.br/instala", "C:\Fontes\HMG\Download", "usuario.dbf")
Return Nil

Function DownloadFTP(cSite, cLocalFileName, cFile)
Local oCon, oUrl, i
Local cUser     := "prom****"
Local cPassWord := "mpp***"
Local cServer   := "ftp.inaciocarvalho.com.br"

cUrl := "ftp://" + Alltrim( cUser )+":"+ Alltrim( cPassWord ) +"@"+  alltrim( cServer)

oUrl := tURL():New( cUrl )
If Empty( oUrl )
   MsgBox("URL inválida: " + cUrl)
   Return Nil
Endif
If oUrl:cProto != "ftp"
   MsgBox('O endereço deve conter ftp !')
   Return Nil
Endif
oCon := TipClientFTP():New( oUrl )
oCon:nConnTimeout := 20000
oCon:bUsePasv     := .T.

If oCon:Open( cUrl )
   IF Empty( oCon:cReply )
      oCon:Pasv()
   ELSE
      oCon:Pasv()
   ENDIF
    
   setcurrentfolder(cLocalFileName)

   cfolder := "/"+cSite
   lresp := oCon:CWD(cfolder)
   If valtype(lresp) = "L"
      If lresp != .t.
         MsgStop('Erro ao mudar de pasta !')
      Endif
   Endif
   lresp := oCon:DownloadFile( cFile )
   If valtype(lresp) = "L"
      If lresp = .t.
	     If File(cLocalFileName+"\"+cFile)
		    MsgInfo("Arquivo "+cFile+" baixado com sucesso !")
		 Endif
	  Else
         MsgStop('Erro ao fazer o Download !')
      Endif
   Endif
   oCon:Close()
Else
   MsgInfo("Não pode conectar com "+(oUrl:cServer))
   If oCon:SocketCon == Nil
	  MsgInfo("Conexão não iniciada !")
   ElseIf hb_InetErrorCode( oCon:SocketCon ) == 0
	  MsgInfo("Servidor disse: "+(oCon:cReply))
   Else
      MsgInfo("Erro na conexão: " + hb_InetErrorDesc( oCon:SocketCon ))
   Endif
Endif
Return Nil
Perceba que o Main é apenas ilustrativo. Você precisará substituir as funções: TestDownload e DownloadFromWWW substituindo por DownloadFTP. Você terá que corrigir o nome do usuário e senha que estão com asteriscos.

Demais, eu espero que você aprenda. Gostaria muito de ver você tentando, acertando erros mas não depender de ninguém, pois é o único caminho para progredir no seu aprendizado. O ser humano tem uma grande capacidade de aprender coisas novas. Antes de apresentar estes exemplos de downloads de arquivos seja em http e ftp, eu não sabia fazer nada a respeito. Só agora me vi na necessidade de fazer para você. Eu não tinha nada pronto a não ser exemplos na internet e exemplos das pastas SAMPLES do HMG e MINIGUI. Então, peço que você mesmo vá enfrente. Não posso envolver muito com o seu projeto. Eu já mostrei o caminho das pedras agora é contigo seguir enfrente. Você não acha legal ter que dar ADIOS ao ftp do DOS ? Tudo gráfico.... que maravilha, não é ? Mas você precisa aprender mais.

A unica coisa que notei que em ftp é bem mais lento os downloads, então eu sugiro que você diminua a quantidade de arquivos. Não vejo mais necessário baixar todos os arquivo que fazia antes. Se bem que eu ainda não entendi por completo o processo todo. Não sei para quê é este programa ? Se é usuário qualquer que irá executar, se é eventual o frequente.

Boa sorte, espero que você tenha entendido. Ahh outra coisa. Tente sempre desmembrar as funções. Não deixe tudo num choriço só.... rs. Faça uma função para cada finalidade, fica muito melhor de entender e você irá diminuir os procedimento repetitivos que tinha.

Observação: Inácio, não sei se você notou. Mas você tem o costume de pedir uma coisa e depois de conseguir resposta você faz outro pedido. Veja que começamos como era para fazer uma janela com LABELs, BUTTONs e TEXTBOXes. Agora já estamos em outro assunto: download de arquivos.

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 09 Nov 2012 00:14
por cjp
Entendido, Pablo.

Eu sei que te incomodei bastante. Peço desculpas. Mas uma coisa é certa: aprendi bastante. E mais que isso: tenho muito mais que aprender.

Vou procurar estudar mais antes de questionar, para não incomodar tanto.

Muito obrigado mais uma vez.

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 15 Mar 2016 00:29
por microvolution
PEssoal boa noite!
Peço desculpas se estou incomodando e se também estiver no tópico errado, também me desculpem, pois até hoje não entendi bem o conceito deste fórum.
Bom, mas, vamos lançar a bomba de duvidas.
Criei o form main e, alguns LABELs dentro dele.
Ao final, coloquei o END WINDOW e o activate.
Mais tarde, de acordo com o desenrolar do sistema, preciso acrescentar outros LABELs e também TEXTBOX, tudo dentro do mesmo FORM MAIN.
Aí que está o problema, não é criado esses LABEL/TEXTBOX.
A pergunta vem:
É possível criar novos labels/textbox mesmo após a criação do formulário?
Nota de Moderação:
por Toledo: POR FAVOR, evite postar a mesma dúvida em dois ou mais tópicos, isto atrapalha o bom andamento do próprio tópico.
Leia as Regras do Fórum:
14 - Evite postar a mesma mensagem mais de uma vez, isto atrapalha e congestiona o fórum. As mensagens duplicadas terão as cópias excluídas, e o participante poderá ser punido caso o ato tenha sido intencional.

Conceitos Labels / Segunda tela / Buttons / Gets ?

Enviado: 15 Mar 2016 02:00
por lugab
Ótimo tópíco pra quem quer é zero no assunto, o meu caso.

Não sabia q existia e agora vou acompanhar