Plateforme Level Extreme
Abonnement
Profil corporatif
Produits & Services
Support
Légal
English
FtpFindFirstFile hangs
Message
Information générale
Forum:
Visual FoxPro
Catégorie:
Fonctions Windows API
Versions des environnements
Visual FoxPro:
VFP 9 SP2
OS:
Windows 7
Divers
Thread ID:
01550162
Message ID:
01550463
Vues:
80
I have a code sample using this API function; just tested -- it works. Check if it sheds any light.
#DEFINE ERROR_FTP_TRANSFER_IN_PROGRESS 12110
#DEFINE INTERNET_OPEN_TYPE_DIRECT 1
#DEFINE INTERNET_SERVICE_FTP 1
#DEFINE INTERNET_INVALID_PORT_NUMBER 0

DO declare

LOCAL oFtp

* replace Init parameters with valid host, user and password
* for a FTP server

oFtp = CREATEOBJECT("TFtpDir",;
	"ftp.???.???", "anonymous", "ano@nymous.com")

IF TYPE("oFtp") = "O"
	oFtp.ScanFiles
ENDIF
* end of main

DEFINE CLASS TFtpDir As Custom
hInternet=0
hConnect=0

PROCEDURE Init(lcHost, lcUser, lcPwd)
	THIS.hInternet = InternetOpen("VfpFtp", INTERNET_OPEN_TYPE_DIRECT, 0,0,0)
	IF THIS.hInternet <> 0
		THIS.hConnect = InternetConnect(THIS.hInternet, lcHost,;
			INTERNET_INVALID_PORT_NUMBER, lcUser, lcPwd,;
			INTERNET_SERVICE_FTP, 0, 0)
	ENDIF
	IF THIS.hConnect = 0
		RETURN .F.
	ENDIF

PROCEDURE Destroy
	InternetCloseHandle(THIS.hConnect)
	InternetCloseHandle(THIS.hInternet)

PROCEDURE ScanFiles
	THIS.EnumFiles

	WITH THIS
		DO WHILE .T.
			lnResult = .NextNode()
			DO CASE
			CASE lnResult = 0
				LOOP
			CASE lnResult = 1
				.EnumFiles
			CASE lnResult = -1
				EXIT
			ENDCASE
		ENDDO
	ENDWITH

FUNCTION NextNode
* returns next unprocessed remote folder
	SELECT csResult
	LOCATE ALL FOR Not processed

	IF FOUND()
		IF FtpSetCurrentDirectory(THIS.hConnect, ALLTRIM(csResult.fpath)) <> 1
			REPLACE processed WITH .T., accesserr WITH .T.
			RETURN 0
		ELSE
			RETURN 1
		ENDIF
	ELSE
		RETURN -1
	ENDIF

PROTECTED FUNCTION GetCurrentDir
	DECLARE INTEGER FtpGetCurrentDirectory IN wininet;
		INTEGER hFtpSession, STRING @lpszDir, INTEGER @lpdwCurDir
	LOCAL lcDirectory, lnLen, lnResult
	lcDirectory = SPACE(250)   
	lnLen = Len(lcDirectory)
	lnResult = FtpGetCurrentDirectory(THIS.hConnect, @lcDirectory, @lnLen)
RETURN Iif(lnResult=1, LEFT(lcDirectory, lnLen), "#error#")

