PureBasic Forums - English

http://www.purebasic.com
https://www.purebasic.fr/english/

Windows only FTP routines...

https://www.purebasic.fr/english/viewtopic.php?t=25662

Page 1 of 1

Windows only FTP routines...

Posted: Wed Jan 31, 2007 3:47 am
by DoubleDutch
This is some routines I've put together to do ftp transfer on a windows system. Loads of people on the forums deserve some credit, there are too many to mention and they know who they are!

If anyone wants to help expand it into an full ftp library - with gadget callbacks, etc then please contribute.

Most standard ftp parameters are optional, defaulting to the most common. Eg, port=21

As usual with my code, there is no comments - but its fairly obvious what does what.

Code: Select all

Global ftp_hopen,ftp_hconnect

Procedure FtpCallback(handle,context,status,info,len)
	If context
    Debug("# "+Str(context)+" - "+Str(status)+" - "+Str(info)+" - "+Str(len))
  EndIf
EndProcedure

Procedure FtpOpen(server$,user$,password$,port=21,passive=0,ftpname$="FTP",gad=0)
	result=#False
	ftp_hopen=InternetOpen_(ftpname$,1,"","",0)
	If ftp_hopen
		ftp_hcallback=InternetSetStatusCallback_(ftp_hopen,@FtpCallback())
		ftp_hconnect=InternetConnect_(ftp_hopen,server$,port,user$,password$,1,passive,gad)
		If ftp_hconnect
			result=#True
		Else
			InternetCloseHandle_(ftp_hopen)
			ftp_hopen=0
		EndIf
	EndIf
	ProcedureReturn result
EndProcedure

Procedure.s FtpDir(dir$="*.*")
	result$=""
	dir$=Trim(dir$)
	If ftp_hconnect
		found=FtpFindFirstFile_(ftp_hconnect,dir$,@file.WIN32_FIND_DATA,0,0)
		If found
			Repeat
				attrib=PeekL(@file)
				writel=PeekL(@file+20)
				writeh=PeekL(@file+24)
				sizeh=PeekL(@file+28)
				sizel=PeekL(@file+32)
				filename$=PeekS(@file+44)
				result$+Trim(filename$)+"|"
				result$+RSet(Bin(attrib),16,"0")+"|"
				result$+RSet(Hex(writeh),8,"0")+RSet(Hex(writel),8,"0")+"|"
				result$+Str(sizel+1024*sizeh)+"#"
			Until Not InternetFindNextFile_(found,@file)
		EndIf
	EndIf
	ProcedureReturn result$
EndProcedure

Procedure FtpSetPath(dir$="")
	result=#False
	If ftp_hconnect
		result=FtpSetCurrentDirectory_(ftp_hconnect,dir$)
	EndIf
	ProcedureReturn result
EndProcedure

Procedure FtpCreateDirectory(dir$)
	result=#False
	If ftp_hconnect
		dir$=Trim(dir$)
		If dir$<>""
			result=FtpCreateDirectory_(ftp_hconnect,dir$)
		EndIf
	EndIf
	ProcedureReturn result
EndProcedure

Procedure FtpDeleteDirectory(dir$)
	result=#False
	If ftp_hconnect
		dir$=Trim(dir$)
		If dir$<>""
			result=FtpRemoveDirectory_(ftp_hconnect,dir$)
		EndIf
	EndIf
	ProcedureReturn result
EndProcedure

Procedure FtpDeleteFile(file$)
	result=#False
	If ftp_hconnect
		file$=Trim(file$)
		If file$<>""
			result=FtpDeleteFile_(ftp_hconnect,file$)
		EndIf
	EndIf
	ProcedureReturn result
EndProcedure

Procedure FtpRenameFile(source$,dest$)
	result=#False
	If ftp_hconnect
		source$=Trim(source$)
		dest$=Trim(dest$)
		If source$<>"" And dest$<>"" 
			result=FtpRenameFile_(ftp_hconnect,source$,dest$)
		EndIf
	EndIf
	ProcedureReturn result
EndProcedure

