USUÁRIO:      SENHA:        SALVAR LOGIN ?    Adicione o VBWEB na sua lista de favoritos   Fale conosco 

 

  Dicas

  Visual Basic    (Internet)

Título da Dica:  FTP simpificado para atualização
Postada em 14/12/2007 por Edimo Aguiar      Clique aqui para enviar email para o autor  nautiluzz@gmail.com
'Devido a não encontrar um código FTP que atendesse minhas necessidades para 'atualizar meu programa decidi fazer minha própria função, creio eu, fico é a mais 'enxuta de todas as funções que encontrei ate hoje.

'No programa e co chamar a função abaixo com o caminho e nome do arquivo

'Exemplo:

'TROQUE PIPE | POR BARRA INVERTIDA
If FTP("c:|Teste.exe") Then
MsgBox ("Programa atualizado")
End
end if



'Num modulo



Const FTP_TRANSFER_TYPE_UNKNOWN = &H0
Const FTP_TRANSFER_TYPE_ASCII = &H1
Const FTP_TRANSFER_TYPE_BINARY = &H2
Const INTERNET_DEFAULT_FTP_PORT = 21
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_OPEN_TYPE_PROXY = 3
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4
Const MAX_PATH = 260
Dim TRANSFER_TYPE As Variant
Public Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Public Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftMaxAccessTime As FILETIME
    ftMaxWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type
Public Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Public Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Public Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Public Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Public Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Public Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Public Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
Public Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Boolean
Public Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Public Declare Function InternetGetMaxResponseInfo Lib "wininet.dll" Alias "InternetGetMaxResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
Public Declare Function FtpFindMinFile Lib "wininet.dll" Alias "FtpFindMinFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long

Dim hConnection As Long, hOpen As Long, sOrgPath  As String
Dim racine As String
Dim repertoire As String
Dim lErr As Long
Dim sErr As String
Dim lenBuf As Long
Dim pData As WIN32_FIND_DATA
Dim hFind As Long
Dim lRet As Long


Public Function FTP(DirFile As String) As Boolean
Const Usuario = ""  'Nome do usuario q leh foi dado quando vc criou a conta
Const Senha = ""    'senha que lhe foi dado
Const URL = ""      'exemplo ftp.xpg.com.br
Const Arquivo = ""  'exemplo teste.exe

'COLOCA EM MODO BYNARY PARA TRASNFERENCIA DE ARQUIVOS
TRANSFER_TYPE = FTP_TRANSFER_TYPE_BINARY

'abre conexão ftp
hOpen = InternetOpen("Transfert", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
ShowError

'o comando abaixo abre a conexão especificada
hConnection = InternetConnect(hOpen, URL, INTERNET_DEFAULT_FTP_PORT, Usuario, Senha, INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
ShowError

'pega parametros da conexão atual
sOrgPath = String(MAX_PATH, 0)
FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath)
ShowError

If Left(sErr, 3) = "257" Then
ShowError
racine = sOrgPath

repertoire = "/Prog" 'coloca aki o diretorio
FtpSetCurrentDirectory hConnection, repertoire 'muda para o diretorio especificado
ShowError
EnumFiles hConnection 'atualiza o diretorio = cw
'250  = cw
'faz o download do arquivo especificado
'ATENÇÂO: o Diretorio deve ter o caminho e o nome do arquivo
FtpGetFile hConnection, Arquivo, DirFile, False, 0, TRANSFER_TYPE, 0
ShowError
FTP = True
Else
'se não ouve sucesso fecha a conexão FTP
InternetCloseHandle hConnection
InternetCloseHandle hOpen
FTP = False
End If

End Function

Sub ShowError()
'------------------- Atualiza os status da conexão ---------------------------------

    InternetGetMaxResponseInfo lErr, sErr, lenBuf 'estatus da conexão
    sErr = String(lenBuf, 0)
    InternetGetMaxResponseInfo lErr, sErr, lenBuf 'atualiza a resposta
      
End Sub
Public Sub EnumFiles(hConnection As Long)
'--------------- enumera os arquivos da pasta atual no servidor do servidor------------------
    pData.cFileName = String(MAX_PATH, 0)
    hFind = FtpFindMinFile(hConnection, "*.*", pData, 0, 0)
    InternetCloseHandle hFind
End Sub


 


CyberWEB Network Ltda.    © Copyright 2000-2024   -   Todos os direitos reservados.
Powered by HostingZone - A melhor hospedagem para seu site
Topo da página