Jump to content
Fivewin Brasil

Theotokos

Membros
 View Profile  See their activity

  • Posts

    1,796

  • Joined

  • Last visited

  • Days Won

    31

 Content Type 

Posts posted by Theotokos

  2. Bloqueio do sistema

    in Programação

    Posted

    42 minutos atrás, kapiaba disse:

    Bom dia. Nada impede que você cerre(feche) o programa em definitivo, somente o da estação de trabalho.  abs.

    Regards, saludos.

    optei por fazer assim, porque no meu caso tinha usuário que abria uma venda, lança alguns produtos e sai para mostrar algo para o cliente, deixando tudo aberto... ai com tempo iria fechar o sistema e perder tudo que lançou, assim pede a senha novamente, o vendedor coloca a senha dele e segue a venda aberta...

  3. Aposentadoria... Parar ou Não Parar ?

    in Programação

    Posted

    Olá meu caro amigo... não conhecemos pessoalmente, mas com certeza vc é uma das pessoas que muito contribuiu e contribui por este fórum... 

    que bom que chegou nesta fase de vida... realmente é uma decisão difícil... penso que não deve ser levado em conta apenas o financeiro, mas sim a saúde mental, familiar e de vida... 

    eu tenho 52 anos... tenho trabalhado nesta área à 28 - 29 anos mais ou menos, e muitas vezes tenho este mesmo pensamento, "não esta fácil acompanhar as mudanças", fora que tempo trabalhando com varias pessoas (clientes, funcionários) e cada um com sua personalidade (chatice kkk); porem não estou ainda com o tempo para aposentadoria - pois hoje se eu pudesse aposentar, já aposentaria, pelo menos ter a paz de que não preciso correr atrás e então me dedicaria a alguns trabalhos que vale a pena...  

    Um forte abraço, e que Deus ilumine sua decisão...

     

  5. Bloqueio do sistema

    in Programação

    Posted

    2 minutos atrás, Theotokos disse:

    seria mais ou menos isso aqui: (peguei aqui no forum mesmo, mas não lembro de quem... acabei que não usei) 

    Function Fnct_StartCounterTime ()

   Define Timer oTimerExit of oWndMain Interval nInterval Action ( iif( sysIdleSecs()>nSecondsToOut, fExit(),))
   oTimerExit:Activate()

Return NIL

function fExit()

    oTimerExit:Deactivate()
    //oTimerExit:End()

    MsgInfo( "Lembre de Fechar Sistema caso não vá mais usar","Sistema Inativo")
    
    oTimerExit:Activate()
    
    *
	 MsgAlert('Sistema Será Fechado por Inatividade','SyS RlI')

    oWndMain:End()

	SET RESOURCES TO
	
	oImgFundo:End()
	oImgLogo:End()
	oFntMsg:End()
	
	FecharPrograma()
	*

return .t.

#pragma BEGINDUMP
#include "windows.h"
#include "hbapi.h"
#include <stdio.h>

WINUSERAPI BOOL WINAPI GetLastInputInfo(PLASTINPUTINFO);
typedef  BOOL (WINAPI *GETLASTINPUTINFO_)(PLASTINPUTINFO);

HB_FUNC( SYSIDLESECS )
{
   HINSTANCE handle= LoadLibrary("user32.dll");
   if ( handle)
   {
      GETLASTINPUTINFO_ pFunc;
      pFunc = GetProcAddress( handle,"GetLastInputInfo" );
      if (pFunc)
      {
         LASTINPUTINFO lpi;

         lpi.cbSize = sizeof(LASTINPUTINFO);

         if (!pFunc(&lpi))
         {
            hb_retni(0);
         }
         else
         {
            hb_retnd( ( DOUBLE ) ( GetTickCount() - lpi.dwTime ) * 0.001 );
         }
      }
   else
      {
         hb_retni(0);
      }
   }

   if (handle)
      {
         FreeLibrary( handle);
      }
}
#pragma ENDDUMP
***********************************************************************************************+

     

    Static oTimerExit
    Static nInterval
    *
    Function Main()
       *
       Public nSecondsToOut:= 55 //(segundos)

       nInterval := 1*60000  //(1 x 60000 = 1 minuto)

     

    Acrescentar isso no fotnte principal e chamar a função no ON INIT
     

  6. Bloqueio do sistema

    in Programação

    Posted

    seria mais ou menos isso aqui: (peguei aqui no forum mesmo, mas não lembro de quem... acabei que não usei) 

    Function Fnct_StartCounterTime ()

   Define Timer oTimerExit of oWndMain Interval nInterval Action ( iif( sysIdleSecs()>nSecondsToOut, fExit(),))
   oTimerExit:Activate()

