www.FiveTechSoft.com
https://forums.fivetechsoft.com/
Code: Select all
// Original work from Alex Shaft & Peter Kohler, with mods by Byron Hopp, Rimantas Usevicius
// Modified by Luis Krause May 10, 2003, Optimized and cleaned up code
// Fixed ::Retr() & ::Dir() bugs
// added progress bar capability
// Made socket calls compatible with modified TSocket class (TSmtp, etc.)
// Added a timeout to escape from ::DoWait() to avoid hanging up the system
// Added Proxy support (needs more testing)
// October 14, 2003, Optimized ::Retr() & ::Dir() more - much faster now
// ::oTrnSocket wasn't being properly released. Fixed!
// May 8, 2003 More fixes to ::Retr???() methods
// Fixed ::Stor(), added IVAR nDelay to allow upload to work
// Entries in log file use the following codes:
// "E:" an error occurred; description follows
// "I:" info about the current operation executed
// "S:" data/action sent to the ftp server
// "R:" reply/response returned by ftp server
#include "FiveWin.ch"
#include "Directry.ch"
#ifndef __CLIPPER__
#xtranslate Memory(<n>) => // only needed with Clipper, not Harbour
#endif
#define BLOCK_SIZE 10240
#define ST_CLOSED 0
#define ST_CONNECTING 1
#define ST_CONNECTED 2
#define ST_CONNECTERR 3
#define ST_DOCWD 4
#define ST_DONECWD 5
#define ST_CWDERROR 6
#define ST_DOTYPE 7
#define ST_TYPEOK 8
#define ST_TYPEBAD 9
#define ST_DOPORT 10
#define ST_PORTOK 11
#define ST_PORTBAD 12
#define ST_DOSTOR 13
#define ST_STOROK 14
#define ST_STORBAD 15
#define ST_STORDONE 16
#define ST_DOPASV 17
#define ST_PASVOK 18
#define ST_PASVBAD 19
#define ST_DOQUIT 20
#define ST_QUITOK 21
#define ST_QUITBAD 22
#define ST_DODIR 23
#define ST_DIROK 24
#define ST_DIRBAD 25
#define ST_DIRDONE 26
#define ST_DIRREADY 126
#define ST_DOPWD 27
#define ST_DONEPWD 28
#define ST_PWDERROR 29
#define ST_DORENFROM 30
#define ST_RENFROMOK 31
#define ST_RENFROMBAD 32
#define ST_DORENTO 33
#define ST_RENTOOK 34
#define ST_RENTOBAD 35
#define ST_DODELETE 36
#define ST_DELETEOK 37
#define ST_DELETEBAD 38
#define ST_DOMKDIR 39
#define ST_MKDIROK 40
#define ST_MKDIRBAD 41
#define ST_DORETR 42
#define ST_RETROK 43
#define ST_RETRBAD 44
#define ST_RETRDONE 45
#define ST_DOABOR 46
#define ST_ABOROK 47
#define ST_ABORBAD 48
#define ST_DORMDIR 49
#define ST_RMDIROK 50
#define ST_RMDIRBAD 51
#define NTRIM(n) ( LTrim( Str( n ) ) )
/*
Function Main()
local oWin
DEFINE WINDOW oWin ;
TITLE "FTP Test"
ACTIVATE WINDOW oWin ;
ON INIT FTPTest()
return nil
Static Function FTPTest()
local oFTP
Ferase("logftp.txt")
oFTP := qFTPClient():New("10.1.1.2", 21, {|cMessage| Logfile("logftp.txt", {cMessage})},, ;
"alex", "secret")
// oFTP:bAbort := {|| oApp():oFrmmain:lFormClosed}
oFTP:lPassive := .T.
if oFTP:Connect()
MsgInfo("Connection successful to " + oFTP:cServer + CRLF + oFTP:cServerIP + CRLF + oFTP:oSocket:ClientIP())
if oFTP:Cd("/home/alex")
MSginfo("Successfully changed dir to /pub")
if oFTP:Dir()
Msginfo("Got directory listing")
//Aeval(oFTP:acDir, {| cDir, nCount | Msginfo(Str(nCount) + " " + cDir)})
oFTP:Retr("/etc/hosts", "hosts.txt")
oFTP:Del("hosts.backup")
oFTP:Stor("hosts.txt", "hosts.txt")
oFTP:Rename("hosts.txt", "hosts.backup")
oFTP:Quit()
oFTP:End()
Msginfo("Done")
else
Msginfo("Directory listing failed!")
oFTP:Quit()
oFTP:End()
endif
else
Msginfo("CD to /pub failed!")
oFTP:Quit()
oFTP:End()
endif
else
Msginfo("Connect failed!")
endif
return nil
*/
CLASS qFTPClient
#ifdef __CLIPPER__
DATA oSocket, oTrnSocket, oProxy AS OBJECT, NIL
#else
DATA oSocket, oTrnSocket, oProxy AS OBJECT INIT Nil
#endif
DATA cServer, cServerIP, cUser, cPass, cBuffer, cLastCmd, cReply, cDirBuffer, ;
cDataIP AS String INIT ""
DATA nPort, nDataPort AS NUMERIC INIT 21
DATA nStatus, nRetrHandle AS NUMERIC INIT 0
DATA bResolving, bResolved, bDump, bAbort, bStorProgress ;
AS Codeblock INIT Nil
DATA lResolved, lConnected, lClosed, lSent, lSendFile, lPassive, lSentUser ;
AS Logical Init .F.
DATA acDir, acReply AS Array
DATA nRetrFSize, nRetrBRead AS NUMERIC INIT 0
// allow a small delay when uploading (STOR command) data if there's no way to get an acknowledgment from server
DATA nDelay AS NUMERIC INIT 1
// allow 30 seconds before we bump out of ::DoWait() to avoid hanging up the system
// set to 0 if you're pretty confident this won't happen to you :o)
DATA nTimeOut AS NUMERIC INIT 30
Method New( cServer, nPort, bDump, bAbort, cUser, cPass, cProxyIP, nProxyPort, cProxyLog ) Constructor
Method End()
Method Connect()
Method OnConnect( oSocket, nWSAError )
Method OnRead( oSocket, nWSAError )
Method OnClose( oSocket, nWSAError )
Method Port( oTransSocket )
Method CD( cPath )
Method Pwd()
Method XfrType( cType )
Method Stor( cLocal, cRemote, bStorProgess, oMeter, oText )
Method StorAccept( opSocket, nWSAError, cFile, oMeter, oText ) Hidden
Method StorClose( oSocket, nWSAError, cFile, oMeter, oText ) Hidden
Method Dir( cLoc )
Method DirAccept( opSocket, nWSAError ) Hidden
Method DirRead( oSocket, nWSAError ) Hidden
Method DirClose( oSocket, nWSAError ) Hidden
Method Dump( cMsg )
Method Quit()
Method Bye() Inline ::Quit()
Method DoWait( nState ) Hidden
Method Del( cFile )
Method Rename( cFrom, cTo )
Method MkDir( cDir )
Method RmDir( cDir )
Method Retr( cRemote, cLocal, oMeter, oText )
Method RetrAccept( opSocket, nWSAError, cFile, oMeter, oText ) Hidden
Method RetrRead( oSocket, nWSAError, cFile, oMeter, oText ) Hidden
Method RetrClose( oSocket, nWSAError, cFile, oMeter, oText ) Hidden
Method Abort()
Method Pasv()
EndClass
//---------------------------------------------------------------------------------------------//
/*
Creates FTP Object
Parameters : cServer : Servername e.g. ftp.microsoft.com or 207.46.133.140
nPort : Server FTP Port. Defaults to 21
bDump : Codeblock to send all commands sent, and replies received to. Useful for logging, etc.
bAbort : Codeblock, which if eval's to True, will abort any current waiting process.
cUser : User name to log-in with
cPass : Password to log-in with
cProxyIP : Optional Proxy IP Address
nProxyPort : Optional Proxy Port No.
cProxyLog : Optional Proxy Logfile
*/
Method New( cServer, nPort, bDump, bAbort, cUser, cPass, ;
cProxyIP, nProxyPort, cProxyLog ) Class qFTPClient
Default cServer := "10.1.1.2", ;
nPort := 21, ;
bAbort := {|| .F. }, ;
cUser := "anonymous", ;
cPass := "fwuser@fivetech.com", ;
cProxyIP := "0.0.0.0", ;
nProxyPort := 0
::cServer := cServer
::nPort := nPort
::bAbort := bAbort
::bDump := bDump
::acDir := {}
::acReply := {}
::cUser := cUser
::cPass := cPass
If Val( cProxyIP ) > 0 .and. nProxyPort > 0
::oProxy := TProxy():New( nProxyPort, cProxyIP )
::oProxy:lDebug := bDump # Nil
If cProxyLog # Nil
::oProxy:cLogFile := cProxyLog
Endif
::oProxy:Activate()
Endif
Return Self
//---------------------------------------------------------------------------------------------//
/*
Internal method to give feedback to caller
*/
Method Dump( cMsg ) Class qFTPClient
If ValType( ::bDump ) == "B" .and. ValType( cMsg ) == "C"
Eval( ::bDump, cMsg )
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Logs into the FTP Server, using parameters specified with New Method.
Returns True or False based on connection success
*/
Method Connect() Class qFTPClient
Local nReturn
Local lOK := .F. // was .T. - Thanks to Roberto Chiaiese
::lResolved := .F.
::oSocket := TSocket():New(0)
If ValType( ::bResolving ) == "B"
Eval( ::bResolving, Self )
Endif
If IsAlpha( ::cServer )
::cServerIP := GetHostByName( AllTrim( ::cServer ) ) // PK Note this hogs the pc for up to 35 seconds if it cannot be resolved
Else
::cServerIP := ::cServer
Endif
If ::lResolved := Val( ::cServerIP ) > 0
::oSocket:bConnect := {|o,n| ::OnConnect( o, n ) } // lkm - see adjustment to TSocket class
::oSocket:bRead := {|o,n| ::OnRead( o, n ) }
::oSocket:bClose := {|o,n| ::OnClose( o, n ) }
::nStatus := ST_CONNECTING
Memory(-1) // cleanup memory when connecting frequently
::oSocket:Connect( ::cServerIP, ::nPort )
::DoWait( ST_CONNECTING )
lOK := ::nStatus == ST_CONNECTED
If ValType( ::bResolved ) == "B"
Eval( ::bResolved, Self )
Endif
Endif
Return lOk
//---------------------------------------------------------------------------------------------//
/*
Internal method to handle connection established.
Note it only checks for a bad connection. The rest is done by OnRead
*/
Method OnConnect( oSocket, nWSAError ) Class qFTPClient
If Val( oSocket:ClientIP() ) == 0
::lConnected := .F.
::nStatus := ST_CONNECTERR
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to handle data received by control socket
*/
Method OnRead( oSocket, nWSAError ) Class qFTPClient
Local cData := ""
Local nPos := 0, nPos1, nPos2
Local cCmd := ""
cData := oSocket:GetData()
::cBuffer += cData
Do While ( nPos := At( CRLF, ::cBuffer ) ) > 0 .and. ! Eval( ::bAbort )
AAdd( ::acReply, Left( ::cBuffer, nPos - 1 ) )
::cBuffer := SubStr( ::cBuffer, nPos + 2 )
Enddo
AEval( ::acReply, {|cReply| ::Dump( "R:" + NTRIM( ::nStatus ) + ":" + cReply ) } )
If Len( ::acReply ) > 0 .and. ;
Val( Left( ATail( ::acReply ), 3 ) ) > 0 .and. ; // i.e. skip stuff like:
SubStr( ATail( ::acReply ), 4, 1 ) == " " // "230-" or " ***"
// Full reply received
::cReply := ATail( ::acReply )
cCmd := Left( ::cReply, 3 ) // Left( ::acReply[1], 3 ) <<- caused a ton of problems!
Do Case
Case cCmd == "530" .or. ; // Login incorrect. [or other error]
::nStatus == ST_CLOSED .or. ::nStatus == ST_CONNECTERR
::nStatus := ST_DOQUIT
::lConnected := .F.
Case ::nStatus == ST_CONNECTING
Do Case
Case cCmd == "220" // Ready for user| ProFTPD 1.2.2rc1 Server (ProFTPD) [n.n.n.n]
::Dump( "S:" + NTRIM( ::nStatus ) + ":USER *************" ) // + AllTrim( ::cUser )
oSocket:SendData( "USER " + AllTrim( ::cUser ) + CRLF )
::lSentUser := .T.
Case cCmd == "331" // Password required for ::cUser.
::Dump( "S:" + NTRIM( ::nStatus ) + ":PASS *************" )
oSocket:SendData( "PASS " + AllTrim( ::cPass ) + CRLF )
Case cCmd == "230" // User ::cUser logged in.
::nStatus := ST_CONNECTED
::lConnected := .T.
Otherwise
::nStatus := ST_CONNECTERR
EndCase
Case ::nStatus == ST_DOCWD
Do Case
Case cCmd == "250" // CWD command successful.
::nStatus := ST_DONECWD
Otherwise
::nStatus := ST_CWDERROR
EndCase
Case ::nStatus == ST_DOQUIT
::lConnected := .F.
Do Case
Case cCmd == "221" .or. cCmd == "530" // Goodbye.
::nStatus := ST_QUITOK
Otherwise
::nStatus := ST_QUITBAD
EndCase
Case ::nStatus == ST_DODELETE
Do Case
Case cCmd == "250" // DEL command successful.
::nStatus := ST_DELETEOK
Otherwise
::nStatus := ST_DELETEBAD
EndCase
Case ::nStatus == ST_DOPWD
Do Case
Case cCmd == "257" // PWD command successful.
::nStatus := ST_DONEPWD
Otherwise
::nStatus := ST_PWDERROR
EndCase
Case ::nStatus == ST_DOPORT
Do Case
Case cCmd == "200" // OK
::nStatus := ST_PORTOK
Otherwise
::nStatus := ST_PORTBAD
EndCase
Case ::nStatus == ST_DOTYPE
Do Case
Case cCmd == "200" // Type set to x.
::nStatus := ST_TYPEOK
Otherwise
::nStatus := ST_TYPEBAD
EndCase
Case ::nStatus == ST_DOSTOR
Do Case
Case cCmd == "150"
::nStatus := ST_STOROK
::lSendFile := .T.
Otherwise
::nStatus := ST_STORBAD
EndCase
Case ::nStatus == ST_STOROK
Do Case
Case cCmd == "226" // OK
::nStatus := ST_STORDONE
Otherwise
::nStatus := ST_STORBAD
EndCase
Case ::nStatus == ST_DOPASV
Do Case
Case cCmd == "227" // Entering Passive Mode (n,n,n,n,m,m).
::nStatus := ST_PASVOK
Otherwise
::nStatus := ST_PASVBAD
EndCase
Case ::nStatus == ST_DODIR
Do Case
Case cCmd == "150" // Opening ASCII mode data connection for [file list]
::nStatus := ST_DIROK
Case cCmd == "125" // Data connection already open; Transfer starting.
::nStatus := ST_DIROK // some ftp servers return 125 instead of 150
Otherwise
::nStatus := ST_DIRBAD
EndCase
Case ::nStatus == ST_DIROK .or. ::nStatus == ST_DIRREADY
Do Case
Case cCmd == "226" // Transfer complete.
::nStatus := ST_DIRDONE
Otherwise
::nStatus := ST_DIRBAD
EndCase
Case ::nStatus == ST_DORETR
Do Case
Case cCmd == "150" // Opening BINARY mode data connection for cFile (nnnnn bytes).
If ::nRetrBRead == 0 // in case it jumped the gun (with small files sometimes ST_RETRDONE jumps the gun and file has already arrived!)
nPos1 := At( "(", ::cReply )
nPos2 := At( " bytes)", ::cReply )
::nRetrFSize := Val( SubStr( ::cReply, nPos1 + 1, nPos2 - nPos1 - 1 ) )
Endif
::nStatus := ST_RETROK
Case cCmd == "125" // command 150 never received, therefore we don't know the size of the file being retrieved
If ::nRetrFSize == 0 // horrible hack, but it's the only
::nRetrFSize := 1 // way around this (for the time being)
Endif
::nStatus := ST_RETROK
Otherwise // a 550 means No such file or directory
::nStatus := ST_RETRBAD
EndCase
Case ::nStatus == ST_RETROK .or. ::nStatus == ST_RETRDONE
Do Case
Case cCmd == "226" // Transfer complete.
::nStatus := ST_RETRDONE
Otherwise
::nStatus := ST_RETRBAD
EndCase
Case ::nStatus == ST_DORENFROM
Do Case
Case cCmd == "350"
::nStatus := ST_RENFROMOK
Otherwise
::nStatus := ST_RENFROMBAD
EndCase
Case ::nStatus == ST_DORENTO
Do Case
Case cCmd == "250"
::nStatus := ST_RENTOOK
Otherwise
::nStatus := ST_RENTOBAD
EndCase
Case ::nStatus == ST_DOMKDIR
Do Case
Case cCmd == "257" // OK
::nStatus := ST_MKDIROK
Otherwise
::nStatus := ST_MKDIRBAD
EndCase
Case ::nStatus == ST_DOABOR
Do Case
Case cCmd == "426" // Data connection closed, file transfer cFile aborted.
::nStatus := ST_DOABOR // stay put for successful reply from server
Case cCmd == "225" .or. cCmd == "226" // ABOR command successful.
::nStatus := ST_ABOROK
Otherwise
::nStatus := ST_ABORBAD
EndCase
Case ::nStatus == ST_DORMDIR
Do Case
Case cCmd == "250" // OK
::nStatus := ST_RMDIROK
Otherwise
::nStatus := ST_RMDIRBAD
EndCase
Otherwise
::Dump( "E:" + NTRIM( ::nStatus ) + ":Unknown exception on cmd " + ::cReply )
EndCase
Endif
::acReply := {}
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Used to get directory listing.
cLoc Parameter gives dir spec.
Returns true or false based on success
When True. Data var acDir will hold dir listing as returned by server.
*/
Method Dir( cLoc ) CLASS qFTPClient
Local lOK := .T.
Local cPort := ""
Local nPos := 0
Local cLine := ""
Local cSepChar := ""
Default cLoc := ""
::acDir := {}
::cDirBuffer := ""
::oTrnSocket := TSocket():New(0)
If ! ::lPassive
cPort := ::Port( ::oTrnSocket )
::oTrnSocket:bAccept := {|o,n| ::DirAccept( o, n ) }
::oTrnSocket:Listen()
::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )
::nStatus := ST_DOPORT
::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
::oSocket:SendData( cPort + CRLF )
::DoWait( ST_DOPORT )
lOK := ::nStatus == ST_PORTOK
Else
If ::Pasv()
If lOK := ::nDataPort > 0
::oTrnSocket:bConnect := {|o,n| ::DirAccept( o, n ) }
::oTrnSocket:bRead := {|o,n| ::DirRead( o, n ) }
::oTrnSocket:bClose := {|o,n| ::DirClose( o, n ) }
::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
Memory(-1) // cleanup memory when connecting frequently
::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
Endif
Endif
Endif
If lOK
::nStatus := ST_DODIR
::Dump( "S:" + NTRIM( ::nStatus ) + ":LIST " + AllTrim( cLoc ) )
::oSocket:SendData( "LIST " + AllTrim( cLoc ) + CRLF )
::DoWait( ST_DODIR )
::DoWait( ST_DIROK )
If lOK := ::nStatus == ST_DIRDONE
::Dump( "I:" + NTRIM( ::nStatus ) + ":Interpreting dir listing" )
cSepChar := CRLF
nPos := At( cSepChar, ::cDirBuffer )
If nPos == 0
If ! Empty( ::cDirBuffer ) // single line, just one file, THEREFORE there won't be any CRLF's!
::cDirBuffer += CRLF
Else
cSepChar := Chr(10)
Endif
nPos := At( cSepChar, ::cDirBuffer )
Endif
::acDir := {}
Do While nPos > 0 .and. ! Eval( ::bAbort )
cLine := AllTrim( Left( ::cDirBuffer, nPos - 1 ) )
::cDirBuffer := SubStr( ::cDirBuffer, nPos + Len( cSepChar ) )
cLine := AllTrim( StrTran( cLine, Chr(0), "" ) )
If( ! Empty( cLine ), AAdd( ::acDir, cLine ), Nil )
nPos := At( cSepChar, ::cDirBuffer )
SysRefresh()
Enddo
lOk := ! Empty( ::acDir )
::nStatus := ST_DIRREADY
SysWait( ::nDelay ) // allow time for server to respond
Else
::Abort()
Endif
Endif
If ::oTrnSocket # Nil
::oTrnSocket:End()
::oTrnSocket := Nil
Endif
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage directory socket
*/
Method DirAccept( opSocket, nWSAError ) Class qFTPClient
Local oSocket
If ! ::lPassive
oSocket := TSocket():Accept( opSocket:nSocket )
oSocket:bRead := {|o,n| ::DirRead( o, n ) }
oSocket:bClose := {|o,n| ::DirClose( o, n ) }
Endif
::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data connection established" )
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage directory socket
*/
Method DirRead( oSocket, nWSAError ) Class qFTPClient
Local cData := oSocket:GetData()
::cDirBuffer += cData
::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data received" )
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage directory socket
*/
Method DirClose( oSocket, nWSAError ) Class qFTPClient
::Dump( "I:" + NTRIM( ::nStatus ) + ":LIST data socket closed:" + CRLF + ::cDirBuffer )
oSocket:Close()
::nStatus := ST_DIRDONE
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to handle socket closed by server
*/
Method OnClose( oSocket, nWSAError ) Class qFTPClient
::Dump( "I:" + NTRIM( ::nStatus ) + ":Server closed down" )
::lClosed := .T.
::nStatus := ST_CLOSED
If ValType( ::oSocket ) == "O"
::oSocket:Close()
::oSocket := Nil
Endif
If ValType( ::oTrnSocket ) == "O"
::oTrnSocket:Close()
::oTrnSocket := Nil
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Kills connections
*/
Method End() Class qFTPClient
If ValType( ::oSocket ) == "O"
::oSocket:End()
::oSocket := Nil
Endif
If ValType( ::oTrnSocket ) == "O"
::oTrnSocket:End()
::oTrnSocket := Nil
Endif
If ValType( ::oProxy ) == "O"
::oProxy:End()
::oProxy := Nil
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to obtain unused port no. for data connections.
*/
METHOD Port( oTransSocket ) Class qFTPClient
Local cIP := GetIP( ::oSocket:nSocket )
Local nPort
Local cPort
Local cComplement
BindToPort( oTransSocket:nSocket, 0 ) // Get a free port from 1024 - 5000
nPort := GetPort( oTransSocket:nSocket )
cPort := AllTrim( Str( Int( nPort / 256 ), 3 ) )
cComplement := AllTrim( Str( Int( nPort % 256 ), 3 ) )
oTransSocket:nPort := nPort
Return "PORT " + StrTran( AllTrim( StrTran( cIP, ".", "," ) ) + ;
"," + cPort + "," + cComplement, " ", "" )
//---------------------------------------------------------------------------------------------//
/*
Change directory on FTP Server.
Returns True or False based on success
*/
Method CD( cPath ) Class qFTPClient
Local lOK := .T.
::nStatus := ST_DOCWD
::Dump( "S:" + NTRIM( ::nStatus ) + ":CWD " + cPath )
::oSocket:SendData( "CWD " + cPath + CRLF )
::DoWait( ST_DOCWD )
lOK := ::nStatus == ST_DONECWD
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Used internally to set Binary transfer mode for transfers
*/
Method XfrType( cType ) Class qFTPClient
Local lOK := .T.
Default cType := "I"
::nStatus := ST_DOTYPE
::Dump( "S:" + NTRIM( ::nStatus ) + ":TYPE " + cType )
::oSocket:SendData( "TYPE " + cType + CRLF )
::DoWait( ST_DOTYPE )
lOK := ::nStatus == ST_TYPEOK
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Used to store files on server.
Parameters : cLocal : Local File to send
cRemote : Location to store file remotely
bStorProgess : Codeblock to get percent complete
oMeter : Meter object progress bar [optional]
oText : Say object used with meter object to display bytes processed [optional]
Returns True or False based on success
*/
Method Stor( cLocal, cRemote, bStorProgress, oMeter, oText ) Class qFTPClient
Local cRemFile := ""
Local nPos := 0
Local cPort := ""
Local lOK := .T.
Default cRemote := "", ;
bStorProgress := {|| Nil }
::bStorProgress := bStorProgress
::lSendFile := .F.
If Empty( cRemote )
If ( nPos := RAt( "\", cLocal ) ) > 0
cRemFile := SubStr( cLocal, nPos + 1 )
Else
cRemFile := cLocal
Endif
Else
cRemFile := cRemote
Endif
If oMeter # Nil
oMeter:cargo := .T. // cancel button available while download in progress
oMeter:oWnd:AEvalWhen()
Endif
::XfrType( "I" )
::DoWait( ST_DOTYPE )
::oTrnSocket := TSocket():New(0)
If lOK := ::nStatus == ST_TYPEOK
If ! ::lPassive
cPort := ::Port( ::oTrnSocket )
::oTrnSocket:bAccept := {|o,n| ::StorAccept( o, n, cLocal, oMeter, oText ) }
::oTrnSocket:Listen()
::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )
::nStatus := ST_DOPORT
::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
::oSocket:SendData( cPort + CRLF )
::DoWait( ST_DOPORT )
lOK := ::nStatus == ST_PORTOK
Else
If ::Pasv()
If lOK := ::nDataPort > 0
::oTrnSocket:bConnect := {|o,n| ::StorAccept( o, n, cLocal, oMeter, oText ) }
::oTrnSocket:bClose := {|o,n| ::StorClose( o, n, cLocal, oMeter, oText ) }
::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
Memory(-1) // cleanup memory when connecting frequently
::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
Endif
Endif
Endif
Endif
If lOk
::nStatus := ST_DOSTOR
::Dump( "S:" + NTRIM( ::nStatus ) + ":STOR " + cRemFile )
::oSocket:SendData( "STOR " + cRemFile + CRLF )
::DoWait( ST_DOSTOR )
::DoWait( ST_STOROK )
lOK := ::nStatus == ST_STORDONE
Endif
If ::oTrnSocket # Nil
::oTrnSocket:End()
::oTrnSocket := Nil
Endif
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage file store socket
*/
Method StorAccept( opSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
Local oSocket
Local hFile := 0
Local cBuffer := ""
Local nSent := 0
Local nTotal := 0
Local lClosed := .F.
Local nNow := 0
Local nSize
If ! ::lPassive
oSocket := TSocket():Accept( opSocket:nSocket )
oSocket:bClose := {|o,n| ::StorClose( o, n, cFile, oMeter, oText ), lClosed := .T. }
Else
oSocket := opSocket
Endif
Do While ! ::lSendFile .and. ! ::lClosed .and. ! Eval( ::bAbort )
SysRefresh()
Enddo
If ::lSendFile
::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data connection established" )
nNow := Seconds()
If ( hFile := FOpen( cFile ) ) > 0
nSize := Directory( cFile )[1,F_SIZE]
::Dump( "I:" + NTRIM( ::nStatus ) + ":Uploading " + cFile + ", " + NTRIM( nSize ) + " bytes in size" )
If oMeter # Nil
oMeter:Set(0) // reset
oMeter:SetTotal( nSize ) // set bar length
Endif
cBuffer := Space( BLOCK_SIZE )
Do While .T.
nSent := FRead( hFile, @cBuffer, BLOCK_SIZE )
oSocket:SendData( Left( cBuffer, nSent ) )
nTotal += nSent
If ::nDelay > 0
SysWait( ::nDelay ) // this is trial and error... I'm using 0.5 to 1.5; default is 1.0
Endif
Eval( ::bStorProgress, Round( nTotal / nSize * 100, 2 ) ) // left for compatibility with original class
If( oMeter # Nil, oMeter:Set( nTotal ), Nil )
If( oText # Nil, oText:SetText( cFile + ": " + NTRIM( nTotal ) + " bytes uploaded..." ), Nil )
If nSent < BLOCK_SIZE .or. lClosed .or. ::nStatus == ST_STORBAD .or. Eval( ::bAbort )
Exit
Endif
If ::nDelay == 0
SysRefresh()
Endif
Enddo
FClose( hFile )
::Dump( "I:" + NTRIM( ::nStatus ) + ":" + NTRIM( nTotal ) + " bytes of file sent in " + LTrim( Str( Seconds() - nNow, 16, 2 ) ) + " seconds" )
::Dump( "I:" + NTRIM( ::nStatus ) + ":Waiting for acknowledgement" )
oSocket:Close()
Else
oSocket:Close()
oSocket:End()
::Dump( "E:" + NTRIM( ::nStatus ) + ":FOpen() failed with file " + cFile + " DOS Error #" + NTRIM( FError() ) )
Endif
SysRefresh()
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage file store socket
*/
Method StorClose( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
If oMeter # Nil
oMeter:cargo := .F. // cancel button not available anymore
oMeter:oWnd:AEvalWhen()
Endif
::lSendFile := .F.
oSocket:Close()
If ::nStatus == ST_DOABOR .or. ::nStatus == ST_ABOROK .or. ;
::nStatus == ST_ABORBAD .or. ::nStatus == ST_STORBAD
::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data aborted" )
Else
::Dump( "I:" + NTRIM( ::nStatus ) + ":STOR data completed :-)" )
::nStatus := ST_STORDONE
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Close FTP Connection
*/
Method Quit() Class qFTPClient
::nStatus := ST_DOQUIT
::Dump( "S:" + NTRIM( ::nStatus ) + ":QUIT" )
::oSocket:SendData( "QUIT" + CRLF )
::DoWait( ST_DOQUIT )
Return .T.
//---------------------------------------------------------------------------------------------//
/*
Get current directory on FTP Server
Returns True or False based on success
*/
Method Pwd() Class qFTPClient
Local cRetVal := ""
Local nPos := ""
Local cReply
::nStatus := ST_DOPWD
::Dump( "S:" + NTRIM( ::nStatus ) + ":PWD" )
::oSocket:SendData( "PWD" + CRLF )
::DoWait( ST_DOPWD )
cReply := ::cReply
nPos := At( '"', cReply )
cReply := SubStr( cReply, nPos + 1 )
nPos := At( '"', cReply )
cReply := SubStr( cReply, 1, nPos - 1 )
cRetVal := cReply
Return cRetVal
//---------------------------------------------------------------------------------------------//
/*
Delete file (cFile of server)
Will return Success True or False
*/
Method Del( cFile ) Class qFTPClient
Local lOK := .T.
Default cFile := ""
::nStatus := ST_DODELETE
If lOK := ! Empty( cFile )
::Dump( "S:" + NTRIM( ::nStatus ) + ":DELE " + cFile )
::oSocket:SendData( "DELE " + cFile + CRLF )
::DoWait( ST_DODELETE )
lOK := ::nStatus == ST_DELETEOK
Endif
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Rename file on server
Parameters : cFrom : Source file
cTo : Target file
Will return Success True or False
*/
Method Rename( cFrom, cTo ) Class qFTPClient
Local lOK := .F.
Default cFrom := "", ;
cTo := ""
If lOK := ! Empty( cFrom ) .and. ! Empty( cTo )
::nStatus := ST_DORENFROM
::Dump( "S:" + NTRIM( ::nStatus ) + ":RNFR " + cFrom )
::oSocket:SendData( "RNFR " + cFrom + CRLF )
::DoWait( ST_DORENFROM )
If lOK := ::nStatus == ST_RENFROMOK
::nStatus := ST_DORENTO
::Dump( "S:" + NTRIM( ::nStatus ) + ":RNTO " + cTo )
::oSocket:SendData( "RNTO " + cTo + CRLF )
::DoWait( ST_DORENTO )
lOK := ::nStatus == ST_RENTOOK
Endif
Endif
Return lOk
//---------------------------------------------------------------------------------------------//
/*
Create a directory
*/
Method MkDir( cDir ) Class qFTPClient
Local lOK := .T.
::nStatus := ST_DOMKDIR
::Dump( "S:" + NTRIM( ::nStatus ) + ":MKD " + cDir )
::oSocket:SendData( "MKD " + cDir + CRLF )
::DoWait( ST_DOMKDIR )
lOK := ::nStatus == ST_MKDIROK
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Remove a directory
*/
Method RmDir( cDir ) Class qFTPClient
Local lOK := .T.
::nStatus := ST_DORMDIR
::Dump( "S:" + NTRIM( ::nStatus ) + ":RMD " + cDir )
::oSocket:SendData( "RMD " + cDir + CRLF )
::DoWait( ST_DORMDIR )
lOK := ::nStatus == ST_RMDIROK
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Retrieve file from server.
Parameters : cRemote : Remote file name
cLocal : Local file name
oMeter : Meter object progress bar [optional]
oText : Say object used with meter object to display bytes processed [optional]
*/
Method Retr( cRemote, cLocal, oMeter, oText ) Class qFTPClient
Local lOK := .T.
Local cPort := ""
Local nPos := 0
Local cLine := ""
Local nNow := 0
nPos := RAt( "/", cRemote )
If nPos == 0
Default cLocal := cRemote
Else
Default cLocal := SubStr( cRemote, nPos + 1 )
Endif
If oMeter # Nil
oMeter:cargo := .T. // cancel button available while download in progress
oMeter:oWnd:AEvalWhen()
Endif
::nRetrHandle := FCreate( cLocal )
If lOK := ( ::nRetrHandle > 0 )
::XfrType( "I" )
::DoWait( ST_DOTYPE )
If lOK := ::nStatus == ST_TYPEOK
::oTrnSocket := TSocket():New(0)
If ! ::lPassive
cPort := ::Port( ::oTrnSocket )
::oTrnSocket:bAccept := {|o,n| ::RetrAccept( o, n, cRemote, oMeter, oText ) }
::oTrnSocket:Listen()
::Dump( "I:" + NTRIM( ::nStatus ) + ":Listening on port " + NTRIM( ::oTrnSocket:nPort ) )
::nStatus := ST_DOPORT
::Dump( "S:" + NTRIM( ::nStatus ) + ":" + cPort )
::oSocket:SendData( cPort + CRLF )
::DoWait( ST_DOPORT )
lOK := ::nStatus == ST_PORTOK
Else
If ::Pasv()
If lOK := ::nDataPort > 0
::oTrnSocket:bConnect := {|o,n| ::RetrAccept( o, n, cRemote, oMeter, oText ) }
::oTrnSocket:bRead := {|o,n| ::RetrRead( o, n, cRemote, oMeter, oText ) }
::oTrnSocket:bClose := {|o,n| ::RetrClose( o, n, cRemote, oMeter, oText ) }
::Dump( "I:" + NTRIM( ::nStatus ) + ":Connecting on IP:port " + ::cDataIP + ":" + NTRIM( ::nDataPort ) )
Memory(-1) // cleanup memory when connecting frequently
::oTrnSocket:Connect( ::cDataIP, ::nDataPort )
Endif
Endif
Endif
Endif
Else
::Dump( "E:" + NTRIM( ::nStatus ) + ":FCreate() failed with file " + cLocal + " DOS Error #" + NTRIM( FError() ) )
Endif
If lOK
::nRetrBRead := 0 // initialize here, not in ::OnRead()
::nStatus := ST_DORETR
::Dump( "S:" + NTRIM( ::nStatus ) + ":RETR " + cRemote )
::oSocket:SendData( "RETR " + cRemote + CRLF )
::DoWait( ST_DORETR )
Do While ::nRetrBRead < ::nRetrFSize .and. ; // stay put until file fully downloaded so it won't be truncated
! ::nRetrHandle == 0 .and. ! ::lClosed .and. ! Eval( ::bAbort ) .and. ;
! ::nStatus == ST_RETRBAD // this is case the file was not found: 550 ?????.???: No such file or directory
SysRefresh()
Enddo
::DoWait( ST_RETROK )
lOK := ::nStatus == ST_RETRDONE
SysWait( ::nDelay ) // allow time for server to respond
Endif
If ::oTrnSocket # Nil
::oTrnSocket:End()
::oTrnSocket := Nil
Endif
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage file retrieval socket
*/
Method RetrAccept( opSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
Local oSocket
If ! ::lPassive
oSocket := TSocket():Accept( opSocket:nSocket )
oSocket:bRead := {|o,n| ::RetrRead( o, n, cFile, oMeter, oText ) }
oSocket:bClose := {|o,n| ::RetrClose( o, n, cFile, oMeter, oText ) }
Endif
::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data connection established" )
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage file retrieval socket
*/
Method RetrRead( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
Local cData := oSocket:GetData()
If ::nRetrHandle > 0
If ::nRetrBRead == 0 .and. oMeter # Nil
oMeter:Set(0) // reset
oMeter:SetTotal( ::nRetrFSize ) // set bar length
Endif
FWrite( ::nRetrHandle, cData )
::nRetrBRead += Len( cData )
If( oMeter # Nil, oMeter:Set( ::nRetrBRead ), Nil )
If( oText # Nil, oText:SetText( cFile + ": " + NTRIM( ::nRetrBRead ) + " bytes downloaded..." ), Nil )
//::Dump( "I:" + NTRIM( ::nStatus ) + ":Bytes retrieved " + NTRIM( ::nRetrBRead ) + " out of " + NTRIM( ::nRetrFSize ) )
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Internal method to manage file retrieval socket
Note: When retrieving very small files, the file might already be downloaded
before ::nRetrFSize can even be initialized (cmd 150). So it's OK if it's ZERO
*/
Method RetrClose( oSocket, nWSAError, cFile, oMeter, oText ) Class qFTPClient
If oMeter # Nil
oMeter:cargo := .F. // cancel button not available anymore
oMeter:oWnd:AEvalWhen()
Endif
FClose( ::nRetrHandle )
::nRetrHandle := 0
oSocket:Close()
If ::nStatus == ST_DOABOR .or. ::nStatus == ST_ABOROK .or. ;
::nStatus == ST_ABORBAD .or. ::nStatus == ST_RETRBAD
::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data aborted" )
Else
::Dump( "I:" + NTRIM( ::nStatus ) + ":RETR data completed" + If( ::nRetrBRead < ::nRetrFSize, ;
", but file truncated by " + NTRIM( ::nRetrFSize - ::nRetrBRead ) + " bytes :-(", " :-)" ) )
// this should avoid the occasional hanging in ::DoWait()
::nStatus := If( ::nRetrFSize == 0 .or. ::nRetrBRead >= ::nRetrFSize, ST_RETRDONE, ST_RETRBAD )
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
/*
Cancel any transfer/command in progress.
Called by class if bAbort block evals to true in wait state.
*/
Method Abort() Class qFTPClient
Local lOK := .T., nStatus := ::nStatus, bAbort := ::bAbort
::bAbort := {|| .F. } // avoid nested calls to ::Abort()
::nStatus := ST_DOABOR
::Dump( "S:" + NTRIM( ::nStatus ) + ":ABOR while on " + NTRIM( nStatus ) )
::oSocket:SendData( "ABOR" + CRLF )
::DoWait( ST_DOABOR )
lOK := ::nStatus == ST_ABOROK
::bAbort := bAbort // restore abort codeblock
Return lOK
//---------------------------------------------------------------------------------------------//
/*
Switch next transfer to passive mode
*/
Method Pasv() Class qFTPClient
Local cReply := ""
Local nPos := 0
::nStatus := ST_DOPASV
::Dump( "S:" + NTRIM( ::nStatus ) + ":PASV" )
::oSocket:SendData( "PASV" + CRLF )
::DoWait( ST_DOPASV )
If ::lPassive := ::nStatus == ST_PASVOK
cReply := ::cReply
nPos := At( "(", cReply )
cReply := SubStr( cReply, nPos + 1 )
nPos := At( ")", cReply )
cReply := Left( cReply, nPos - 1 )
::cDataIP := StrToken( cReply, 1, "," ) + "."
::cDataIP += StrToken( cReply, 2, "," ) + "."
::cDataIP += StrToken( cReply, 3, "," ) + "."
::cDataIP += StrToken( cReply, 4, "," )
::nDataPort := 0
::nDataPort += 256 * Val( StrToken( cReply, 5, "," ) )
::nDataPort += Val( StrToken( cReply, 6, "," ) )
::Dump( "I:" + NTRIM( ::nStatus ) + ":Server has opened connection on port " + NTRIM( ::nDataPort ) + " - IP:" + ::cDataIP )
Endif
Return ::lPassive
//---------------------------------------------------------------------------------------------//
/*
Internal method to wait for responses from server.
*/
Method DoWait( nState ) Class qFTPClient
Local nStart := Seconds()
Do While ::nStatus == nState .and. ! ::lClosed .and. ! Eval( ::bAbort )
If ::nTimeOut > 0 .and. Seconds() - nStart > ::nTimeOut
::Dump( "E:" + NTRIM( ::nStatus ) + ":Timed out waiting for state " + NTRIM( nState ) + " to finish" )
Exit
Endif
SysRefresh()
Enddo
If nState # ST_DOABOR .and. Eval( ::bAbort )
::Abort()
Endif
Return Nil
//---------------------------------------------------------------------------------------------//
Igual me sirve.Biel EA6DD wrote:...tengo una implementacion muy basica para Telnet...
Pues precisamente necesito VT100.Biel EA6DD wrote:...si no necesitas emulacion de terminal VT100 ,VTxxx puede valerte...
No solo eso, sino que no soy el "amo" de los equipos y tienen lo que tiene y solo me dan login y pass...Marcelo Via Giglio wrote:...Claro lo complicado aqui es que tendrias que poner este servicio en cada equipo unix...
(remote shel de FW, jejeje)Code: Select all
function main()
local oShell:=TOleAuto():New("WScript.Shell")
oShell:Run("cmd /K rsh 99.99.99.99 -l usuario ifconfig -a > tmp.txt & exit",0,.F.)
MagInfo(Memoread("tmp.txt")) // Visualiza las IPs de las tarjetas de red de la maquina Unix
return nil