/*
 * Xailer source code:
 *
 * Ftp.prg
 * Manejo del protocolo FTP
 *
 * Copyright 2003, 2007 Jose Lalin
 * Copyright 2003, 2007 Xailer.com
 * All rights reserved
 *
 */

#include "Xailer.ch"
#include "WinNT.api"
#include "WinINet.api"


//--------------------------------------------------------------------------

CLASS XFTP FROM TInternet

PUBLISHED:
   PROPERTY cServer              INIT ""
   PROPERTY nPort                INIT inetFTP
   PROPERTY nBuffer              INIT 32 * 1024 // 32 Kb buffer

   PROPERTY nTransferType        INIT ftpBINARY ;
                                 VALUES ftpBINARY, ftpASCII

   PROPERTY lPassive             INIT .F. WRITE INLINE ::FlPassive := ::SetFlag( INTERNET_FLAG_PASSIVE, Value )

   EVENT OnCommand( oSender, hFile )   // --> Nil
   EVENT OnDirectory( oSender, cFile ) // --> Nil | lContinue
   EVENT OnError( oSender, nError, cError ) // --> Nil
   EVENT OnStart( oSender, nTotalSize ) // --> Nil
   EVENT OnProgress( oSender, nBytes ) // --> Nil
   EVENT OnComplete( oSender ) // --> Nil


PUBLIC:
   PROPERTY nService             INIT inetSERVICEFTP

   METHOD Command( cCmd, lResponse, nFlags ) // --> lSuccess

   METHOD GetFile( cFtpFile, cLocalFile, lFail, nAttributes ) // --> lSuccess
   METHOD GetFileSize( hFile ) // --> nFileSize
   METHOD PutFile( cFile, cFtpFile ) // --> lSuccess

   METHOD OpenFile( cFile, nAccess ) // --> hFile
   METHOD CloseFile( hSession ) // --> lSuccess

   METHOD OpenFileRead( cFile )     INLINE ::OpenFile( cFile, GENERIC_READ ) // --> hFile
   METHOD OpenFileWrite( cFile )    INLINE ::OpenFile( cFile, GENERIC_WRITE ) // --> hFile

   METHOD RenameFile( cFile, cNewFile ) // --> lSuccess
   METHOD DeleteFile( cFile ) // --> lSuccess
   METHOD UploadFile( cLocalFile, cRemoteFile ) // --> lSuccess
   METHOD DownloadFile( cRemoteFile, cLocalFile ) // --> lSuccess

   METHOD CreateDirectory( cDirectory ) // --> lSuccess
   METHOD RemoveDirectory( cDirectory ) // --> lSuccess

   METHOD GetCurrentDirectory() // --> cDirectory
   METHOD SetCurrentDirectory( cDirectory ) // --> lSuccess

   METHOD Directory( cMask ) // --> aDirectory


RESERVED:
   METHOD NewError( nError, cError )

ENDCLASS

//--------------------------------------------------------------------------

METHOD NewError( nError, cError )  CLASS XFTP

   DEFAULT nError TO ::nLastError
   DEFAULT cError TO ::GetErrorDescription()

   ::OnError( nError, cError )

RETURN NIL

//--------------------------------------------------------------------------

METHOD UploadFile( cLocalFile, cRemoteFile ) CLASS XFTP

   LOCAL hFile, hRemote
   LOCAL cBuffer := Space( ::nBuffer )
   LOCAL nBytes
   LOCAL lSuccess := .F.

   IF ::Open()
      IF ::Connect( ::cServer )
         IF ( hFile := FOpen( cLocalFile ) ) > -1
            ::OnStart( hb_FSize( cLocalFile ) )
            IF ( hRemote := ::OpenFileWrite( cRemoteFile ) ) > 0
               WHILE ( nBytes := FRead( hFile, @cBuffer, ::nBuffer ) ) > 0
                  ::WriteFile( hRemote, cBuffer, nBytes )
                  ::OnProgress( nBytes )
               END
            ELSE
               ::NewError()
            ENDIF
            ::CloseFile( hRemote )
            FClose( hFile )
            ::OnComplete()
            lSuccess := .T.
         ELSE
            ::NewError( FError(), "FOpen Error" )
         ENDIF
      ELSE
         ::NewError()
      ENDIF
      ::Close()
   ELSE
      ::NewError()
   ENDIF

RETURN lSuccess

//--------------------------------------------------------------------------