#ftp_unknown=0
#ftp_ascii=1
#ftp_binary=2
Procedure FtpDownload(source$,dest$="",mode=#ftp_binary,gad=0)
	result=#False
	If ftp_hconnect
		source$=Trim(source$)
		If source$<>""
			If dest$=""
				dest$=source$
			EndIf
  		result=FtpGetFile_(ftp_hconnect,source$,dest$,0,0,mode,gad)
  	EndIf
  EndIf
 	ProcedureReturn result
EndProcedure

Procedure FtpUpload(source$,dest$="",mode=#ftp_binary,gad=0)
	result=#False
	If ftp_hconnect
		source$=Trim(source$)
		If source$<>""
			If dest$=""
				dest$=source$
			EndIf
  		result=FtpPutFile_(ftp_hconnect,source$,dest$,mode,gad)
  	EndIf
  EndIf
 	ProcedureReturn result
EndProcedure

Procedure FtpClose()
	If ftp_hconnect
		InternetCloseHandle_(ftp_hconnect)
		InternetCloseHandle_(ftp_hopen)
	EndIf
EndProcedure

Re: Windows only FTP routines...

Posted: Wed Jan 31, 2007 12:06 pm
by ts-soft
DoubleDutch wrote: If anyone wants to help expand it

Code: Select all

Procedure FtpRead2Mem(File.s, mode.l = #ftp_binary)
  Protected hFile.l, Mem.l, hSize.l, hSizeError.l, lpdwNumberOfBytesRead.l
  hFile = FtpOpenFile_(ftp_hconnect, @File, #GENERIC_READ, mode, 0)
  hSize = FtpGetFileSize_(hFile, @hSizeError)
  If hSize > 0
    Mem = AllocateMemory(hSize)
    If Mem <> 0
      If InternetReadFile_(hFile, Mem, hSize, @lpdwNumberOfBytesRead)
        ProcedureReturn Mem
      Else
        FreeMemory(Mem)
        ProcedureReturn -1
      EndIf
    EndIf
  EndIf
EndProcedure

Posted: Wed Jan 31, 2007 1:13 pm
by DoubleDutch
ts-soft: nice :)

Eventually (after a few more 'features' have been submitted) you may like to add it to PB-OSL?

Here is an slight update to FtpDir, it allows the programmer to specify the parameter end marker and the line end marker...

Code: Select all

Procedure.s FtpDir(dir$="*.*",paraend$="|",lineend$="#")
	result$=""
	dir$=Trim(dir$)
	If ftp_hconnect
		found=FtpFindFirstFile_(ftp_hconnect,dir$,@file.WIN32_FIND_DATA,0,0)
		If found
			Repeat
				attrib=PeekL(@file)
				writel=PeekL(@file+20)
				writeh=PeekL(@file+24)
				sizeh=PeekL(@file+28)
				sizel=PeekL(@file+32)
				filename$=PeekS(@file+44)
				result$+Trim(filename$)+paraend$
				result$+RSet(Bin(attrib),16,"0")+paraend$
				result$+RSet(Hex(writeh),8,"0")+RSet(Hex(writel),8,"0")+paraend$
				result$+Str(sizel+1024*sizeh)+lineend$
			Until Not InternetFindNextFile_(found,@file)
		EndIf
	EndIf
	ProcedureReturn result$
EndProcedure
What would be good is a method like pb_any of making the routines multi-entry thread safe (so you can have multiple simultaneous ftp connections running independently using threads). This may mean changing the calls to put a 'handle' as the first parameter? Anyone have any ideas?

Is there any way for a thread to find out its own thread id?

Posted: Wed Jan 31, 2007 2:07 pm
by ts-soft
DoubleDutch wrote:Eventually (after a few more 'features' have been submitted) you may like to add it to PB-OSL?
No problem, but you should use the standard constant-names from Wininet.h
and protected all variables in procedures!

Code: Select all

Enumeration 0
  #INTERNET_OPEN_TYPE_PRECONFIG
  #INTERNET_OPEN_TYPE_DIRECT
  #INTERNET_OPEN_TYPE_PROXY = 3
  #INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY
EndEnumeration

Enumeration 1
  #INTERNET_SERVICE_FTP
  #INTERNET_SERVICE_GOPHER
  #INTERNET_SERVICE_HTTP
EndEnumeration

Enumeration 0
  #FTP_TRANSFER_TYPE_UNKNOWN
  #FTP_TRANSFER_TYPE_ASCII
  #FTP_TRANSFER_TYPE_BINARY
  #FTP_TRANSFER_TYPE_MASK  = (#FTP_TRANSFER_TYPE_ASCII|#FTP_TRANSFER_TYPE_BINARY)
EndEnumeration

#INTERNET_FLAG_RELOAD = $80000000
I work in a private project with ftp, so i hope, i can more help you on this project :wink:

Posted: Wed Jan 31, 2007 2:25 pm
by DoubleDutch
No problem, but you should use the standard constant-names from Wininet.h
and protected all variables in procedures!
ok, will do.

Posted: Mon Mar 19, 2007 5:03 pm
by Droopy
For the DoubleDutch code, the CallBack doens't works for me.
I need this callback to set a progressBar when downloading a file thru ftp.

Re: Windows only FTP routines...

Posted: Thu Mar 29, 2007 9:56 am
by ankachen

Code: Select all

ftp_hcallback=InternetSetStatusCallback_(ftp_hopen,@FtpCallback())

Code: Select all

Procedure FtpCallback(Handle,context,Status,info,len) 
  If context 
    Debug("# "+Str(context)+" - "+Str(Status)+" - "+Str(info)+" - "+Str(len)) 
  EndIf 
EndProcedure


Anyone can explain the code above? I don't understand how to use the

"FtpCallback" function? Appreciated!

Posted: Thu Mar 29, 2007 10:33 am
by DoubleDutch
It's supposed to be updated by the system at regular intervals - so you can display current download/upload status

You could relate the numbers to a progress bar?

-Anthony

Posted: Mon Apr 02, 2007 4:04 am
by ankachen
DoubleDutch wrote:ts-soft: nice :)

Code: Select all

Procedure.s FtpDir(dir$="*.*",paraend$="|",lineend$="#")
	result$=""
	dir$=Trim(dir$)
	If ftp_hconnect
		found=FtpFindFirstFile_(ftp_hconnect,dir$,@file.WIN32_FIND_DATA,0,0)
		If found
			Repeat
				attrib=PeekL(@file)
				writel=PeekL(@file+20)
				writeh=PeekL(@file+24)
				sizeh=PeekL(@file+28)
				sizel=PeekL(@file+32)
				filename$=PeekS(@file+44)
				result$+Trim(filename$)+paraend$
				result$+RSet(Bin(attrib),16,"0")+paraend$
				result$+RSet(Hex(writeh),8,"0")+RSet(Hex(writel),8,"0")+paraend$
				result$+Str(sizel+1024*sizeh)+lineend$
			Until Not InternetFindNextFile_(found,@file)
		EndIf
	EndIf
	ProcedureReturn result$
EndProcedure
In the "FTPDir" function. How to change it with a "Recursive Function".

I wonna find all files in FTP(including subdirectory).

Posted: Mon Apr 02, 2007 9:53 am
by DoubleDutch
It's opensource, have a go and post your results. ;)
All times are UTC+01:00
Page 1 of 1

Powered by phpBB® Forum Software © phpBB Limited