Windows only FTP routines...

Windows specific forum
Post Reply
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Windows only FTP routines...

Post 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
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Re: Windows only FTP routines...

Post 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
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Top
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Post 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?
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
User avatar
ts-soft
Always Here
Always Here
Posts: 5756
Joined: Thu Jun 24, 2004 2:44 pm
Location: Berlin - Germany

Post 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:
PureBasic 5.73 | SpiderBasic 2.30 | Windows 10 Pro (x64) | Linux Mint 20.1 (x64)
Old bugs good, new bugs bad! Updates are evil: might fix old bugs and introduce no new ones.
Image
Top
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Post by DoubleDutch »

No problem, but you should use the standard constant-names from Wininet.h
and protected all variables in procedures!
ok, will do.
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
User avatar
Droopy
Enthusiast
Enthusiast
Posts: 658
Joined: Thu Sep 16, 2004 9:50 pm
Location: France
Contact:
Contact Droopy

Post 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.
Top
ankachen
User
User
Posts: 12
Joined: Tue Mar 27, 2007 2:52 am

Re: Windows only FTP routines...

Post 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!
Top
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Post 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
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
ankachen
User
User
Posts: 12
Joined: Tue Mar 27, 2007 2:52 am

Post 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).
Top
User avatar
DoubleDutch
Addict
Addict
Posts: 3220
Joined: Thu Aug 07, 2003 7:01 pm
Location: United Kingdom
Contact:
Contact DoubleDutch

Post by DoubleDutch »

It's opensource, have a go and post your results. ;)
https://deluxepixel.com <- My Business website
https://reportcomplete.com <- School end of term reports system
Top
Post Reply

Return to “Windows”