PROCEDURE EnumFiles
#DEFINE FILE_ATTR_DIR 16
#DEFINE MAX_PATH  260
#DEFINE MAX_DWORD 0xffffffff + 1
#DEFINE FIND_DATA_SIZE 318
#DEFINE INTERNET_FLAG_NEED_FILE 16

	LOCAL lcFPath
	lcFPath = THIS.GetCurrentDir()
	
	IF Not USED("csResult")
		CREATE CURSOR csResult (;
			fpath     C(250),;
			fileattr  I,;
			filecount I,;
			dircount  I,;
			filesize  N(12),;
			isfile    L,;
			processed L,;
			accesserr L )

		INSERT INTO csResult VALUES (;
			lcFPath, 0,0,0,0, .F., .F., .F.)
	ENDIF
	? lcFPath

	LOCAL hFind, lcFBuff, lnFileattr, lcFilename, lnFileCount, lnDirCount,;
		lnFileSize, lProcessed, lIsFile

	STORE 0 TO lnDirCount, lnFileCount, lnFileSize
	lcFBuff = Repli(Chr(0), FIND_DATA_SIZE)

	hFind = FtpFindFirstFile(THIS.hConnect, lcFPath + "/*.*",;
		@lcFBuff, INTERNET_FLAG_NEED_FILE, 0)

	IF hFind <> 0
		DO WHILE .T.
			lcFilename = SUBSTR(lcFBuff, 45,MAX_PATH)
			lcFilename = Left(lcFilename, AT(Chr(0),lcFilename)-1)
			lnFileattr = buf2dword(SUBSTR(lcFBuff, 1,4))
			lnFileSize = buf2dword(SUBSTR(lcFBuff, 29,4)) * MAX_DWORD +;
				buf2dword(SUBSTR(lcFBuff, 33,4))

			IF BitAnd(lnFileattr, FILE_ATTR_DIR) = FILE_ATTR_DIR
			* for a directory
				lnDirCount = lnDirCount + 1
				lProcessed = (lcFilename==".." Or lcFilename==".")
				lIsFile = .F.
			ELSE
			* for a regular file
				lnFileCount = lnFileCount + 1
				lProcessed = .T.
				lIsFile = .T.
			ENDIF
			
			lcFullpath = lcFPath + "/" + lcFilename
			lcFullpath = STRTRAN(lcFullpath, "//", "/")

			INSERT INTO csResult VALUES (lcFullpath,;
				lnFileattr, 0, 0, lnFilesize, lIsFile, lProcessed, .F.)

			IF InternetFindNextFile(hFind, @lcFBuff) = 0
				EXIT
			ENDIF
		ENDDO
	ENDIF

	UPDATE csResult SET dircount = m.lnDirCount,;
		filecount = m.lnFileCount, filesize = m.lnFileSize,;
		processed = .T.;
	WHERE fpath == lcFPath

	= InternetCloseHandle(hFind)
ENDDEFINE

FUNCTION buf2dword(cBuffer)
RETURN Asc(SUBSTR(cBuffer, 1,1)) + ;
	BitLShift(Asc(SUBSTR(cBuffer, 2,1)),  8) +;
	BitLShift(Asc(SUBSTR(cBuffer, 3,1)), 16) +;
	BitLShift(Asc(SUBSTR(cBuffer, 4,1)), 24)

PROCEDURE declare
	DECLARE INTEGER InternetCloseHandle IN wininet INTEGER hInet

	DECLARE INTEGER InternetOpen IN wininet;
		STRING sAgent, INTEGER lAccessType, STRING sProxyName,;
		STRING sProxyBypass, STRING lFlags

    DECLARE INTEGER InternetConnect IN wininet;
		INTEGER hInternetSession, STRING sServerName, INTEGER nServerPort,;
		STRING sUsername, STRING sPassword, INTEGER lService,;
		INTEGER lFlags, INTEGER lContext

	DECLARE INTEGER FtpFindFirstFile IN wininet;
		INTEGER hFtpSession, STRING lpszSearchFile,;
		STRING @lpFindFileData, INTEGER dwFlags, INTEGER dwContent

	DECLARE INTEGER InternetFindNextFile IN wininet;
		INTEGER hFind, STRING @lpvFindData

	DECLARE INTEGER FtpSetCurrentDirectory IN wininet;
		INTEGER hFtpSession, STRING @lpszDirectory
Précédent
Suivant
Répondre
Fil
Voir

Click here to load this message in the networking platform