Return NIL

function fExit()

    oTimerExit:Deactivate()
    //oTimerExit:End()

    MsgInfo( "Lembre de Fechar Sistema caso não vá mais usar","Sistema Inativo")
    
    oTimerExit:Activate()
    
    *
	 MsgAlert('Sistema Será Fechado por Inatividade','SyS RlI')

    oWndMain:End()

	SET RESOURCES TO
	
	oImgFundo:End()
	oImgLogo:End()
	oFntMsg:End()
	
	FecharPrograma()
	*

return .t.

#pragma BEGINDUMP
#include "windows.h"
#include "hbapi.h"
#include <stdio.h>

WINUSERAPI BOOL WINAPI GetLastInputInfo(PLASTINPUTINFO);
typedef  BOOL (WINAPI *GETLASTINPUTINFO_)(PLASTINPUTINFO);

HB_FUNC( SYSIDLESECS )
{
   HINSTANCE handle= LoadLibrary("user32.dll");
   if ( handle)
   {
      GETLASTINPUTINFO_ pFunc;
      pFunc = GetProcAddress( handle,"GetLastInputInfo" );
      if (pFunc)
      {
         LASTINPUTINFO lpi;

         lpi.cbSize = sizeof(LASTINPUTINFO);

         if (!pFunc(&lpi))
         {
            hb_retni(0);
         }
         else
         {
            hb_retnd( ( DOUBLE ) ( GetTickCount() - lpi.dwTime ) * 0.001 );
         }
      }
   else
      {
         hb_retni(0);
      }
   }

   if (handle)
      {
         FreeLibrary( handle);
      }
}
#pragma ENDDUMP
***********************************************************************************************+

     

  9. API Whatsapp

    in Programação

    Posted

    6 minutos atrás, Manoel Marinho disse:

    Erro tentando compilar WHATSAPP.PRG da pasta \fwh\samples

     

    Type: C >>>xhb.exe -o"whatsapp.c" -m -n -p -q -gc0  -I"C:\fwh2307\include"  -I"C:\FWH2307\include" -I"C:\xHBCOM1703\include" -I"C:\xHBCOM1703\include\w32" "whatsapp.prg"<<<

    xHarbour 1.2.3 Intl. (SimpLex) (Build 20170312)
    Copyright 1999-2017, http://www.xharbour.org http://www.harbour-project.org/
    Generating object output to 'whatsapp.obj'...

    Type: C >>>xlink.exe -NOEXPOBJ -MAP -FORCE:MULTIPLE -NOIMPLIB -subsystem:windows -UNMANGLE -LIBPATH:"C:\fwh2307\lib" -LIBPATH:"" -LIBPATH:"C:\FWH2307\lib" -LIBPATH:"C:\xHBCOM1703\Lib" -LIBPATH:"C:\xHBCOM1703\c_lib" -LIBPATH:"C:\xHBCOM1703\c_lib\win"  "whatsapp.obj" "C:\fwh2307\lib\FiveHCM.lib" "C:\fwh2307\lib\FiveHMX.lib" "OptG.lib" "xhb.lib" "dbf.lib" "nsx.lib" "ntx.lib" "cdx.lib" "rmdbfcdx.lib" "ct3comm.lib" crt.lib kernel32.lib user32.lib winspool.lib ole32.lib oleaut32.lib odbc32.lib odbccp32.lib uuid.lib wsock32.lib ws2_32.lib wininet.lib advapi32.lib shlwapi.lib msimg32.lib mpr.lib OleDlg.lib version.lib comctl32.lib comdlg32.lib gdi32.lib shell32.lib winmm.lib lz32.lib Netapi32.lib -out:"whatsapp.exe"<<<

    xLINK: fatal error: No argument specified with option /LIBPATH.

    Type: C >>>Couldn't build: whatsapp.exe<<<
    Type: C >>>TMAKEPROJECT<<<
    ype: C >>>TMAKEPROJECT:REFRESH<<<
    Type: N >>>      1415<<<
     

    eu não uso a copilação desta forma, eu utilizo xDev... mas verifica se isso: -LIBPATH:""

  10. API Whatsapp

    in Programação

    Posted

    Verificando o sitem Word System... vc faz seu cadastro lá pode usar por 7 dias gratuito e depois assinar um dos planos...

    mas verificando lá as opções este codigo seu esta incompleto..  esta faltando opções para criar instancia, conexão, etc...

    só a função enviar não vai...

  12. CAMPO NOME ACEITAR NO MÁXIMO 2 NUMEROS

    in Programação

    Posted

    Em 04/01/2024 at 19:01, marcioe disse:

    Pessoal, quase que ficou 100%

    porem esta comendo os espaços em branco

    veja 


    Sem-t-tulo.png

      

    Function VerString(cStr)
	Local cStrNova := ""	
	Local nCt := 0
   For n1 := 1 To Len(AllTrim(cStr))
		If !IsAlpha( SubStr(cStr,n1,1) ) .And. !Empty(SubStr(cStr,n1,1))
			nCt++
			If nCt <= 3
	         cStrNova += SubStr(cStr,n1,1)
	      EndIf
		Else
			cStrNova += SubStr(cStr,n1,1)
		EndIf
    Next n1
    ? cStrNova
