:: Visual Foxpro, Foxpro for DOS
Ftp класс
BOBAN
Автор

Сообщений: 625
Откуда: Солигорск
Дата регистрации: 05.07.2004
Игорь, добрый день. Вот проблема нарисовалась : после перехода Win32 на Win64 перестал работать класс отправки приема на фтп (проверял на FtpPutFile). Не спец, видимо нужно переопределить типы функций. Поможешь советом ?

*****************************************************
* 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 ''.phorum_html_encode('DaveC@Replacement-soSoftware.co.uk').''
*


**************************
* Methods:
* FTP_Init()
* FTP_Connect()
* FTP_Disconnect()
* FTP_Get_File()
* FTP_Send_File
* FTP_Set_Current_Directory()
* FTP_Delete_File
*

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


*******************
* IsDirectory
* Used by SetValue
*
Function IsDirectory(tcFileAttributes)
return BitAnd(tcFileAttributes,;
FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY

*******************
* Buf2Num
* Used by SetValue
* converts N bytes from the buffer into a numeric value
*
Function Buf2Num(lcBuffer, lnOffset, lnBytes)
Local lnResult,ii
lnResult = 0
For ii=1 TO lnBytes
lnResult = lnResult + BitLShift(Asc(SUBSTR (lcBuffer, lnOffset+ii, 1)), (ii-1)*8)
EndFor
Return lnResult

*******************
* FTime2DTime
* Used by SetValue
* COnvert FTP Time to VFP Time
*
Function FTime2DTime(lcFileTime)
local lcSystemTime,wYear, wMonth, wDay, wHour, wMinute, wSecond,;
lcStoredSet, lcDate, lcTime, 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

*****************
* 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.

**********************
Function FTP_Get_Dir(tcMask, aFile_Data)
Local nResult, hConnection, lcFindFileData, lcMask, 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

*************************
* Delete file off Host
* Return: 1 - Success
* 2 - Failure
*
Function FTP_Delete_File(tcFile_Name)
Local hConnection, cFile_Name, nResult
hConnection = This.hFTPSession
cFile_Name = tcFile_Name
nResult = FtpDeleteFile(hConnection,cFile_Name)
Return nResult

***********************************************************************
* 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, nResult, hConnection, 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

***********************************************************************
* 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, nResult, hConnection, cSource, cDestination,;
fFailIfExists , dwContext

fFailIfExists = 0 && Do not stop if target exists
dwContext = 0
hConnection = This.hFTPSession
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

******************************
* Disconnect from FTP Session
* Return: ** Unknown **
Function FTP_Disconnect()
local hFTPSession
hFTPSession = This.hFTPSession
=InternetCloseHandle(hFTPSession)
Return .T.

**************************
* Returns .T. or .F.
*
Function FTP_Connect(tcHost, tcUser, tcPassword)
Local hOpen, hFtpSession , 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)
Return .F.
EndIf

Return .T.

**********************************
Function FTP_Get_Current_Directory()
local lcDirectory , lnLen, hConnection
lcDirectory = SPACE(250)
lnLen = LEN(lcDirectory)
hConnection = This.hFTPSession
Return IIf(FtpGetCurrentDirectory (hConnection, @lcDirectory, @lnLen)=1,;
Left(lcDirectory, lnLen),"")

***********************
* 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

EndDefine
Ratings: 0 negative/0 positive
Re: Ftp класс
Igor Korolyov

Сообщений: 34580
Дата регистрации: 28.05.2002
Не надо ничего менять - АПИ то же самое. Скорее всего дело в настройках - прокси, файервола.


------------------
WBR, Igor
Ratings: 0 negative/0 positive
Re: Ftp класс
BOBAN
Автор

Сообщений: 625
Откуда: Солигорск
Дата регистрации: 05.07.2004
Эммм... промахнул , думал в личку пишу. Спасибо.
Ratings: 0 negative/0 positive


Извините, только зарегистрированные пользователи могут оставлять сообщения в этом форуме.

On-line: 24 (Гостей: 24)

© 2000-2024 Fox Club 
Яндекс.Метрика