Bueno decidi ponerme a hacer un pequeño tuto de como crear un FTP, tratare de explicarlo lo mejor posible! ;D
Veamos:
Lo primero que nesecitamos es una API (libreria de windows) que nos permita hacer las conexiones,el paso de archivos, y demas comandos que en un cliente de ftp (protocolo de transferencia de archivos) estan presentes.
Ustedes diran ...... y ahora? bueno para eso estoy aqui :P
usaremos la libreria de windows llamada WININET.dll..... pero porque esa libreria y no otra diran ustedes?
bueno para los que recien empiezan WININET es un módulo que contiene las funciones relacionadas con el internet usadas por por las aplicaciones de windows.
ahora que ya sabemos que .dll usar, pasemos al desarrollo del programa!
lo primero que hago siempre que desarrollo un soft, es declarar las funciones de la libreria ( creo que todos hacen lo mismo no? jaja ;D).
para eso creamos un archivo de tipo ".bas" dentro del proyecto!
veamos que funciones nos brinda WININET!
antes que nada le ponemos un nombre no?
Attribute VB_Name = "modWinInet"
fijense como lo declaran dentro del proyecto ;)
ahora, como debemos declarar las variables, tenemos que poner qu se declaren SI O SI!!
Option Explicit
ustedes diran y?? eso para que es? ?? jaja, bueno al igual que en el lenguaje ASP, se usa esto para que las variables se puedan usar correctamente
empezemos con las variables......
Declare Function GetProcessHeap Lib "kernel32" () As Long
Declare Function HeapAlloc Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, ByVal dwBytes As Long) As Long
Declare Function HeapFree Lib "kernel32" (ByVal hHeap As Long, ByVal dwFlags As Long, lpMem As Any) As Long
Public Const HEAP_ZERO_MEMORY = &H8
Public Const HEAP_GENERATE_EXCEPTIONS = &H4
y ahora que haces ghost? vos estas loco? dijiste que usemos WININET y me mandas KERNEL32?? ???
naaa no estoy loco (puede qe un poco) , lo que hicimos ahi es inicializar la memoria a 0, dicha funcion se encuentra en esa libreria. tranquilos no me perdi! :D
Declare Sub CopyMemory1 Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Any, ByVal hpvSource As Long, ByVal cbCopy As Long)
Declare Sub CopyMemory2 Lib "kernel32" Alias "RtlMoveMemory" ( _
hpvDest As Long, hpvSource As Any, ByVal cbCopy As Long)
oootraaa veezz esa libreria??? y ahora que me vas a inventar ghost? hee? jajaa,
ahi declaramos la funcion "Copymemory", que sirve para mover un grupo de Lenght bytes desde Source hasta Destination.
si todo muy lindo y "ByVal" ??? q me decis de eso ???
ByVal se utiliza para pasar parámetros a funciones por valor en lugar de por variable. (sino te quedo claro lo lamento, no preguntes tanto :P)
Public Const MAX_PATH = 260
Public Const NO_ERROR = 0
Public Const FILE_ATTRIBUTE_READONLY = &H1
Public Const FILE_ATTRIBUTE_HIDDEN = &H2
Public Const FILE_ATTRIBUTE_SYSTEM = &H4
Public Const FILE_ATTRIBUTE_DIRECTORY = &H10
Public Const FILE_ATTRIBUTE_ARCHIVE = &H20
Public Const FILE_ATTRIBUTE_NORMAL = &H80
Public Const FILE_ATTRIBUTE_TEMPORARY = &H100
Public Const FILE_ATTRIBUTE_COMPRESSED = &H800
Public Const FILE_ATTRIBUTE_OFFLINE = &H1000
una simple igualdad si tienen dudas, preguntenme ! °|°
hora y fecha actual codificada en una estructura de 8 bytes!:
Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
verificamos que exista el arhivo,su tamaño,fecha de creacion, etc , en una palabra informacion acerca del archivo:
Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime 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
descubrimos si ha ocurrido un error verdadero o simplemente no hay mas archivos:
Public Const ERROR_NO_MORE_FILES = 18
ahora pasaremos a declarar las funciones de la tan esperada .dll WININET: :o
Public Declare Function InternetFindNextFile Lib "wininet.dll" Alias "encontrarsiguientearchivoA" _
(ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Public Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "encontrarprimerarchivoA" _
(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 FtpGetFile Lib "wininet.dll" Alias "recibirarchivoA" _
(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _
ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Public Declare Function FtpPutFile Lib "wininet.dll" Alias "enviararchivoeA" _
(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _
ByVal lpszRemoteFile As String, _
ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _
(ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
inicializamos el uso de win32 en las funciones de internet:
Public Declare Function InternetOpen Lib "wininet.dll" Alias "abiertoA" _
(ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Constante del usuario:
Public Const scUserAgent = "vb wininet"
Utilizar los ajustes del acceso del registro:
Public Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Public Const INTERNET_OPEN_TYPE_DIRECT = 1
Public Const INTERNET_OPEN_TYPE_PROXY = 3
Public Const INTERNET_INVALID_PORT_NUMBER = 0
Public Const FTP_TRANSFER_TYPE_ASCII = &H1
Public Const FTP_TRANSFER_TYPE_BINARY = &H1
Public Const INTERNET_FLAG_PASSIVE = &H8000000
Abre una sesión del HTTP para un sitio dado:
Public Declare Function InternetConnect Lib "wininet.dll" Alias "conectarA" _
(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 Const ERROR_INTERNET_EXTENDED_ERROR = 12003
Public Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" ( _
lpdwError As Long, _
ByVal lpszBuffer As String, _
lpdwBufferLength As Long) As Boolean
Número del puerto de TCP/IP en el servidor al cual nos vamos a conectar:
Public Const INTERNET_DEFAULT_FTP_PORT = 21
Public Const INTERNET_DEFAULT_GOPHER_PORT = 70
Public Const INTERNET_DEFAULT_HTTP_PORT = 80
Public Const INTERNET_DEFAULT_HTTPS_PORT = 443
Public Const INTERNET_DEFAULT_SOCKS_PORT = 1080
Public Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Public Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Public Const INTERNET_OPTION_SEND_TIMEOUT = 5
Public Const INTERNET_OPTION_USERNAME = 28
Public Const INTERNET_OPTION_PASSWORD = 29
Public Const INTERNET_OPTION_PROXY_USERNAME = 43
Public Const INTERNET_OPTION_PROXY_PASSWORD = 44
Tipo de servicio para acceder (http,ftp,etc):
Public Const INTERNET_SERVICE_FTP = 1
Public Const INTERNET_SERVICE_GOPHER = 2
Public Const INTERNET_SERVICE_HTTP = 3
Continua...........
by ghost
fuente:
http://foro.hackerselite.net/index.php?topic=371.0
;D Salu2, WarGhost
bien. ahora que estoy con la panzita llena y no tengo el peligro de pasarme con los caracteres, procedere a seguir lo que esta mañana empeze! .. .. que era? ahhh si jaja, el ftp en visual basic :-\ jajaja!
estabamos en el archivo .bas declarando las variables no es cierto? espero que digan que si, asi me doy cuenta que estan siguiendo el tema :P
bueno basta de chachara, sigamos:
Abrir una peticion al HTTP:
Public Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _
(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Traer los datos por la red, aunque esten guardados localmente:
Public Const INTERNET_FLAG_RELOAD = &H80000000
Public Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Public Const INTERNET_FLAG_MULTIPART = &H200000
Public Const GENERIC_READ = &H80000000
Public Const GENERIC_WRITE = &H40000000
Envíar la petición especificada al servidor del HTTP:
Public Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As _
String, ByVal lOptionalLength As Long) As Integer
Preguntas para la información sobre una petición del HTTP:
Public Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" _
(ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, _
ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Los valores posibles para el parámetro del lInfoLevel:
Public Const HTTP_QUERY_CONTENT_TYPE = 1
Public Const HTTP_QUERY_CONTENT_LENGTH = 5
Public Const HTTP_QUERY_EXPIRES = 10
Public Const HTTP_QUERY_LAST_MODIFIED = 11
Public Const HTTP_QUERY_PRAGMA = 17
Public Const HTTP_QUERY_VERSION = 18
Public Const HTTP_QUERY_STATUS_CODE = 19
Public Const HTTP_QUERY_STATUS_TEXT = 20
Public Const HTTP_QUERY_RAW_HEADERS = 21
Public Const HTTP_QUERY_RAW_HEADERS_CRLF = 22
Public Const HTTP_QUERY_FORWARDED = 30
Public Const HTTP_QUERY_SERVER = 37
Public Const HTTP_QUERY_USER_AGENT = 39
Public Const HTTP_QUERY_SET_COOKIE = 43
Public Const HTTP_QUERY_REQUEST_METHOD = 45
Public Const HTTP_STATUS_DENIED = 401
Public Const HTTP_STATUS_PROXY_AUTH_REQ = 407
Agregar este flag alrededor de los otros flags para conseguir el "header" de la petición:
Public Const HTTP_QUERY_FLAG_REQUEST_HEADERS = &H80000000
Public Const HTTP_QUERY_FLAG_NUMBER = &H20000000
todo muy lindo hasta ahora pero sino leemos los datos no hacemos nada jejee
Lee datos de un "handle" abierto por la función de HttpOpenRequest:
Public Declare Function InternetReadFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Public Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As String, _
ByVal lNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Public Declare Function FtpOpenFile Lib "wininet.dll" Alias _
"FtpOpenFileA" (ByVal hFtpSession As Long, _
ByVal sFileName As String, ByVal lAccess As Long, _
ByVal lFlags As Long, ByVal lContext As Long) As Long
Public Declare Function FtpDeleteFile Lib "wininet.dll" _
Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _
ByVal lpszFileName As String) As Boolean
Public Declare Function InternetSetOption Lib "wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByVal lBufferLength As Long) As Integer
Public Declare Function InternetSetOptionStr Lib "wininet.dll" Alias "InternetSetOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByVal sBuffer As String, ByVal lBufferLength As Long) As Integer
Cerrar un solo "handle" del Internet o una sub-estructura de los "handles" de Internet: ( sino quedaria abierto siempre jaja :P ..mm intrusos? naaa jaja)
Public Declare Function InternetCloseHandle Lib "wininet.dll" _
(ByVal hInet As Long) As Integer
Preguntar una opción de Internet en el "handle" especificado:
Public Declare Function InternetQueryOption Lib "wininet.dll" Alias "InternetQueryOptionA" _
(ByVal hInternet As Long, ByVal lOption As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long) As Integer
Retornar la version de Wininet.dll: ( Solo para curiosar un poco , me gusta informarme jajaja, mentira)
Public Const INTERNET_OPTION_VERSION = 40
Contiene el número de versión del DLL que contiene el Internet de Windows: (seguimos husmeando =P )
Public Type tWinInetDLLVersion
lMajorVersion As Long
lMinorVersion As Long
End Type
Agregar unos o más "headers" de la petición del HTTP al "handle" de la misma:
Public Declare Function HttpAddRequestHeaders Lib "wininet.dll" Alias "HttpAddRequestHeadersA" _
(ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, _
ByVal lModifiers As Long) As Integer
Agregar el "header" solamente si aun no existe; si no, se vuelve un error:
Public Const HTTP_ADDREQ_FLAG_ADD_IF_NEW = &H10000000
si todo muy lindo pero como ***** hago para poner el "header" que ya lo nombraste tanto?
Public Const HTTP_ADDREQ_FLAG_ADD = &H20000000
para vos que no querias que repita tanto el "header" toma:
Substituye o quita un "header". Si el valor del "header" es nulo , se quita. Si no es nulo, se substituye dicho valor:
Public Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000
bueno y aunque no lo puedan creer, termianmos con el archivo o modulo de tipo ".bas" en tu proyecto para crear un ftp, que por cierto esta bastante bueno, ;) hasta yo me sorprendi de lo que me salio jeje :o
en el proximo capitulo de esta entrega, les dare el codigo que utilize para el programa, es decir. botones,su grafica, imagenes, etc.
Resumen: lo mas importante en la programacion VB se encuentra en conocer nuestras APIS, las tan odiadas APIS De windows ;D
como veran programar no es facil, pero en visual basic es bastante sencillo. Todo incide en las .dll que nuestro maldito windows posee!
by: Ghost
fuente:
http://foro.hackerselite.net/index.php?topic=373.0
;D Salu2, WarGhost
bueno en esta parte 3 del pequeño manual que hize para vosotros, proceder con el formulario ( y es uno solo ) que compone el proyecto que estamos tratando!
Agreguen un formulario en el vb. (nombre el que sea)
lo primero a agregar es lo siguiente:
Dim bActiveSession As Boolean
Dim hOpen As Long, hConnection As Long
Dim dwType As Long
Dim EnumItemNameBag As New Collection
Dim EnumItemAttributeBag As New Collection
un poco de decoracion:
Private Sub Form_Load()
bActiveSession = False
hOpen = 0
hConnection = 0
chkPassive.Value = 1
optBin.Value = 1
dwType = FTP_TRANSFER_TYPE_BINARY
Dim imgI As ListImage
Set imgI = ImageList1.ListImages.Add(, "tuimagen", LoadPicture("tuimagen.bmp"))
Set imgI = ImageList1.ListImages.Add(, "tuimagen", LoadPicture("tuimagen.bmp"))
Set imgI = ImageList1.ListImages.Add(, "tuimagen", LoadPicture("tuimagen.bmp"))
Set imgI = ImageList1.ListImages.Add(, "tuimagen", LoadPicture("tuimagen.bmp"))
TreeView1.ImageList = ImageList1
TreeView1.Style = tvwTreelinesPictureText
EnableUI (False)
End Sub
Private Sub Form_Unload(Cancel As Integer)
cmdClosehOpen_Click
End Sub
definimos el comando InternetOpen:
Private Sub cmdInternetOpen_Click()
If Len(txtProxy.Text) <> 0 Then
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_PROXY, txtProxy.Text, vbNullString, 0)
Else
hOpen = InternetOpen(scUserAgent, INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
End If
If hOpen = 0 Then ErrorOut Err.LastDllError, "abierto"
EnableUI (True)
End Sub
definimos el comando cerrar:
rivate Sub cmdClosehOpen_Click()
If hConnection <> 0 Then InternetCloseHandle (hConnection)
If hOpen <> 0 Then InternetCloseHandle (hOpen)
hConnection = 0
hOpen = 0
If bActiveSession Then TreeView1.Nodes.Remove txtServer.Text
bActiveSession = False
ClearTextBoxAndBag
EnableUI (False)
End Sub
comando "connect" o conectar como prefieran llamarlo, para conectarnos vitehh sino no hay nada:
Private Sub cmdConnect_Click()
If Not bActiveSession And hOpen <> 0 Then
If txtServer.Text = "" Then
MsgBox "Falta el nombre del servidor!"
Exit Sub
End If
Dim nFlag As Long
If chkPassive.Value Then
nFlag = INTERNET_FLAG_PASSIVE
Else
nFlag = 0
End If
hConnection = InternetConnect(hOpen, txtServer.Text, INTERNET_INVALID_PORT_NUMBER, _
txtUser, txtPassword, INTERNET_SERVICE_FTP, nFlag, 0)
If hConnection = 0 Then
bActiveSession = False
ErrorOut Err.LastDllError, "Conectar"
Else
bActiveSession = True
EnableUI (CBool(hOpen))
FillTreeViewControl (txtServer.Text)
FtpEnumDirectory ("")
If EnumItemNameBag.Count = 0 Then Exit Sub
FillTreeViewControl (txtServer.Text)
End If
End If
End Sub
si existe un conectar , existe un desconectar no? : (todo lo que entra sale ,pero no todo lo que sale entra :D)
Private Sub cmdDisconnect_Click()
bDirEmpty = True
If hConnection <> 0 Then InternetCloseHandle hConnection
hConnection = 0
ClearBag
TreeView1.Nodes.Remove txtServer.Text
bActiveSession = False
EnableUI (True)
End Sub
por si te equivocas y queres que cuando apretes "X" boton se borre lo que escribiste: (suele pasar)
Private Sub ClearTextBoxAndBag()
txtServer.Text = ""
txtUser.Text = ""
txtPassword.Text = ""
txtProxy.Text = ""
ClearBag
End Sub
lo mismo que el anterior:
Private Sub ClearBag()
Dim Num As Integer
For Num = 1 To EnumItemNameBag.Count
EnumItemNameBag.Remove 1
Next Num
For Num = 1 To EnumItemAttributeBag.Count
EnumItemAttributeBag.Remove 1
Next Num
End Sub
Configurando el mini explorador de windows:
Private Sub FillTreeViewControl(strParentKey As String)
Dim nodX As Node
Dim strImg As String
Dim nCount As Integer, i As Integer
Dim nAttr As Integer
Dim strItem As String
If EnumItemNameBag.Count = 0 And strParentKey = txtServer.Text Then
Set nodX = TreeView1.Nodes.Add(, tvwFirst, txtServer.Text, txtServer.Text, "tuimagen")
Exit Sub
End If
nCount = EnumItemAttributeBag.Count
If nCount = 0 Then Exit Sub
For i = 1 To nCount
nAttr = EnumItemAttributeBag.Item(i)
strItem = EnumItemNameBag(i)
If nAttr = FILE_ATTRIBUTE_DIRECTORY Then
strImg = "tuimagen"
Else
strImg = "tuimagen"
End If
Set nodX = TreeView1.Nodes.Add(strParentKey, tvwChild, strParentKey & "/" & strItem, _
strParentKey & "/" & strItem, strImg)
Next
nodX.EnsureVisible
End Sub
Ahora algo muyyy importante, el comando para el boton "recibir" (cuando se pasa del server a tu pc ):
Private Sub cmdGet_Click()
Dim bRet As Boolean
Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
Dim szTempString As String
Dim nPos As Long, nTemp As Long
Dim nodX As Node
Set nodX = TreeView1.SelectedItem
If bActiveSession Then
If nodX Is Nothing Then
MsgBox "Selecciona archivo para recibir" <== Puedes cambiar estos textos a tu gusto!
Exit Sub
End If
szTempString = TreeView1.SelectedItem.Text
szFileRemote = szTempString
nPos = 0
nTemp = 0
Do
nTemp = InStr(1, szTempString, "/", vbBinaryCompare)
If nTemp = 0 Then Exit Do
szTempString = Right(szTempString, Len(szTempString) - nTemp)
nPos = nTemp + nPos
Loop
szDirRemote = Left(szFileRemote, nPos)
szFileRemote = Right(szFileRemote, Len(szFileRemote) - nPos)
szFileLocal = File1.Path
rcd szDirRemote
bRet = FtpGetFile(hConnection, szFileRemote, szFileLocal & "/" & szFileRemote, False, _
INTERNET_FLAG_RELOAD, dwType, 0)
File1.Refresh
If bRet = False Then ErrorOut Err.LastDllError, "recibirarchivo"
Else
MsgBox "Iniciar sesion"
End If
End Sub
Si hay un boton para "recibir", tiene que haber un boton "enviar" jeje :
rivate Sub cmdPut_Click()
Dim bRet As Boolean
Dim szFileRemote As String, szDirRemote As String, szFileLocal As String
Dim szTempString As String
Dim nPos As Long, nTemp As Long
Dim nodX As Node
Set nodX = TreeView1.SelectedItem
If bActiveSession Then
If nodX Is Nothing Then
MsgBox "elige un directorio para poner el archivo!" <=tambien puedes cambiarlos por lo que teguste!
Exit Sub
End If
If nodX.Image = "tuimagen" Then
MsgBox "elige un directorio para poner el archivo!"
Exit Sub
End If
If File1.FileName = "" Then
MsgBox "elige un archivo para enviar!"
Exit Sub
End If
szTempString = nodX.Text
szDirRemote = Right(szTempString, Len(szTempString) - Len(txtServer.Text))
szFileRemote = File1.FileName
szFileLocal = File1.Path & "\" & File1.FileName
If (szDirRemote = "") Then szDirRemote = "\"
rcd szDirRemote
bRet = FtpPutFile(hConnection, szFileLocal, szFileRemote, _
dwType, 0)
If bRet = False Then
ErrorOut Err.LastDllError, "enviararchivo"
Exit Sub
End If
Dim nodChild As Node, nodNextChild As Node
Set nodChild = nodX.Child
Do
If nodChild Is Nothing Then Exit Do
Set nodNextChild = nodChild.Next
TreeView1.Nodes.Remove nodChild.Index
If nodNextChild Is Nothing Then Exit Do
Set nodChild = nodNextChild
Loop
If nodX.Image = "tuimagen" Then
nodX.Image = "tuimagen"
End If
FtpEnumDirectory (nodX.Text)
FillTreeViewControl (nodX.Text)
End If
End Sub
y como hacemos para cambiar de directorio a un archivo o moverlo?:
Private Sub Dir1_Change()
File1.Path = Dir1.Path
End Sub
by: Ghost
fuente:
http://foro.hackerselite.net/index.php?topic=380.0
;D Salu2, WarGhost
Cambiar de drivers (C:,D:,E:, etc):Private Sub Drive1_Change()
On Error GoTo ErrProc
Dir1.Path = Drive1.Drive
Exit Sub
ErrProc:
Drive1.Drive = "c:"
Dir1.Path = Drive1.Drive
End SubConfiguracion de los directorios (crear, leer, etc):Private Sub rcd(pszDir As String)
If pszDir = "" Then
MsgBox "Por favor ingrese directorio" <= tambien pouedes poner tu texto aqui!
Exit Sub
Else
Dim sPathFromRoot As String
Dim bRet As Boolean
If InStr(1, pszDir, txtServer.Text) Then
sPathFromRoot = Mid(pszDir, Len(txtServer.Text) + 1, Len(pszDir) - Len(txtServer.Text))
Else
sPathFromRoot = pszDir
End If
If sPathFromRoot = "" Then sPathFromRoot = "/"
bRet = FtpSetCurrentDirectory(hConnection, sPathFromRoot)
If bRet = False Then ErrorOut Err.LastDllError, "rcd"
End If
End Sub
Para el tema de los errores: (si salta error permite terminar sesion)
Function ErrorOut(dError As Long, szCallFunction As String)
Dim dwIntError As Long, dwLength As Long
Dim strBuffer As String
If dError = ERROR_INTERNET_EXTENDED_ERROR Then
InternetGetLastResponseInfo dwIntError, vbNullString, dwLength
strBuffer = String(dwLength + 1, 0)
InternetGetLastResponseInfo dwIntError, strBuffer, dwLength
MsgBox szCallFunction & " Extd Err: " & dwIntError & " " & strBuffer
End If
If MsgBox(szCallFunction & " Err: " & dError & _
vbCrLf & "Terminar Sesion?", vbYesNo) = vbYes Then
If hConnection Then InternetCloseHandle hConnection
If hOpen Then InternetCloseHandle hOpen
hConnection = 0
hOpen = 0
If bActiveSession Then TreeView1.Nodes.Remove txtServer.Text
bActiveSession = False
ClearTextBoxAndBag
EnableUI (False)
End If
End FunctionDeterminar que botones/opciones estan disponibles sin sesion y cuales con sesion!:Private Sub EnableUI(bEnabled As Boolean)
txtServer.Enabled = bEnabled
txtUser.Enabled = bEnabled
txtPassword.Enabled = bEnabled
cmdConnect.Enabled = bEnabled And Not bActiveSession
cmdDisconnect.Enabled = bEnabled And bActiveSession
chkPassive.Enabled = bEnabled
cmdClosehOpen.Enabled = bEnabled
cmdInternetOpen.Enabled = Not bEnabled
txtProxy.Enabled = Not bEnabled
optBin.Enabled = bEnabled
optAscii.Enabled = bEnabled
cmdGet.Enabled = bEnabled And bActiveSession
cmdPut.Enabled = bEnabled And bActiveSession
End Subcomo sabemos si un directorio esta vacio, si el archivo existe, su nombre, encontrarlos, etc etc:Private Sub FtpEnumDirectory(strDirectory As String)
ClearBag
Dim hFind As Long
Dim nLastError As Long
Dim dError As Long
Dim ptr As Long
Dim pData As WIN32_FIND_DATA
If Len(strDirectory) > 0 Then rcd (strDirectory)
pData.cFileName = String(MAX_PATH, 0)
hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
nLastError = Err.LastDllError
If hFind = 0 Then
If (nLastError = ERROR_NO_MORE_FILES) Then
MsgBox "Directorio vacio!"
Else
ErrorOut nLastError, "encontrarprimerarchivo"
End If
Exit Sub
End If
dError = NO_ERROR
Dim bRet As Boolean
Dim strItemName As String
EnumItemAttributeBag.Add pData.dwFileAttributes
strItemName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
EnumItemNameBag.Add strItemName
Do
pData.cFileName = String(MAX_PATH, 0)
bRet = InternetFindNextFile(hFind, pData)
If Not bRet Then
dError = Err.LastDllError
If dError = ERROR_NO_MORE_FILES Then
Exit Do
Else
ErrorOut dError, "encontrarsiguientearchivo"
InternetCloseHandle (hFind)
Exit Sub
End If
Else
EnumItemAttributeBag.Add pData.dwFileAttributes
strItemName = Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
EnumItemNameBag.Add strItemName
End If
Loop
InternetCloseHandle (hFind)
End SubLo siguiente yo lo hize en mi cliente de ftp, si quieren lo ponen , sino no ! simple 8):es un boton para transformar a ASCII
Private Sub optAscii_Click()
dwType = FTP_TRANSFER_TYPE_ASCII
End Suby si quieren agreguen un boton para que cambie a BINARIO:Private Sub optBin_Click()
dwType = FTP_TRANSFER_TYPE_BINARY
End SubEsto si agreguenlo es importante, controla el inicio de sesion, los permisos, y otras cositas mas!:rivate Sub TreeView1_DblClick()
Dim nodX As Node
Set nodX = TreeView1.SelectedItem
If Not bActiveSession Then
MsgBox "Inicie Sesion!"
Exit Sub
End If
If nodX Is Nothing Then
MsgBox "Seleccione archivos a enumerar"
End If
If nodX.Image = "tuimagen" Then
nodX.Image = "tuimagen"
FtpEnumDirectory (nodX.Text)
FillTreeViewControl (nodX.Text)
Else
If nodX.Image = "tuimagen" Then
nodX.Image = "tuimagen"
Dim nodChild As Node, nodNextChild As Node
Set nodChild = nodX.Child
Do
Set nodNextChild = nodChild.Next
TreeView1.Nodes.Remove nodChild.Index
If nodNextChild Is Nothing Then Exit Do
Set nodChild = nodNextChild
Loop
End If
End If
End SubY aca terminamos con el unico formulario que compone nuestro tan querido cliente del FTP ! °|°
Ahora ya pueden contarles a todos qiue crearon un ftp desde 0, y que no hace falta ser un gran programador! ;D
**Nota: las imagenes que pongan, tendran que ir incluidas en el directorio del programa ya compilado para que puedan verse conrrectamente.!Espero les haya gustado mi pequeño manual. para cualquier robador de informacion que ande dando vueltas, solo le dire, quie por favor ponga la fuente ( foro.hackerselite.net) y el autor de este tuto ( ghost ) disfrute mucho creando este manual, pero mis dedos no jaja!
salu2, cualquier duda, consultenme!
Dedicado a : Sdrako ( sabes que te quiero) ,Universal SAC ( a ti tambien tontuelo ;D) y para todos nuestros usuarios y miembros del staff que llevan esta comunidad(hackerselite) hacia un futuro prospero 8)
By: Ghost
fuente:http://foro.hackerselite.net/index.php?topic=382.0
FIN
;D Salu2, WarGhost