Return(cStrNova)

    ? VerString("001432 DAIANE 5555 OLIVEIRA UBÁ")

  18. DIALOG MSG com Button Temporizando

    in Programação

    Posted

    6 horas atrás, kapiaba disse: 
    Entendi o funcionamento do novo forum?

Veja se ajuda. Você pode ir mostrando o tempo de espera no Botão com o Refresh(), eu acho...

// tinativo.prg - By William Adami
// exemplo do uso da classe Tinativo
// Apos um tempo de inatividade do mouse
// e do teclado chama uma funcao qualquer.

#include "fivewin.ch"

STATIC oWnd

//************

FUNCTION Main()

   LOCAL nTempo_espera, cNome_funcao, lTimercontinua

   // Tempo a ser esperado ate chamar a funcao
   // -> 1 hora tem 3600 segundos.
   nTempo_espera := 10  // segundos. 

   // nome da funcao a ser chamada quando
   // chegar no tempo de espera
   cNome_funcao := "LOGOFF()"   
   // se apos executar a funcao , continua
   // monitorando a inatividade do mouse e teclado.
   lTimercontinua := .F.

   define window oWnd title "Teste de teclado e mouse"

   activate window oWnd ;
      ON INIT tinativo():new( nTempo_espera, cNome_funcao, lTimerContinua )

RETURN NIL

FUNCTION LOGOFF()

   // msgalert( "AQUI ENTRA SUA FUNCAO DE LOGOFF !", "AVISO" )

   IF MsgYesNo( OemToAnsi( "ATEN€ÇO USUµRIO:                       " )+CRLF+ ;
                OemToAnsi( "PROTEJA OS BANCOS DE DADOS DO PROGRAMA." )+CRLF+ ;
                OemToAnsi( "SE NÇO ESTIVER USANDO O WINORCAM.EXE,  " )+CRLF+ ;
                OemToAnsi( "DESLIGUE-O PARA NÇO CORRER RISCOS.     " )+CRLF+ ;
                OemToAnsi( "POSSO DESLIGAR O PROGRAMA? <S> ou <N>??" ),      ;
                OemToAnsi( "AVISO PARA DESLIGAR O WINORCAM.EXE...  " ) )

      //--Fecha o Programa Definitivamente
      LIBERA_TUDO()  // ESTA EM WINORCAM.PRG

      // QUIT

   ENDIF

RETURN NIL

//   tinativo.prg

#include "fivewin.ch"

CLASS TINATIVO

   DATA nTimeInpAntes
   DATA nTimeInpDepois
   DATA cTimeAtu
   DATA nTempo
   DATA oTimerTime
   DATA cFunc
   DATA lContinuar

   METHOD NEW( nTime, cFuncao, lContinua )  CONSTRUCTOR

   METHOD ver_tempo()

ENDCLASS

METHOD new( ntime, cFuncao, lContinua ) CLASS TINATIVO

   ::cfunc := cfuncao
   ::ntempo := ntime
   ::lContinuar := lContinua
   ::oTimerTime := TTimer():New( 1000, { || ::VER_TEMPO() } )
   ::oTimerTime:Activate()
   ::cTimeAtu := time()
   ::nTimeInpAntes := getInputState()    // 0 = erro