METHOD DownloadFile( cRemoteFile, cLocalFile ) CLASS XFTP

   LOCAL hFile, hRemote
   LOCAL cBuffer := Space( ::nBuffer )
   LOCAL lSuccess := .F.

   IF ::Open()
      IF ::Connect( ::cServer )
         IF ( hRemote := ::OpenFile( cRemoteFile ) ) > 0
            IF ( hFile := FCreate( cLocalFile ) ) > 0
               ::OnStart( ::GetFileSize( hRemote ) )
               WHILE ::ReadFile( hRemote, @cBuffer, ::nBuffer )
                  FWrite( hFile, cBuffer )
                  ::OnProgress( Len( cBuffer ) )
               END
               ::CloseFile( hRemote )
               FClose( hFile )
               ::OnComplete()
               lSuccess := .T.
            ELSE
               ::NewError( FError(), "FCreate Error" )
            ENDIF
         ELSE
            ::NewError()
         ENDIF
      ELSE
         ::NewError()
      ENDIF
      ::Close()
   ELSE
      ::NewError()
   ENDIF

RETURN lSuccess

//--------------------------------------------------------------------------

#pragma BEGINDUMP

#include <windows.h>
#include <wininet.h>
#include <xailer.h>

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_COMMAND )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPCTSTR lpCmd = hb_parc( 1 );
   BOOL bResponse = HB_ISLOG( 2 ) ? hb_parl( 2 ) : TRUE;
   DWORD dwFlags = HB_ISNUM( 3 ) ? hb_parnl( 3 ) : XA_ObjGetNL( Self, "nTransferType" );
   HINTERNET hFile;
   BOOL bSuccess;

   bSuccess = FtpCommand( hSession, bResponse, dwFlags, lpCmd, 0, &hFile );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( bSuccess )
      XA_ObjSendNL( Self, "OnCommand", (LONG) hFile );
   else
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_GETFILE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   DWORD dwFlags = XA_ObjGetNL( Self, "nTransferType" );
   LPCTSTR lpRemote = hb_parc( 1 );
   LPCTSTR lpLocal = hb_parc( 2 );
   BOOL bFail = HB_ISLOG( 3 ) ? hb_parl( 3 ) : FALSE;
   DWORD dwAttributes = HB_ISNUM( 4 ) ? hb_parnl( 4 ) : FILE_ATTRIBUTE_NORMAL;
   BOOL bSuccess;

   bSuccess = FtpGetFile( hSession, lpRemote, lpLocal, bFail, dwAttributes,
                          dwFlags, 0 );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_GETFILESIZE )
{
   HINTERNET hFile = (HINTERNET) hb_parnl( 1 );
   DWORD dwLoSize;
   DWORD dwHiSize = 0;

   dwLoSize = FtpGetFileSize( hFile, &dwHiSize );

   hb_retnll( ( ( (HB_ULONGLONG) dwHiSize ) << 32 ) + dwLoSize );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_PUTFILE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   DWORD dwFlags = XA_ObjGetNL( Self, "nTransferType" );
   LPCTSTR lpLocal = hb_parc( 1 );
   LPCTSTR lpRemote = hb_parc( 2 );
   BOOL bSuccess;

   bSuccess = FtpPutFile( hSession, lpLocal, lpRemote, dwFlags, 0 );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_OPENFILE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   DWORD dwFlags = XA_ObjGetNL( Self, "nTransferType" );
   LPCTSTR lpFile = hb_parc( 1 );
   DWORD dwAccess = HB_ISNUM( 2 ) ? (DWORD) hb_parnl( 2 ) : GENERIC_READ;
   HINTERNET hFile;

   dwFlags |= INTERNET_FLAG_RELOAD | INTERNET_FLAG_RESYNCHRONIZE;

   hFile = FtpOpenFile( hSession, lpFile, dwAccess, dwFlags, 0 );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !hFile )
      XA_ObjSend( Self, "NewError" );

   hb_retnl( (LONG) hFile );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_CLOSEFILE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   BOOL bSuccess = FALSE;

   if( HB_ISNUM( 1 ) )
   {
      HINTERNET hFile = (HINTERNET) hb_parnl( 1 );

      bSuccess = InternetCloseHandle( hFile );
      XA_ObjSendNL( Self, "_nLastError", GetLastError() );
   }

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_RENAMEFILE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPCTSTR lpSrc = hb_parc( 1 );
   LPCTSTR lpDest = hb_parc( 2 );
   BOOL bSuccess;

   bSuccess = FtpRenameFile( hSession, lpSrc, lpDest );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_DELETEFILE )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPCTSTR lpFile = hb_parc( 1 );
   BOOL bSuccess;

   bSuccess = FtpDeleteFile( hSession, lpFile );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_CREATEDIRECTORY )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPCTSTR lpDir = hb_parc( 1 );
   BOOL bSuccess;

   bSuccess = FtpCreateDirectory( hSession, lpDir );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_REMOVEDIRECTORY )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPCTSTR lpDir = hb_parc( 1 );
   BOOL bSuccess;

   bSuccess = FtpRemoveDirectory( hSession, lpDir );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_GETCURRENTDIRECTORY )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPTSTR lpDir = (LPTSTR) hb_xgrab( MAX_PATH );
   DWORD dwLen = MAX_PATH;
   BOOL bSuccess;

   bSuccess = FtpGetCurrentDirectory( hSession, lpDir, &dwLen );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( bSuccess )
      hb_retc( (char *) lpDir );
   else
      {
      hb_retc( "" );
      XA_ObjSend( Self, "NewError" );
      }

   hb_xfree( lpDir );
}

