Use wininet API to develop an FTP Client

Option explicit

Public const max_path = 260 'is defined by MFC and cannot be changed.

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 internet_flag_passive = & h8000000 'Passive Mode
Public const internet_flag_port = & o0' Active Mode

Public const internet_service_ftp = 1
Public const internet_service_gopher = 2
Public const internet_service_http = 3

Public const error_no_more_files = 18

Public const ftp_transfer_type_ascii = & H1
Public const ftp_transfer_type_binary = & H1

Public const internet_flag_reload = & h80000000
Public const internet_flag_keep_connection = & h400000
Public const internet_flag_multipart = & h200000

Type filetime
Dwlowdatetime as long
Dwhighdatetime as long
End type

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 * 16 'is defined by MFC. Do not change it.
End type

'Connection and initialization
'*************************************** **************************************** ***************************
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 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 internetclosehandle lib "wininet. dll "_
(Byval hinet as long) as integer

'Ftp directory Operation Command
'*************************************** **************************************** ***************************
Public declare function ftpgetcurrentdirectory lib "wininet. dll" alias "ftpgetcurrentdirectorya "_
(Byval hftpsession as long, lpszcurrentdirectory as string, byref lpdwcurrentdirectory as long) as Boolean

Public declare function ftpsetcurrentdirectory lib "wininet. dll" alias "ftpsetcurrentdirectorya "_
(Byval hftpsession as long, byval lpszcurrentdirectory as string) as Boolean

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

