A programatic class (non viual designer) that incorporates FTP client access to traverse the folder structure of the remote site and send/receive files. At the head of the .prg is a small demonstration that shows how to use the class. Author: Dave Crozier Freeware 4.4K Last updated: 2012.08.17
* Programatic FTP Class Definition
* Written By: R.D.Crozier - Replacement-Software
* Date: 01/02/2012
* Description:
* A programatic FTP Class to send, receive as well as get folder layout of FTP host.
* a small demo program is included to show how it works. Please fill in your
* FTP server credentials as apropriate
*
* Support:
* Please freely use and just mention the fact that I used it in your documentation.
* any bugs, please report to DaveC@Replacement-soSoftware.co.uk
*
clear
set talk off
wait clear
oFTP = Createobject("clsFTP")
oFTP.strHost = "<<ip address>"
oFTP.strUser= "<<Login Name>>"
oFTP.strPassword = "Password"
lConnect=oFTP.FTP_Connect()
? "FTP: Connection: ", lConnect
if not lConnect
=Messagebox("Unable to connect to FTP")
return
endif
*
? "Current_Directory: ", oFTP.FTP_Get_Current_Directory()
? "Set Current Directory: ", oFTP.FTP_Set_Current_Directory("BT_OSIS/INBOUND")
* Uncomment as required to test functionality
*? "Send File: ", Iif(oFTP.FTP_Send_File(".\Test_File.txt")=1, "Success", "Failure")
*? "Get File: ", Iif(oFTP.FTP_Get_File("Test_File.txt", Sys(5)+Addbs(Curdir())+"Fred.txt")=1, "Success (1)", "Failure")
* ? "Delete File: ", oFTP.FTP_Delete_File("Test_File.txt")
*? "Delete non exist file: ", oFTP.FTP_Delete_File("XXXTest_File.txt")
*? "Set Current Directory: ", oFTP.FTP_Set_Current_Directory("INBOUND")
dimension aFile_Info[1]
? "Get Dir: ", oFTP.FTP_Get_Dir("*", @aFile_Info)
? " ", " ", "Attrib", " ", " ", " ", " ", "Size", "File", "Last Write", " ", " ", " ", " ", " ", " ", " ", " ", "Name"
for I=1 to Alen(aFile_Info,1)
? aFile_Info[I,1], aFile_Info[I,2], aFile_Info[I,3], aFile_Info[I,4], aFile_Info[I,5]
if aFile_Info[I,3]
cDestination=Sys(5)+Addbs(Curdir())+aFile_Info[I,5]
cDestination=aFile_Info[I,5]
? "Get File: ", Iif(oFTP.FTP_Get_File(aFile_Info[I,5], cDestination)=1, "Success (1): "+cDestination, "Failure")
endif
*
endfor
=oFTP.FTP_Disconnect()
wait clear
return
**************************
* Methods:
* FTP_Init()
* FTP_Connect()
* FTP_Disconnect()
* FTP_Get_File()
* FTP_Dend_File
* FTP_Set_Current_Directory()
*
define class clsFTP as relation
#DEFINE INTERNET_INVALID_PORT_NUMBER 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_SERVICE_FTP 1
#DEFINE FTP_TRANSFER_TYPE_ASCII 1
#DEFINE FTP_TRANSFER_TYPE_BINARY 2
#DEFINE INTERNET_FLAG_NEED_FILE 16
#DEFINE FILE_ATTRIBUTE_DIRECTORY 16
#DEFINE GENERIC_READ 2147483648 && &H80000000
#DEFINE GENERIC_WRITE 1073741824 && &H40000000
* lAccessType - some values
#DEFINE INTERNET_INVALID_PORT_NUMBER 0
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_OPEN_TYPE_PROXY 3
#DEFINE INTERNET_DEFAULT_FTP_PORT 21
* lFlags: only a few
#DEFINE INTERNET_FLAG_ASYNC 268435456 && &H10000000
#DEFINE INTERNET_FLAG_FROM_CACHE 16777216 && &H1000000
#DEFINE INTERNET_FLAG_OFFLINE 16777216
#DEFINE INTERNET_FLAG_CACHE_IF_NET_FAIL 65536 && &H10000
#DEFINE INTERNET_FLAG_NEED_FILE 16
#DEFINE FILE_ATTRIBUTE_DIRECTORY 16
* registry access settings
#DEFINE INTERNET_OPEN_TYPE_PRECONFIG 0
#DEFINE FTP_TRANSFER_TYPE_ASCII 1
#DEFINE FTP_TRANSFER_TYPE_BINARY 2
* type of service to access
#DEFINE INTERNET_SERVICE_FTP 1
#DEFINE INTERNET_SERVICE_GOPHER 2
#DEFINE INTERNET_SERVICE_HTTP 3
* file attributes
#DEFINE FILE_ATTRIBUTE_NORMAL 128 && 0x00000080
#DEFINE FILE_ATTRIBUTE_DIRECTORY 16
*********************
* Private Class Properties
*
strHost = ""
strUser = ""
strPassword = ""
*
hFTPSession = 0
lAscii_Transfer = .T.
* Properties used in the Get FTP Directory
Value=null
FileAttributes=null
FileSize=null
FileType=null
LastWriteTime=null
FileName=null
aFileData[1,1]=null
procedure init()
*!* #DEFINE INTERNET_INVALID_PORT_NUMBER 0
*!* #DEFINE INTERNET_OPEN_TYPE_DIRECT 1
*!* #DEFINE INTERNET_SERVICE_FTP 1
*!* #DEFINE FTP_TRANSFER_TYPE_ASCII 1
*!* #DEFINE FTP_TRANSFER_TYPE_BINARY 2
*!* #DEFINE INTERNET_FLAG_NEED_FILE 16
*!* #DEFINE FILE_ATTRIBUTE_DIRECTORY 16
*!* #DEFINE GENERIC_READ 2147483648 && &H80000000
*!* #DEFINE GENERIC_WRITE 1073741824 && &H40000000
DECLARE INTEGER InternetOpen IN wininet.dll;
STRING sAgent, INTEGER lAccessType, STRING sProxyName,;
STRING sProxyBypass, STRING lFlags
DECLARE INTEGER InternetCloseHandle IN wininet.dll INTEGER hInet
DECLARE INTEGER InternetConnect IN wininet.dll;
INTEGER hInternetSession, STRING sServerName,;
INTEGER nServerPort, STRING sUsername, STRING sPassword,;
INTEGER lService, INTEGER lFlags, INTEGER lContext
DECLARE INTEGER FtpFindFirstFile IN wininet.dll;
INTEGER hFtpSession, STRING lpszSearchFile,;
STRING @lpFindFileData, INTEGER dwFlags, INTEGER dwContent
DECLARE INTEGER InternetFindNextFile IN wininet.dll;
INTEGER hFind, STRING @lpvFindData
DECLARE INTEGER FtpGetCurrentDirectory IN wininet.dll;
INTEGER hFtpSession, STRING @lpszDirectory,;
INTEGER @lpdwCurrentDirectory
DECLARE INTEGER FtpSetCurrentDirectory IN wininet.dll;
INTEGER hFtpSession, STRING @lpszDirectory
DECLARE INTEGER FtpOpenFile IN wininet.dll;
INTEGER hFtpSession, STRING sFileName, INTEGER lAccess,;
INTEGER lFlags, INTEGER lContext
DECLARE INTEGER InternetReadFile IN wininet.dll;
INTEGER hFile, STRING @lpBuffer,;
INTEGER dwNumberOfBytesToRead, INTEGER @lpdwNumberOfBytesRead
DECLARE INTEGER FileTimeToSystemTime IN kernel32.dll;
STRING @lpFileTime, STRING @lpSystemTime
*
DECLARE INTEGER FtpGetFile IN wininet;
INTEGER hFtpSession, STRING lpszRemoteFile,;
STRING lpszNewFile, INTEGER fFailIfExists,;
INTEGER dwFlagsAndAttributes,;
INTEGER dwFlags, INTEGER dwContext
*
DECLARE INTEGER FtpPutFile IN wininet.DLL;
INTEGER hConnect,;
STRING lpszLocalFile,;
STRING lpszNewRemoteFile,;
INTEGER dwFlags,;
INTEGER dwContext
*
DECLARE INTEGER FtpDeleteFile IN wininet.DLL;
INTEGER hConnect,;
STRING lpszFileName
*
DECLARE INTEGER FtpFindFirstFile IN wininet.dll;
INTEGER hFtpSession, STRING lpszSearchFile,;
STRING @lpFindFileData, INTEGER dwFlags, INTEGER dwContent
*
DECLARE INTEGER InternetFindNextFile IN wininet.dll;
INTEGER hFind, STRING @lpvFindData
*
* Not uset at present
*!* DECLARE INTEGER InternetReadFile IN wininet.dll;
*!* INTEGER hFile, STRING @lpBuffer,;
*!* INTEGER dwNumberOfBytesToRead, INTEGER @lpdwNumberOfBytesRead
*
DECLARE INTEGER FileTimeToSystemTime IN kernel32.dll;
STRING @lpFileTime, STRING @lpSystemTime
*
return
*
endproc
*******************
* IsDirectory
* Used by SetValue
*
function IsDirectory(tcFileAttributes)
return BitAnd(tcFileAttributes,;
FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY
*
endfunc
*******************
* Buf2Num
* Used by SetValue
* converts N bytes from the buffer into a numeric value
*
Function Buf2Num(lcBuffer, lnOffset, lnBytes)
local lnResult
local ii
lnResult = 0
for ii=1 TO lnBytes
lnResult = lnResult + BitLShift(Asc(SUBSTR (lcBuffer, lnOffset+ii, 1)), (ii-1)*8)
endfor
*
return lnResult
*
endfunc
*******************
* FTime2DTime
* Used by SetValue
* COnvert FTP Time to VFP Time
*
function FTime2DTime(lcFileTime)
local lcSystemTime
local wYear, wMonth, wDay, wHour, wMinute, wSecond
local lcStoredSet
local lcDate, lcTime
local ltResult
lcSystemTime = REPLI (Chr(0), 16)
= FileTimeToSystemTime (@lcFileTime, @lcSystemTime)
wYear = This.buf2num (lcSystemTime, 0, 2)
wMonth = This.buf2num (lcSystemTime, 2, 2)
wDay = This.buf2num (lcSystemTime, 6, 2)
wHour = This.buf2num (lcSystemTime, 8, 2)
wMinute = This.buf2num (lcSystemTime, 10, 2)
wSecond = This.buf2num (lcSystemTime, 12, 2)
lcStoredSet = SET ("DATE")
set Date to MDY
lcDate = strtran(Str(wMonth,2) + "/" +;
Str(wDay,2) + "/" + Str(wYear,4), " ","0")
lcTime = Strtran(Str(wHour,2) + ":" +;
Str(wMinute,2) + ":" + Str(wSecond,2), " ","0")
ltResult = Ctot(lcDate + " " + lcTime)
set Date to &lcStoredSet
*
Return ltResult
*
endfunc
*****************
* Converts file info from FTP Format
* into VFP FOrmat and populate the appropriate
* Class Properties
*
function SetValue(tcFindFileData)
with This
.Value = SPACE(300)
.Value = tcFindFileData
.FileAttributes = This.buf2num (THIS.value, 0, 4)
.FileSize = This.buf2num (THIS.value, 32, 4)
.FileType = !This.isDirectory(This.FileAttributes)
.LastWriteTime = This.ftime2dtime (Substr(This.Value, 21, 8))
.FileName = Alltrim(Substr(This.Value, 45,250))
if at(Chr(0), This.FileName) <> 0
This.FileName = Substr(This.FileName, 1, at(Chr(0), This.FileName)-1)
endif
endwith
*
return .T.
*
endfunc
function FTP_Get_Dir(tcMask, aFile_Data)
local nResult
local hConnection
local lcFindFileData
local lcMask
local lnFound
nResult=0
* Default mask to *
lcMask=Iif(Type("tcMask")$"C", tcMask, "*")
* Set Area to put File name in
lcFindFileData = Replicate(Chr(0), 320)
hConnection=This.hFTPSession
* nResult returns back file handle of the first file!!!
nResult=FtpFindFirstFile (hConnection, lcMask,;
@lcFindFileData, INTERNET_FLAG_NEED_FILE, 0)
lnFound=0
if nResult<>0
do while .T.
* We got some files
* Extract Details from the File info
This.SetValue(lcFindFileData)
lnFound=lnFound+1
dimension aFile_Data[lnFound,5]
aFile_Data[lnFound, 1]=This.FileAttributes
aFile_Data[lnFound, 2]=This.FileSize
aFile_Data[lnFound, 3]=This.FileType
aFile_Data[lnFound, 4]=This.LastWriteTime
aFile_Data[lnFound, 5]=This.FileName
lcFindFileData = Replicate(Chr(0), 320)
if InternetFindNextFile (nResult, @lcFindFileData) <> 1
exit
endif
*
enddo
*
endif
*
return nResult
*
endfunc
*************************
* Delete file off Host
* Return: 1 - Success
* 2 - Failure
*
function FTP_Delete_File(tcFile_Name)
local hConnection
local cFile_Name
local nResult
hConnection = This.hFTPSession
cFile_Name=tcFile_Name
nResult=FtpDeleteFile(hConnection, cFile_Name)
return nResult
*
endfunc
***********************************************************************
* If Destination name is blank or doesn't exist then take source name
* Return: 1 - Success
* 0 - Failure
*
Function FTP_Send_File(tcSource, tcDestination)
local lAscii_Transfer
local nResult
local hConnection
local cSource, cDestination
hConnection = This.hFTPSession
cSource= tcSource
cDestination = Iif(Type("tcDestination")$"L" or Empty(tcDestination), ;
Justfname(tcSource), tcDestination)
lAscii_Transfer = This.lAscii_Transfer
*
IF lAscii_Transfer
nResult = FtpPutFile (hConnection, cSource,;
cDestination, FTP_TRANSFER_TYPE_ASCII, 0)
ELSE
nResult = FtpPutFile (hConnection, cSource,;
cDestination, FTP_TRANSFER_TYPE_BINARY, 0)
ENDIF
*
return nResult
*
endfunc
***********************************************************************
* If Destination name is blank or doesn't exist then take source name
* Return: 1 - Success
* 0 - Failure
*
Function FTP_Get_File(tcSource, tcDestination)
local lAscii_Transfer
local nResult
local hConnection
local cSource, cDestination
local fFailIfExists
local dwContext
fFailIfExists = 0 && Do not stop if target exists
dwContext = 0
hConnection = This.hFTPSession
cSource= tcSource
cSource = tcSource
cDestination = Iif(Type("tcDestination")$"L", cSource, tcDestination)
lAscii_Transfer = This.lAscii_Transfer
*
IF lAscii_Transfer
nResult = FtpGetFile (hConnection, tcSource, tcDestination,;
fFailIfExists, FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_ASCII,;
dwContext)
ELSE
nResult = FtpGetFile (hConnection, lpszRemoteFile, lpszNewFile,;
fFailIfExists, FILE_ATTRIBUTE_NORMAL, FTP_TRANSFER_TYPE_BINARY,;
dwContext)
ENDIF
*
return nResult
*
endfunc
******************************
* Disconnect from FTP Session
* Return: ** Unknown **
Function FTP_Disconnect()
local hFTPSession
hFTPSession = This.hFTPSession
=InternetCloseHandle(hFTPSession)
*
return .T.
*
endfunc
**************************
* Returns .T. or .F.
*
Function FTP_Connect(tcHost, tcUser, tcPassword)
local hOpen, hFtpSession
local strHost
strHost = This.strHost
strUser = This.strUser
strPwd = This.strPassword
* open access to Inet functions
hOpen = InternetOpen ("vfp", INTERNET_OPEN_TYPE_DIRECT, 0, 0, 0)
IF hOpen = 0
MESSAGEBOX( "Unable to get access to WinInet.Dll", 0, 'Open error', 5000 )
RETURN .F.
ENDIF
* connect to FTP
This.hFtpSession = InternetConnect (hOpen, strHost,;
INTERNET_INVALID_PORT_NUMBER,;
strUser, strPwd, INTERNET_SERVICE_FTP, 0, 0)
IF This.hFtpSession = 0
* close access to Inet functions and exit
= InternetCloseHandle (hOpen)
=MESSAGEBOX( "FTP " + strHost + " is not available" , 0, "Sorry", 5000 )
RETURN .F.
else
cMessage = "Connected to " + strHost + " as: [" + strUser + "]"
wait window cMessage nowait noclear
ENDIF
RETURN .T.
EndFunc
function FTP_Get_Current_Directory()
local lcDirectory
local lnLen
local hConnection
lcDirectory = SPACE(250)
lnLen = LEN(lcDirectory)
hConnection = This.hFTPSession
IF FtpGetCurrentDirectory (hConnection, @lcDirectory, @lnLen) = 1
RETURN LEFT(lcDirectory, lnLen)
ELSE
RETURN ""
ENDIF
*
EndFunc
***********************
* Set remote directory
* Return: .T. - Set OK
* .F. - Error
*
function FTP_Set_Current_Directory(tcNewDir)
local hConnection
hConnection = This.hFTPSession
return FtpSetCurrentDirectory (hConnection, @tcNewDir) = 1
endfunc
*
enddefine
No comments:
Post a Comment