//--------------------------------------------------------------------------

HB_FUNC_STATIC( XFTP_SETCURRENTDIRECTORY )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPCTSTR lpDir = hb_parc( 1 );
   BOOL bSuccess;

   bSuccess = FtpSetCurrentDirectory( hSession, lpDir );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( !bSuccess )
      XA_ObjSend( Self, "NewError" );

   hb_retl( bSuccess );
}

//--------------------------------------------------------------------------

#if ( __GNUC__ >= 7 )
   #pragma GCC diagnostic ignored "-Wformat-overflow"
#endif

HB_FUNC_STATIC( XFTP_DIRECTORY )
{
   PHB_ITEM Self = hb_stackSelfItem();
   HINTERNET hSession = (HINTERNET) XA_ObjGetNL( Self, "hSession" );
   LPCSTR szMask = hb_parc( 1 );
   WIN32_FIND_DATA wfd;
   HINTERNET hFile;
   PHB_ITEM pArray = hb_itemArrayNew( 0 );

   memset( &wfd, 0, sizeof( WIN32_FIND_DATA ) );
   hFile = FtpFindFirstFile( hSession, szMask, &wfd, INTERNET_FLAG_RELOAD | INTERNET_FLAG_NO_CACHE_WRITE | INTERNET_FLAG_HYPERLINK | INTERNET_FLAG_NEED_FILE | INTERNET_FLAG_RESYNCHRONIZE, 0 );
   XA_ObjSendNL( Self, "_nLastError", GetLastError() );

   if( hFile != NULL )
   {
      BOOL bNext = TRUE;

      while( bNext )
      {
         PHB_ITEM pSub = hb_itemArrayNew( 0 );
         PHB_ITEM pItem = hb_itemNew( NULL );
         PHB_ITEM pAttr = hb_itemNew( NULL );
         SYSTEMTIME st;
         char szAttr[5] = "";
         BOOL bContinue = TRUE;

         hb_arrayAdd( pSub, hb_itemPutC( pItem, wfd.cFileName ) );
         hb_arrayAdd( pSub, hb_itemPutNL( pItem, ( wfd.nFileSizeHigh * MAXDWORD ) + wfd.nFileSizeLow ) );

         szAttr[ 0 ] = wfd.dwFileAttributes & FILE_ATTRIBUTE_NORMAL ? 'A' : ' ';
         szAttr[ 1 ] = wfd.dwFileAttributes & FILE_ATTRIBUTE_DIRECTORY ? 'D' : ' ';
         szAttr[ 2 ] = wfd.dwFileAttributes & FILE_ATTRIBUTE_READONLY ? 'R' : ' ';
         szAttr[ 3 ] = wfd.dwFileAttributes & FILE_ATTRIBUTE_HIDDEN  ? 'H' : ' ';
         hb_itemPutC( pAttr, szAttr );

         if( FileTimeToSystemTime( &wfd.ftLastWriteTime, &st ) )
         {
            char szTime[ 9 ];

            hb_arrayAdd( pSub, hb_itemPutD( pItem, st.wYear, st.wMonth, st.wDay ) );
            sprintf( szTime, "%02d:%02d:%02d", st.wHour, st.wMinute, st.wSecond );
            hb_arrayAdd( pSub, hb_itemPutC( pItem, szTime ) );
         }
         else
         {
            hb_arrayAdd( pSub, hb_itemPutD( pItem, 0, 0, 0 ) );
            hb_arrayAdd( pSub, hb_itemPutC( pItem, "" ) );
         }

         hb_arrayAdd( pSub, pAttr );
         hb_arrayAdd( pArray, pSub );

         if( XA_EventAssigned( Self, "OnDirectory" ) )
         {
            XA_ObjSendC( Self, "OnDirectory", wfd.cFileName );
            bContinue = HB_ISLOG( -1 ) ? hb_parl( -1 ) : TRUE;
         }

         hb_itemRelease( pAttr );
         hb_itemRelease( pItem );
         hb_itemRelease( pSub );

         ProcessMessages();
         bNext = bContinue && InternetFindNextFile( hFile, &wfd );
      }
      InternetCloseHandle( hFile );
   }
   else
      XA_ObjSend( Self, "NewError" );

   hb_itemReturnForward( pArray );
   hb_itemRelease( pArray );
}

#pragma ENDDUMP

//--------------------------------------------------------------------------