'Ftp File Operation Command
'*************************************** **************************************** ***************************
'Find a file or directory
Public declare function ftpfindfirstfile lib "wininet. dll" alias "ftpfindfirstfilea "_
(Byval hftpsession as long, byval lpszsearchfile as string ,_
Lpfindfiledata as win32_find_data, byval dwflags as long, byval dwcontent as long) as long
'Find the next file or directory
Public declare function internetfindnextfile lib "wininet. dll" alias "internetfindnextfilea "_
(Byval hfind as long, lpvfinddata as win32_find_data) as long
'Download an object
Public declare function ftpgetfile lib "wininet. dll" alias "ftpgetfilea "_
(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
'Upload a file
Public declare function ftpputfile lib "wininet. dll" alias "ftpputfilea "_
(Byval hftpsession as long, byval lpszlocalfile as string ,_
Byval lpszremotefile as string ,_
Byval dwflags as long, byval dwcontext as long) as Boolean
'Delete an object
Public declare function ftpdeletefile lib "wininet. dll "_
Alias "ftpdeletefilea" (byval hftpsession as long ,_
Byval lpszfilename as string) as Boolean
'File Renamed
Public declare function ftprenamefile lib "wininet. dll "_
Alias "ftprenamefilea" (byval hftpsession as long ,_
Byval lpszexisting as string, byval lpsznew as string) as Boolean

Public sub main ()

On Error goto ftp_err

Dim bactivesession as Boolean is used to mark whether there is an active session currently
Dim hopen as long 'is used to save the handle of the current session
Dim hconnection as long 'is used to save the handle of the active connection
Dim enumitemnamebag as new collection 'is used to save the FTP directory structure
Dim enumitemattributebag as new collection

'Start the FTP session.
Hopen = internetopen ("VB wininet", internet_open_type_direct, vbnullstring, vbnullstring, 0)
If hopen = 0 then
Errorout err. lastdllerror, "internetopen"
Goto exit_sub
End if

'Connect to the FTP server.
Dim strserver as string, struser as string, strpassword as string
Dim nflag as long
Strserver = "127.0.0.1"
Struser = "test"
Strpassword = "test"
Nflag = internet_flag_passive

Hconnection = internetconnect (hopen, strserver, internet_invalid_port_number ,_
Struser, strpassword, internet_service_ftp, nflag, 0)
If hconnection = 0 then
Errorout err. lastdllerror, "internetconnect"
Goto exit_sub
End if
Bactivesession = true

'Change to the new FTP directory on the server.
Dim strremotefolder as string
Dim Bret as Boolean
Strremotefolder = "/"
Bret = ftpsetcurrentdirectory (hconnection, strremotefolder)
If Bret = false then
Errorout err. lastdllerror, "ftpputfile"
Goto exit_sub
End if

'Check whether the directory exists
Dim pdata as win32_find_data
Dim hfind as long, nlasterror as long
Strremotefolder = "test"
Pdata. cfilename = string (max_path, 0)
Hfind = ftpfindfirstfile (hconnection, strremotefolder, pdata, 0, 0) 'find the first file or directory
If hfind = 0 then
'Not Found
Err. Clear

'Create a directory
Bret = ftpcreatedirectory (hconnection, strremotefolder)
If Bret = false then
Errorout err. lastdllerror, "ftpputfile"
Goto exit_sub
End if

Else
'Already exists
End if

'Change the Directory
Strremotefolder = "test" '. You can use both the relative and absolute directories.
Bret = ftpsetcurrentdirectory (hconnection, strremotefolder)
If Bret = false then
Errorout err. lastdllerror, "ftpputfile"
Goto exit_sub
End if

Strremotefolder = ".." 'You can use both the relative directory and the absolute directory.
Bret = ftpsetcurrentdirectory (hconnection, strremotefolder)
If Bret = false then
Errorout err. lastdllerror, "ftpputfile"
Goto exit_sub
End if

'Directory rename
'Dim strnewfolder as string
'Strnewfolder = "TTT"
'Bret = ftprenamefile (hconnection, strremotefolder, strnewfolder)
'If Bret = false then
'Errout err. lastdllerror, "ftprenamefile"
'Goto exit_sub
'End if

'Delete directory
Strremotefolder = "test"
Bret = ftpremovedirectory (hconnection, strremotefolder)
If Bret = false then
Errorout err. lastdllerror, "ftpremovedirectory"
Goto exit_sub
End if

'Get the content of the current FTP directory
Dim stritem as string
Hfind = ftpfindfirstfile (hconnection, "", pdata, 0, 0) 'find the first file or directory
Nlasterror = err. lastdllerror 'no error returned 0
If hfind = 0 then
If (nlasterror = error_no_more_files) then
Msgbox "this directory is empty! "
Else
Errorout nlasterror, "ftpfindfirstfile"
End if
Goto exit_sub
End if
Stritem = left (pdata. cfilename, instr (1, pdata. cfilename, string (1, 0 )))
Enumitemnamebag. Add stritem

'Find the next file in the FTP directory.
If hfind <> 0 then Bret = true
Do While Bret
Bret = internetfindnextfile (hfind, pdata)
If Bret then
Stritem = left (pdata. cfilename, instr (1, pdata. cfilename, string (1, 0 )))
Enumitemnamebag. Add stritem
End if
Loop

'Upload a file
Dim strfilelocal as string, strfileremote as string, dwtype as long
Dwtype = ftp_transfer_type_ascii
Strfilelocal = "D:/ftptest.rar"
Strfileremote = "ftptest.rar"
Bret = ftpputfile (hconnection, strfilelocal, strfileremote, dwtype, 0)
If Bret = false then
Errorout err. lastdllerror, "ftpputfile"
Goto exit_sub
End if

'Download an object
Strfilelocal = "C:/ftptest.rar"
Strfileremote = "ftptest.rar"
Bret = ftpgetfile (hconnection, strfileremote, strfilelocal, false ,_
Internet_flag_reload, dwtype, 0)
If Bret = false then
Errorout err. lastdllerror, "ftpgetfile"
Goto exit_sub
End if

'File Renamed
Dim strnewfile as string
Strnewfile = "ttt.rar"
Bret = ftprenamefile (hconnection, strfileremote, strnewfile)
If Bret = false then
Errorout err. lastdllerror, "ftprenamefile"
Goto exit_sub
End if

'Delete an object
Bret = ftpdeletefile (hconnection, strnewfile)
If Bret = false then
Errorout err. lastdllerror, "ftpremovedirectory"
Goto exit_sub
End if

Exit_sub:
'End the FTP session.
If hconnection <> 0 then internetclosehandle hconnection
Hconnection = 0
Bactivesession = false
Exit sub
Ftp_err:
Msgbox err. lastdllerror, vbcritical, "test FTP client by wininet. dll"
Goto exit_sub
End sub

Function errorout (derror as long, szcallfunction as string)
Dim strerrinf as string
Select case derror
Case 1, 12014
Strerrinf = "the user name or password is incorrect"
Case 1, 12007
Strerrinf = ""
Case 1, 12003
Strerrinf = "directory operation error"
Case 1, 12110
Strerrinf = "the file does not exist"
End select

Msgbox "error no.:" & STR (derror) & vbcrlf & strerrinf & vbcrlf & szcallfunction, vbcritical, "wininet FTP client"
Err. Clear

End Function

Author's blog:Http://blog.csdn.net/bobo1394/