RETURN self

METHOD VER_TEMPO CLASS TINATIVO

   LOCAL AUX

   ::nTimeInpDepois := getInputState()

   IF ( ::nTimeInpDepois - ::nTimeInpAntes ) > 0

      ::nTimeInpAntes := getInputState()

      ::cTimeAtu := time()

   ENDIF


   IF ( CONVTIME( time() ) - CONVTIME( ::cTimeAtu ) ) > ::ntempo

      ::oTimerTime:DeActivate()

      aux := ::cfunc
   
      // aqui executa a funcao

      &aux

      if ::lContinuar

         ::oTimerTime:Activate()
         ::cTimeAtu := time()

      ENDIF


   ENDIF

RETURN NIL

FUNCTION CONVTIME( ZZ )

   LOCAL Z

   Z := ( VAL( LEFT(ZZ,2 ) ) * 360 ) + ( VAL( SUBSTR(ZZ,4,2 ) ) * 60 ) + ;
          VAL( RIGHT( ZZ,2 ) )

RETURN Z

//*----------------------------------------------------------------------
#pragma BEGINDUMP
#define _WIN32_WINNT 0x0500
#define WINVER 0x0500
#include "windows.h"
#include "hbapi.h"
HB_FUNC( GETINPUTSTATE )
{
LASTINPUTINFO lpi;
lpi.cbSize = sizeof(LASTINPUTINFO);
if (!GetLastInputInfo(&lpi))
{
hb_retni(0);
}
hb_retni(lpi.dwTime);
}
#pragma ENDDUMP
 
// FIN / END

Regards, saludos.

     

    Blz!!! Vou Testar hoje a noite.... Obgdao!!!

  19. DIALOG MSG com Button Temporizando

    in Programação

    Posted 

    			MsgRun( cMensagem,"LEIA Antes ",;
					  {|o| EsperarMsgRun(o) }  )
					  

Function EsperarMsgRun(o)
	
	LOCAL nSegIni := Secs(Time())
	LOCAL nSegFim := 0
	
	While .T.
		nSegFim := Secs(Time())-nSegIni
		o:cTitle := "LEIA Antes" + ;
						" - AGUARDE...     " + StrZero( nSegFim, 2) + '" / 20"'
		o:Refresh()
		
		If nSegFim >= 20
			Exit
		EndIf
	EndDo
	
Return

    FAço assim atualmente, quero substituir a MsgRun por uma DIALOG com Botão, e que o tempo fosse aparecendo no botão e depois que terminasse libera o botão...

  21. AJUDA COM FTP

    in Programação

    Posted

    2 minutos atrás, kapiaba disse:

     

    //
    // File attributes
    //

    #define FILE_ATTRIBUTE_READONLY  1
    #define FILE_ATTRIBUTE_HIDDEN    2
    #define FILE_ATTRIBUTE_SYSTEM    4
    #define FILE_ATTRIBUTE_DIRECTORY 16
    #define FILE_ATTRIBUTE_ARCHIVE   32
    #define FILE_ATTRIBUTE_NORMAL    128
    #define FILE_ATTRIBUTE_TEMPORARY 256


    //
    // access types for InternetOpen()
    //

    #define INTERNET_OPEN_TYPE_PRECONFIG                    0   // use registry configuration
    #define INTERNET_OPEN_TYPE_DIRECT                       1   // direct to net
    #define INTERNET_OPEN_TYPE_PROXY                        3   // via named proxy
    #define INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY  4   // prevent using java/script/INS


    //
    // manifests
    //

    #define INTERNET_INVALID_PORT_NUMBER    0           // use the protocol-specific default

    #define INTERNET_DEFAULT_FTP_PORT       21          // default for FTP servers
    #define INTERNET_DEFAULT_GOPHER_PORT    70          //    "     " gopher "
    #define INTERNET_DEFAULT_HTTP_PORT      80          //    "     " HTTP   "
    #define INTERNET_DEFAULT_HTTPS_PORT     443         //    "     " HTTPS  "
    #define INTERNET_DEFAULT_SOCKS_PORT     1080        // default for SOCKS firewall servers.


    //
    // service types for InternetConnect()
    //

    #define INTERNET_SERVICE_FTP     1
    #define INTERNET_SERVICE_GOPHER  2
    #define INTERNET_SERVICE_HTTP    3
    #define INTERNET_FLAG_PASSIVE 134217728


    //
    // flags for FTP
    //

    #define INTERNET_FLAG_TRANSFER_ASCII  1
    #define INTERNET_FLAG_TRANSFER_BINARY 2

    //-------------------------------------------------------------------


    FUNCTION MandaFTP(host, usuario, senha, pastaServ, arquivo, pastaLocal, oquefazer )

        LOCAL hInternet, hConnect
        Local afiles

        hInternet = INTERNETOPEN( "Anystring", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0 )

        hConnect = INTERNETCONNECT( hInternet, host, INTERNET_INVALID_PORT_NUMBER, usuario, senha, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 )

        if oquefazer = "pega"

            if ! FTPGETFILE( hConnect, pastaServ+arquivo, pastaLocal+arquivo, 0, FILE_ATTRIBUTE_ARCHIVE, 0, 0 )
                    msgStop("Erro ao receber arquivo "+pastaServ+arquivo,"Atenção!")
            end

        else

            if  FTPPUTFILE( hConnect, pastaLocal+arquivo, pastaServ+arquivo, 0, 0 )
                    msginfo("Arquivo enviado.","Sucesso!")
            else
                    msgalert("Falha no envio do arquivo"+CRLF+;
                        "Verifique conexão com a internet e firewall.","Problemas.")
            end
        end


        INTERNETCLOSEHANDLE( hConnect )

        INTERNETCLOSEHANDLE( hInternet )


    RETURN NIL

    //==============================================================================================

    *
    FUNCTION MandaImg(host, usuario, senha, pasta, aJPG, dir, oquefazer, QuemChamou)

        LOCAL hInternet, hConnect
      local hFTPDir, aFiles := {}
       local oWin32FindData, cBuffer
       Local aonde, arquivo

        /*
       STRUCT oWin32FindData
          MEMBER nFileAttributes  AS DWORD
          MEMBER nCreationTime    AS STRING LEN 8
          MEMBER nLastReadAccess  AS STRING LEN 8
          MEMBER nLastWriteAccess AS STRING LEN 8
          MEMBER nSizeHight       AS DWORD
          MEMBER nSizeLow         AS DWORD
          MEMBER nReserved0       AS DWORD
          MEMBER nReserved1       AS DWORD
          MEMBER cFileName        AS STRING LEN 260
          MEMBER cAltName         AS STRING LEN  14
       ENDSTRUCT
        */
        
        hInternet = INTERNETOPEN( "Anystring", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0 )

        hConnect = INTERNETCONNECT( hInternet, host, INTERNET_INVALID_PORT_NUMBER, usuario, senha, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 )

        if oquefazer = "vesetem"


              cBuffer = oWin32FindData:cBuffer
              hFTPDir = FtpFindFirstFile( hConnect, "*.*", @cBuffer, 0, 0 )
              oWin32FindData:cBuffer = cBuffer
              if ! Empty( oWin32FindData:cFileName )
                 aadd( aFiles, { oWin32FindData:cFileName,;
                             oWin32FindData:nSizeLow } )
                 while InternetFindNextFile( hFTPDir, @cBuffer )
                    oWin32FindData:cBuffer = cBuffer
                    aadd( aFiles, { oWin32FindData:cFileName,;
                                oWin32FindData:nSizeLow } )
                 end
              endif
            if len(afiles)>0
                for i=1 to len(aJPG)
                     aonde := ascan(afiles,aJpg)
                    if aonde > 0

                        adel(aJPG,aonde)  //fica na matriz somente o que vai ser enviado

                    end

                next
            else
                msgAlert("Erro ao carregar Dir Remoto."+CRLF+"Conexão falhou."+CRLF+"Gere o relatório novamente.","Atenção:")
            end
        else

            aJPg := {}
        end

        if len(aJPG)>0

            for i=1 to len(aJPG)
                arquivo := aJPG
                if  FTPPUTFILE( hConnect, dir+arquivo, pasta+arquivo, 0, 0 )
                    if QuemChamou = "WT5f0A"
                        msginfo("Arquivo enviado.","Sucesso!")
                    end

                    // crio log da transacao
                else
                    msgalert("Falha no envio do arquivo"+CRLF+;
                            "dir+arquivo: "+dir+arquivo + CRLF+;
                            "pasta+arquivo: "+pasta+arquivo+CRLF+;
                        "Verifique conexão com a internet e firewall.","Problemas.")
                end
            next
        end
        INTERNETCLOSEHANDLE( hConnect )

        INTERNETCLOSEHANDLE( hInternet )


    RETURN NIL
    *
    //================================================================================================

    #pragma BEGINDUMP

    #include "windows.h"
    #include "wininet.h"
    #include "hbapi.h"


    HB_FUNC( INTERNETOPEN )
    {
        hb_retnl( ( LONG ) InternetOpen( hb_parc( 1 ), hb_parnl( 2 ), hb_parc( 3 ), hb_parc( 4 ), hb_parnl( 5 ) ) );
    }


    HB_FUNC( INTERNETCLOSEHANDLE )
    {
        hb_retl( InternetCloseHandle( ( HINTERNET ) hb_parnl( 1 ) ) );
    }


    HB_FUNC( INTERNETCONNECT )
    {
        hb_retnl( ( LONG ) InternetConnect( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), ( INTERNET_PORT ) hb_parnl( 3 ), hb_parc( 4 ), hb_parc( 5 ), hb_parnl( 6 ), hb_parnl( 7 ), hb_parnl( 8 ) ) );
    }


    HB_FUNC( FTPGETFILE )
    {
        hb_retl( FtpGetFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), hb_parc( 3 ), hb_parl( 4 ), hb_parnl( 5 ), hb_parnl( 6 ), hb_parnl( 7 ) ) );
    }


    HB_FUNC( FTPPUTFILE )
    {
        hb_retl( FtpPutFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), hb_parc( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) ) );
    }


    HB_FUNC( FTPDELETEFILE )
    {
        hb_retl( FtpDeleteFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }


    HB_FUNC( FTPCREATEDIRECTORY )
    {
        hb_retl( FtpCreateDirectory( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }


    HB_FUNC( FTPREMOVEDIRECTORY )
    {
        hb_retl( FtpRemoveDirectory( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }


    HB_FUNC( FTPFINDFIRSTFILE )
    {
        hb_retnl( ( LONG ) FtpFindFirstFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), ( WIN32_FIND_DATA * ) hb_parc( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) ) );
    }


    HB_FUNC( INTERNETFINDNEXTFILE )
    {
        hb_retl( InternetFindNextFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }

    #pragma ENDDUMP
     

    aproveitei o seu kk, porque inserir nao consigo, mas ta ai

  23. AJUDA COM FTP

    in Programação

    Posted

    Essa Rotina aqui,  consegui tmb, e mais rapido

    //
    // File attributes
    //

    #define FILE_ATTRIBUTE_READONLY  1
    #define FILE_ATTRIBUTE_HIDDEN    2
    #define FILE_ATTRIBUTE_SYSTEM    4
    #define FILE_ATTRIBUTE_DIRECTORY 16
    #define FILE_ATTRIBUTE_ARCHIVE   32
    #define FILE_ATTRIBUTE_NORMAL    128
    #define FILE_ATTRIBUTE_TEMPORARY 256


    //
    // access types for InternetOpen()
    //

    #define INTERNET_OPEN_TYPE_PRECONFIG                    0   // use registry configuration
    #define INTERNET_OPEN_TYPE_DIRECT                       1   // direct to net
    #define INTERNET_OPEN_TYPE_PROXY                        3   // via named proxy
    #define INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY  4   // prevent using java/script/INS


    //
    // manifests
    //

    #define INTERNET_INVALID_PORT_NUMBER    0           // use the protocol-specific default

    #define INTERNET_DEFAULT_FTP_PORT       21          // default for FTP servers
    #define INTERNET_DEFAULT_GOPHER_PORT    70          //    "     " gopher "
    #define INTERNET_DEFAULT_HTTP_PORT      80          //    "     " HTTP   "
    #define INTERNET_DEFAULT_HTTPS_PORT     443         //    "     " HTTPS  "
    #define INTERNET_DEFAULT_SOCKS_PORT     1080        // default for SOCKS firewall servers.


    //
    // service types for InternetConnect()
    //

    #define INTERNET_SERVICE_FTP     1
    #define INTERNET_SERVICE_GOPHER  2
    #define INTERNET_SERVICE_HTTP    3
    #define INTERNET_FLAG_PASSIVE 134217728


    //
    // flags for FTP
    //

    #define INTERNET_FLAG_TRANSFER_ASCII  1
    #define INTERNET_FLAG_TRANSFER_BINARY 2

    //-------------------------------------------------------------------


    FUNCTION MandaFTP(host, usuario, senha, pastaServ, arquivo, pastaLocal, oquefazer )

        LOCAL hInternet, hConnect
        Local afiles

        hInternet = INTERNETOPEN( "Anystring", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0 )

        hConnect = INTERNETCONNECT( hInternet, host, INTERNET_INVALID_PORT_NUMBER, usuario, senha, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 )

        if oquefazer = "pega"

            if ! FTPGETFILE( hConnect, pastaServ+arquivo, pastaLocal+arquivo, 0, FILE_ATTRIBUTE_ARCHIVE, 0, 0 )
                    msgStop("Erro ao receber arquivo "+pastaServ+arquivo,"Atenção!")
            end

        else

            if  FTPPUTFILE( hConnect, pastaLocal+arquivo, pastaServ+arquivo, 0, 0 )
                    msginfo("Arquivo enviado.","Sucesso!")
            else
                    msgalert("Falha no envio do arquivo"+CRLF+;
                        "Verifique conexão com a internet e firewall.","Problemas.")
            end
        end


        INTERNETCLOSEHANDLE( hConnect )

        INTERNETCLOSEHANDLE( hInternet )


    RETURN NIL

    //==============================================================================================

    /*
    FUNCTION MandaImg(host, usuario, senha, pasta, aJPG, dir, oquefazer, QuemChamou)

        LOCAL hInternet, hConnect
      local hFTPDir, aFiles := {}
       local oWin32FindData, cBuffer
       Local aonde, arquivo

       STRUCT oWin32FindData
          MEMBER nFileAttributes  AS DWORD
          MEMBER nCreationTime    AS STRING LEN 8
          MEMBER nLastReadAccess  AS STRING LEN 8
          MEMBER nLastWriteAccess AS STRING LEN 8
          MEMBER nSizeHight       AS DWORD
          MEMBER nSizeLow         AS DWORD
          MEMBER nReserved0       AS DWORD
          MEMBER nReserved1       AS DWORD
          MEMBER cFileName        AS STRING LEN 260
          MEMBER cAltName         AS STRING LEN  14
       ENDSTRUCT

        hInternet = INTERNETOPEN( "Anystring", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0 )

        hConnect = INTERNETCONNECT( hInternet, host, INTERNET_INVALID_PORT_NUMBER, usuario, senha, INTERNET_SERVICE_FTP, INTERNET_FLAG_PASSIVE, 0 )

        if oquefazer = "vesetem"


              cBuffer = oWin32FindData:cBuffer
              hFTPDir = FtpFindFirstFile( hConnect, "*.*", @cBuffer, 0, 0 )
              oWin32FindData:cBuffer = cBuffer
              if ! Empty( oWin32FindData:cFileName )
                 aadd( aFiles, { oWin32FindData:cFileName,;
                             oWin32FindData:nSizeLow } )
                 while InternetFindNextFile( hFTPDir, @cBuffer )
                    oWin32FindData:cBuffer = cBuffer
                    aadd( aFiles, { oWin32FindData:cFileName,;
                                oWin32FindData:nSizeLow } )
                 end
              endif
            if len(afiles)>0
                for i=1 to len(aJPG)
                     aonde := ascan(afiles,aJpg)
                    if aonde > 0

                        adel(aJPG,aonde)  //fica na matriz somente o que vai ser enviado

                    end

                next
            else
                msgAlert("Erro ao carregar Dir Remoto."+CRLF+"Conexão falhou."+CRLF+"Gere o relatório novamente.","Atenção:")
            end
        else

            aJPg := {}
        end

        if len(aJPG)>0

            for i=1 to len(aJPG)
                arquivo := aJPG
                if  FTPPUTFILE( hConnect, dir+arquivo, pasta+arquivo, 0, 0 )
                    if QuemChamou = "WT5f0A"
                        msginfo("Arquivo enviado.","Sucesso!")
                    end

                    // crio log da transacao
                    SumLog(arquivo, "Enviado por ","FTP ")
                else
                    msgalert("Falha no envio do arquivo"+CRLF+;
                            "dir+arquivo: "+dir+arquivo + CRLF+;
                            "pasta+arquivo: "+pasta+arquivo+CRLF+;
                        "Verifique conexão com a internet e firewall.","Problemas.")
                        SumLog(arquivo, "Falhou ao enviar ","FTP ")
                end
            next
        end
        INTERNETCLOSEHANDLE( hConnect )

        INTERNETCLOSEHANDLE( hInternet )


    RETURN NIL
    */
    //================================================================================================

    #pragma BEGINDUMP

    #include "windows.h"
    #include "wininet.h"
    #include "hbapi.h"


    HB_FUNC( INTERNETOPEN )
    {
        hb_retnl( ( LONG ) InternetOpen( hb_parc( 1 ), hb_parnl( 2 ), hb_parc( 3 ), hb_parc( 4 ), hb_parnl( 5 ) ) );
    }


    HB_FUNC( INTERNETCLOSEHANDLE )
    {
        hb_retl( InternetCloseHandle( ( HINTERNET ) hb_parnl( 1 ) ) );
    }


    HB_FUNC( INTERNETCONNECT )
    {
        hb_retnl( ( LONG ) InternetConnect( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), ( INTERNET_PORT ) hb_parnl( 3 ), hb_parc( 4 ), hb_parc( 5 ), hb_parnl( 6 ), hb_parnl( 7 ), hb_parnl( 8 ) ) );
    }


    HB_FUNC( FTPGETFILE )
    {
        hb_retl( FtpGetFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), hb_parc( 3 ), hb_parl( 4 ), hb_parnl( 5 ), hb_parnl( 6 ), hb_parnl( 7 ) ) );
    }


    HB_FUNC( FTPPUTFILE )
    {
        hb_retl( FtpPutFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), hb_parc( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) ) );
    }


    HB_FUNC( FTPDELETEFILE )
    {
        hb_retl( FtpDeleteFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }


    HB_FUNC( FTPCREATEDIRECTORY )
    {
        hb_retl( FtpCreateDirectory( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }


    HB_FUNC( FTPREMOVEDIRECTORY )
    {
        hb_retl( FtpRemoveDirectory( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }


    HB_FUNC( FTPFINDFIRSTFILE )
    {
        hb_retnl( ( LONG ) FtpFindFirstFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ), ( WIN32_FIND_DATA * ) hb_parc( 3 ), hb_parnl( 4 ), hb_parnl( 5 ) ) );
    }


    HB_FUNC( INTERNETFINDNEXTFILE )
    {
        hb_retl( InternetFindNextFile( ( HINTERNET ) hb_parnl( 1 ), hb_parc( 2 ) ) );
    }

    #pragma ENDDUMP

     

     

     

     

     

     

    SÓ A FUNÇÃO MANDAIMG() QUE NAO FUNCIONOU, MAS NO MOMENTO NÃO VOU USAR... DÁ ERRO NA ROTINA A BAIXO

       STRUCT oWin32FindData
          MEMBER nFileAttributes  AS DWORD
          MEMBER nCreationTime    AS STRING LEN 8
          MEMBER nLastReadAccess  AS STRING LEN 8
          MEMBER nLastWriteAccess AS STRING LEN 8
          MEMBER nSizeHight       AS DWORD
          MEMBER nSizeLow         AS DWORD
          MEMBER nReserved0       AS DWORD
          MEMBER nReserved1       AS DWORD
          MEMBER cFileName        AS STRING LEN 260
          MEMBER cAltName         AS STRING LEN  14
       ENDSTRUCT

     

  24. AJUDA COM FTP

    in Programação

    Posted

            *oFtp:cwd( cPastaServ )   ESTE COMANDO NAO FUNCIONA
             *oFTP:cReply()
        

    COLOQUEI ASSIM, DIRETO oFtp:DownloadFile(  "pasta\arquivo_a_gravar", "pasta/arquivo_a_ser_baixado" )

          
            MsgRun( "AGUARDE A LIBERAÇÃO SYSRli" + CRLF + cPastaServ + CRLF + cFile, ;
                      "Download", {|| lRetorno := oFtp:DownloadFile( "ArqSYS\"+cFile, cPastaServ+cFile )} )

     

    ASSIM FUNCIONOU :D

  25. AJUDA COM FTP

    in Programação

    Posted

    estranho isso... porque na raiz do FTP ele baixa certinho, porem nas pastas não... e os comandos oFtp:cwd( cPastaServ ) retorna .T., ou seja ele conseguiu executar, e depois uso o comando oFtp:cReply() que retorna sucesso.... então entendo que estou na pasta que desejo baixar o arquivo...

     

×
×
  • Create New...