Xb2NET

[Eugene Lutsenko]

Xb2net bought, downloaded and unzipped with a key started by installing a key replaced everywhere received library recompiled sistem, started it and says that the demo version of the library. Link the key file to the program and she stopped writing, that the demo version. However, FTP does not load files larger than 3 MB. Do not tell me what to do?

[c-tec]

Hello,
here you get help:
http://www.xbwin.com/forum.php
regards
Rudolf

[Wolfgang Ciriack]

Do you have activated the passive mode with your FTP-Connection ?

[Eugene Lutsenko]

Oh, and everything works fine, but less than 3 MB files

Code: Select all

**********************************************************************************
*** (C) д.э.н., к.т.н., профессор Луценко Евгений Вениаминович, Россия, Краснодар.
**********************************************************************************

#include "xb2net.ch" 
#pragma Library("XB2NET.LIB")

PROCEDURE AppSys
// Рабочий стол остается окном приложения
RETURN

********************************************************************************
FUNCTION Main()

LOCAL  GetList[0], GetOptions, nColor, oMessageBox, oMenuWords, oDlg, ;
       oMenuBar,oMenu1,oMenu2,oMenu3,oMenu4,oMenu5,oMenu6,oMenu7,;
       oMenu3_3

   DC_IconDefault(1000)

   SET DECIMALS TO 15
   SET DATE GERMAN
   SET ESCAPE On

   SET COLLATION TO SYSTEM   // Русификация
   *SET COLLATION TO ASCII   // Русификация

*** Flag = 0. Что-то вообще не то
*** Flag = 1. Если в текущей папке исполнимого файла системы нет, то скачивание и разархивирование полного архива и запуск системы на исполнение
*** Если в текущей папке исполнимый файл системы есть, то
*** проверка дат создания файла системы и файла обновлений
*** Flag = 2. Если система устарела - скачивание обновлений и запуск новой версии системы
*** Flag = 3. Иначе  - запуск существующей версии системы

Flag = 0

mCountSys = ADIR("_aidos-x.exe")

IF mCountSys = 0                                    // В текущей папке исполнимого файла системы нет

   Flag = 1

ELSE

   Flag = 2                                         // Возможно система устарела, надо скачать и развернуть обновления

   PRIVATE aName[1], aSize[1], aDate[1]
   mCountSys = ADIR("_aidos-x.exe", aName, aSize, aDate )
   mDateSys = aDate[1]
   StrFile(DTOC(aDate[1]), "DateSys.txt")           // Запись текстового файла с датой создания исполнимого модуля системы

ENDIF

cGDServer:="http://lc.kubagro.ru"
Ftp_User  :="*********"
Ftp_Passw:="*********"
Ftp_File:="Downloads.exe"

*savepath:="c:\Downloads\"

oFtp := XbFTPClient():new()

IF oFtp:Connect(cGDServer)                          // Соединение
   
   IF oFtp:Login(Ftp_User, Ftp_Passw)            // Авторизация
      oFtp:PassiveMode:=.T.                           // Пассивный режим

      // Flag = 1. Если в текущей папке исполнимого файла системы нет, то скачивание и разархивирование полного архива и запуск системы на исполнение

      IF Flag = 1

         IF oFtp:GetFile(Ftp_File, "Aidos-x.exe")
*           LB_Warning('Start and update System "Aidos-X++"', '(C) System "Aidos-X++"' )
         ELSE
            LB_Warning('Update file can not be found on the FTP server', '(C) System "Aidos-X++"')
         ENDIF

      ELSE

         ***** Проверка времени создания файла обновлений без его скачивания прямо на FTP-сервере

         aFileUpd:=oFtp:Directory("Downloads.exe")
         mDateUpd = CTOD(SUBSTR(aFileUpd[1], 4, 2) + "." + SUBSTR(aFileUpd[1], 1, 2) + ".20" + SUBSTR(aFileUpd[1], 7, 2))
         StrFile(DTOC(mDateUpd), "DateUpd.txt")     // Запись текстового файла параметров файла обновлений

         ** Flag = 2. Если система устарела - скачивание обновлений и запуск новой версии системы

         IF mDateSys < mDateUpd                     // Исполнимый файл системы в текущей папке старее файла обновлений
            Flag = 2                                // Система устарела, надо скачать и развернуть обновления
            IF oFtp:GetFile(Ftp_File, "Downloads.exe")              // Скачивание файла обновлений
*              LB_Warning('Start and update System "Aidos-X++"', '(C) System "Aidos-X++"' )
            ELSE
               LB_Warning('Update file can not be found on the FTP server', '(C) System "Aidos-X++"')
            ENDIF
         ELSE
            Flag = 3                                // Система не устарела, просто запустить ее
         ENDIF
      ENDIF
   ELSE
      LB_Warning('Authorization error with the FTP server', '(C) System "Aidos-X++"' )
   ENDIF
ELSE
   LB_Warning('Error connecting to FTP server', '(C) System "Aidos-X++"' )
ENDIF

oFtp:close()
oFTP:destroy()

*** Если файл обновлений новее установленной на компьютере системы, то развернуть его, иначе просто запустить систему

DO CASE
   CASE Flag = 0       // Что-то не то
        LB_Warning('Error! Error! Error! Error!', '(C) System "Aidos-X++"' )
   CASE Flag = 1       // Flag = 1. Если в текущей папке исполнимого файла системы нет, то скачивание и разархивирование полного архива и запуск системы на исполнение
        RunShell("","Aidos-x.exe",.T.)       // Полный архив - инсталляция
        aMess := {}
        AADD(aMess, 'Необходимо выполнить разархивирование')
        AADD(aMess, 'и только после этого закрыть данное окно')
        AADD(aMess, 'после чего система будет запущена.')
        AADD(aMess, '')
        AADD(aMess, 'При разархивировании необходимо выбрать')
        AADD(aMess, 'опцию: "Копировать поверх всех файлов"')
        AADD(aMess, '"Yes to All" или "OwerWrite All"')
        LB_Warning(aMess, '(C) System "Aidos-X++"' )
        RunShell("","_aidos-x.exe",.T.)      // Исполнимый файл системы
   CASE Flag = 2       // Flag = 2. Если система устарела - скачивание обновлений и запуск новой версии системы
        RunShell("","Downloads.exe",.T.)
        aMess := {}
        AADD(aMess, 'Необходимо выполнить разархивирование')
        AADD(aMess, 'и только после этого закрыть данное окно')
        AADD(aMess, 'после чего система будет запущена.')
        AADD(aMess, '')
        AADD(aMess, 'При разархивировании необходимо выбрать')
        AADD(aMess, 'опцию: "Копировать поверх всех файлов"')
        AADD(aMess, '"Yes to All" или "OwerWrite All"')
        LB_Warning(aMess, '(C) System "Aidos-X++"' )
        RunShell("","_aidos-x.exe",.T.)
   CASE Flag = 3       // Flag = 3. Запуск существующей версии системы
        RunShell("","_aidos-x.exe",.T.)
ENDCASE

RETURN NIL


***********************************************************************************************************************
FUNCTION LB_Warning( message, ctitle )

  LOCAL aMsg := {}
*  DEFAULT cTitle TO ''
  IF valtype(message) # 'A'
    aadd(aMsg,message)
  ELSE
    aMsg := message
  ENDIF
  IF LEN(ALLTRIM(cTitle)) > 0
     DC_MsgBox(10,10,aMsg,cTitle)
  ELSE
     DC_MsgBox(10,10,aMsg,'Универсальная когнитивная аналитическая система "Эйдос-Х++"')
  ENDIF

RETURN NIL

***********************************************************************************************************************

FUNCTION DC_CenterObject( oXbp, oRel )

LOCAL nRelWidth, nRelHeight, nWidth, nHeight, nCol, nRow, aPos

DEFAULT oRel := oXbp:setParent()

nWidth := oXbp:currentSize()[1]
nHeight := oXbp:currentSize()[2]
nRelWidth := oRel:currentSize()[1]
nRelHeight := oRel:currentSize()[2]
nCol := (nRelWidth-nWidth)/6
nRow := (nRelHeight-nHeight)/2

IF oRel == oXbp:setParent()
  oXbp:setPos( {nCol,nRow} )
ELSE
  aPos := DC_CalcAbsolutePosition({0,0},oRel)
  oXbp:setPos( {aPos[1]+nCol,aPos[2]+nRow} )
ENDIF

RETURN nil

***********************************************************************************************************************

/*
 ╓───────────────────────────────────────────────────╖
 ║  Program..: _DCMSG.PRG                            ║
 ║  Author...: Roger Donnay                          ║
 ║  Notice...: (c) DONNAY Software Designs 1987-2000 ║
 ║  Date.....: Dec 30, 2000                          ║
 ║  Notes....: Message Functions                     ║
 ║                                                   ║
 ║  Functions: dc_msgbox(), dc_confirm()             ║
 ║             dc_errormsg(), dc_msgboxyesno()       ║
 ╙───────────────────────────────────────────────────╜
*/

*---------------

FUNCTION dc_msgbox ( nRow, nCol, aMessage, cTitle, lWait, nSeconds, lYesNo,;
                     nChoice, aItems, aMenuId, cMenuName, cHotKey, cFont, ;
                     bEval, nIcon, lNoRestore, lAlwaysOnTop, aColor, ;
                     aButtSize, lHorizButtons, oOwner )

LOCAL nWidth, i, cSaveScreen, nYesNoCol, nCursor, cSaveColor, ;
      lPrint, lConsole, cDevice, aChoice, cColor1, cColor2, ;
      cMessage, oDlg, oXbp, nHeight, oParent, lInLoop, oOldApp, ;
      GetList := {}, aLocals[7], lOk, nTabGroup, GetOptions, ;
      oAppFocus := SetAppFocus(), nLine, cKey, cPrompt, lAction := .f., ;
      lOutput, nIconType, nButtHeight, nButtWidth, lPixel, nColumn

l_Escape := DC_MsgBoxEscape()
l_EscHit := .f.

DEFAULT nChoice := 0, ;
        lNoRestore := .t., ;
        lAlwaysOnTop := .f., ;
        lHorizButtons := .f., ;
        aColor := DC_MsgBoxColor(), ;
        oOwner := SetAppWindow()

IF Valtype( nRow ) = 'C'
  aMessage := { nRow }
  lWait := .t.
  nRow := 0
  nCol := 0
ELSEIF Valtype(nRow) ='A'
  aMessage := AClone(nRow)
  lWait := .t.
  nRow := 0
  nCol := 0
ENDIF
DC_VALTYPE( @lYesNo, .f. )
DC_VALTYPE( @nRow,0,  @nCol,0,  @aMessage,{},  @cTitle,DC_MsgBoxTitle(), ;
            @nSeconds,0,  @lWait,!lYesNo,  @aItems,{} )


IF Valtype(nIcon) # 'N'
  IF lYesNo
    nIcon := XBPSTATIC_SYSICON_ICONQUESTION
    nIconType := XBPSTATIC_TYPE_SYSICON
  ELSE
    nIcon := XBPSTATIC_SYSICON_ICONINFORMATION
    nIconType := XBPSTATIC_TYPE_SYSICON
  ENDIF
ELSE
  nIconType := XBPSTATIC_TYPE_ICON
ENDIF

IF nIcon < 100
  nIconType := XBPSTATIC_TYPE_SYSICON
ENDIF

FOR i := 1 TO LEN(aMessage)
  aMessage[i] := DC_XtoC(aMessage[i])
NEXT
IF LEN(aMessage)>0 .AND. lWait .AND. !('Y/N'$UPPER(aMessage[1])) ;
      .AND. nSeconds=1 .AND. !lYesNo .AND. LEN(aItems)=0
  CLEAR TYPEAHEAD
ENDIF
IF ( lYesNo .OR. lWait .OR. LEN(aItems)>0 ) .AND. !DC_Gui() .AND. !DC_MsgBoxGui()
  IF LEN( aMessage ) > 0
    AADD(aMessage,' ')
  ENDIF
  AADD(aMessage,' ')
  AADD(aMessage,' ')
  FOR i := 1 TO LEN(aItems)-2
    AADD(aMessage,' ')
  NEXT
ENDIF
nWidth := 0
FOR i := 1 TO LEN(aMessage)
  nWidth := MAX( nWidth, LEN(aMessage[i]) )
NEXT
FOR i := 1 TO LEN(aItems)
  nWidth := MAX( nWidth, LEN(aItems[i])+3 )
NEXT
nWidth := MAX(nWidth,LEN(cTitle)+4)
IF !DC_Gui() .AND. !DC_MsgBoxGui()
  nRow := IIF( nRow <> 0, nRow,INT( (DC_Maxrow()-LEN(aMessage)) /2 -1 ) )
  nCol := IIF( nCol <> 0 ,nCol,INT( ( DC_Maxcol()-nWidth )/2 - 1 ) )
  DC_InkeyRele(0)
  nCursor := SET(_SET_CURSOR,0)
  cSaveColor := SETCOLOR()
  lPrint := SET(_SET_PRINTER,.f.)
  lConsole := SET(_SET_CONSOLE,.t.)
  cDevice := SET(_SET_DEVICE,'SCREEN')
  IF lYesNo .AND. DC_MsgBoxYesNo()
    IF nChoice # 2
      cColor1 := 'W/G'
      cColor2 := 'W+/G'
    ELSE
      cColor1 := 'W/R'
      cColor2 := 'W+/R'
    ENDIF
    cSaveScreen := DC_Explode( nRow, nCol, nRow+LEN(aMessage)+ ;
                             IIF(Empty(aItems),1,2), nCol+nWidth+4, ;
                             cColor1, cColor2,,cTitle )
  ELSE
    cSaveScreen := DC_EXPL( nRow, nCol, nRow+LEN(aMessage)+IIF(Empty(aItems),1,2),;
                            nCol+nWidth+4, cTitle )
  ENDIF
  FOR i := 1 TO LEN(aMessage)
    @ nRow+i, nCol+2 SAY aMessage[i]
  NEXT
ENDIF

DO CASE

  CASE lWait .AND. LEN(aItems)=0 .AND. nSeconds=1  .AND. !DC_Gui() .AND. !DC_MsgBoxGui()

    nYesNoCol := nCol + INT( ( nWidth-10 )/2 - 1 )
    lYesNo := DC_OK( nRow + LEN(aMessage) - 2, nYesNoCol, nChoice, .t. )

  CASE lYesNo .OR. lWait .OR. Len(aItems)>0

    IF DC_Gui() .OR. DC_MsgBoxGui()

      @ 1,1 DCSTATIC TYPE nIconType SIZE 5,1.8 CAPTION nIcon

      IF lYesNo
        IF nWidth < 25
          nWidth := 25
        ENDIF
      ELSE
        IF nWidth < 20
          nWidth := 20
        ENDIF
      ENDIF

      nLine := 3.5

      FOR i := 1 TO LEN(aMessage)
        @ nLine, 1 DCSAY Pad(aMessage[i],nWidth) FONT cFont SIZE 0
        IF Valtype(aColor) == 'A'
           ATail(GetList)[aGETLIST_COLOR] := aColor
        ENDIF
        nLine++
      NEXT

      nLine++
      IF Empty(nChoice)
        nChoice := 1
      ENDIF

      nColumn := 1

      IF Empty(aButtSize)
        nButtHeight := 1.2
        IF lHorizButtons                                                                                // PC CAW 06-12-12  start // to correct problem where long messages
          nButtWidth := 0
          FOR i := 1 TO LEN(aItems)
            nButtWidth := MAX( nButtWidth, LEN(aItems[i])+3 )
          NEXT
        ELSE
          nButtWidth := nWidth                                                                          // original code
        ENDIF                                                                                           // PC CAW 06-12-12 end
        lPixel := .f.
      ELSE
        nButtHeight := aButtSize[2]
        nButtWidth := aButtSize[1]
        lPixel := .t.
        nLine--                                                                                         // PC CAW 06-12-12 if button size provided, one extra line was inserted
        nLine *= DC_GetOptDefault()[nGETOPT_ROWPIXELS]
      ENDIF

      IF LEN(aItems) > 0 .AND. lHorizButtons                                                            // PC CAW 06-12-12 begin // need to use static for centering in horizontal mode only
        nColumn := 0
        @ nLine,0 DCSTATIC TYPE XBPSTATIC_TYPE_TEXT ;
           SIZE (nButtWidth * len(aItems)) + (IIF( lPixel,10,1.4 )*(len(aItems)-1)), nButtHeight+.5 OBJECT o_Static ;
           _PIXEL lPixel
      ENDIF                                                                                             // PC CAW 06-12-12 end

      FOR i := 1 TO Len(aItems)

        cPrompt := Alltrim(aItems[i])
        IF '~' $ cPrompt
          cKey := Substr(cPrompt,At('~',cPrompt)+1,1)
        ELSEIF '&' $ cPrompt
          cKey := Substr(cPrompt,At('&',cPrompt)+1,1)
        ELSE
          cKey := Substr(cPrompt,1,1)
        ENDIF

        IF i = 1
          nTabGroup := XBP_BEGIN_GROUP
        ELSEIF i = Len(aItems)
          nTabGroup := XBP_END_GROUP
        ELSE
          nTabGroup := XBP_WITHIN_GROUP
        ENDIF

        IF !Empty(aItems[i]) .AND. !aItems[i] == '@'

          IF lHorizButtons                                                                              // PC CAW 06-12-12 added for horizontal buttons - begin - to allow centering
            @ .2, nColumn DCPUSHBUTTON CAPTION aItems[i] SIZE nButtWidth, nButtHeight ;
              ACTION _ActionBlock(i,@nChoice,@cHotKey,GetList,cKey) ;
              EVAL _EvalBlock(i,nChoice) ;
              _PIXEL lPixel ;
              PARENT o_Static ;
              TABSTOP ;
              FONT cFont ;
              TABGROUP nTabGroup ;
              ACCELKEY { DC_KeyTran(Asc(Lower(cKey))), DC_KeyTran(Asc(Upper(cKey))) }
          ELSE                                                                                          // PC CAW 06-12-12 added for horizontal buttons - end
            @ nLine, nColumn DCPUSHBUTTON CAPTION aItems[i] SIZE nButtWidth, nButtHeight ;              // original code
              ACTION _ActionBlock(i,@nChoice,@cHotKey,GetList,cKey) ;
              EVAL _EvalBlock(i,nChoice) ;
              _PIXEL lPixel ;
              TABSTOP ;
              FONT cFont ;
              TABGROUP nTabGroup ;
              ACCELKEY { DC_KeyTran(Asc(Lower(cKey))), DC_KeyTran(Asc(Upper(cKey))) }
          ENDIF

        ENDIF

        IF lHorizButtons
          IF lPixel
            nColumn += nButtWidth + 10
          ELSE
            nColumn += nButtWidth + 1.4
          ENDIF
        ELSE
          IF lPixel
            nLine += nButtHeight + 10
          ELSE
            nLine += 1.4
          ENDIF
        ENDIF

      NEXT

      l_YesNo := lYesNo

      IF lYesNo .OR. Empty(aItems)

        @ nLine,0 DCSTATIC TYPE XBPSTATIC_TYPE_TEXT ;
           SIZE IIF( lYesNo,20.6,10 ), 1.7 OBJECT o_Static ;
           _PIXEL lPixel
      ENDIF

      IF lYesNo

        IF nChoice = 2
          lYesNo := .f.
        ENDIF

        lAction := .f.

        @ .2,.6 DCPUSHBUTTON CAPTION DC_LangMsg(DCMSG_YES) ;
          SIZE 9,1.3 ;
          PARENT o_Static ;
          TABSTOP ;
          TABGROUP XBP_BEGIN_GROUP ;
          OBJECT oYes ;
          ACTION {||lAction := .t., lYesNo := .t., DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)} ;
          EVAL {|o|IIF( lYesNo, SetAppFocus(o),nil ) }

        @ .2,11.4 DCPUSHBUTTON CAPTION DC_LangMsg(DCMSG_NO) ;
          SIZE 9,1.3 ;
          PARENT o_Static ;
          TABGROUP XBP_END_GROUP ;
          TABSTOP ;
          OBJECT oNo ;
          ACTION {||lAction := .t., lYesNo := .f., DC_ReadGuiEvent(DCGUI_EXIT_ABORT,GetList)} ;
          EVAL {|o|IIF( lYesNo, nil, SetAppFocus(o) ) }

      ELSEIF Empty(aItems)

        @ .2, .6 DCPUSHBUTTON CAPTION DC_LangMsg(DCMSG_OK) ;
          TABSTOP ;
          SIZE 9,1.3 ;
          PARENT o_Static ;
          OBJECT oOk ;
          ACTION {||PostAppEvent( xbeP_Close,nil,nil,oDlg )} ;
          EVAL {|o|SetAppFocus(o)}

      ENDIF

      IF !Empty(nRow) .AND. !Empty(nCol)
        DCGETOPTIONS NOMAXBUTTON NOMINBUTTON NORESIZE ;
           WINDOWROW nRow ;
           WINDOWCOL nCol ;
           HIDE ;
           _ALWAYS lAlwaysOnTop
      ELSE
        DCGETOPTIONS NOMAXBUTTON NOMINBUTTON NORESIZE ;
         HIDE ;
         _ALWAYS lAlwaysOnTop
      ENDIF
      GetOptions[lGETOPT_PIXEL] := .f.
      GetOptions[nGETOPT_BUTTONALIGN] := DCGUI_BUTTONALIGN_CENTER

      DCREAD GUI FIT MODAL TITLE cTitle OPTIONS GetOptions ;
         TIMEOUT nSeconds ;
         HANDLER dlgHandler REFERENCE aLocals ;
         PARENT @oDlg ;
         _NOAUTORESTORE lNoRestore ;
         CLEAREVENTS ;
         EXPRESS ;
         TO lOutput ;
         OWNER oOwner ;
         EVAL {|o|;
                  DC_CenterObject(o, oOwner), ;
                  IIF(lYesNo .OR. Empty(aItems) .OR. lHorizButtons,_CenterStatic(o, aLocals),nil), ;    // PC 06-12-12 added to allow centering of horizontal buttons when array presented
                  o:Show(), ;
                  IIF(Valtype(bEval)=='B',Eval(bEval,o),nil)}

      IF !lOutput
        nChoice := 0
      ENDIF

      IF lAction
        lYesNo := lOutput
      ENDIF

    ELSE

      lYesNo := ;
       DC_YESNO( nRow + LEN(aMessage) - 2, nYesNoCol, nChoice, .t., cMenuName )

    ENDIF

  CASE LEN(aItems)>0

    aChoice := DC_MSGITEMS( nRow + LEN(aMessage) - LEN(aItems), nCol, ;
               nChoice, aItems, aMenuId, cMenuName )
    nChoice := aChoice[2]
    cHotKey := aChoice[1]
    lYesNo := LASTKEY()#27

  CASE !DC_Gui() .AND. !DC_MsgBoxGui()
    DC_INKEYRELE(0)
    DC_INKEY(,nSeconds)
    lYesNo := UPPER(CHR(LASTKEY()))='Y'

ENDCASE
IF !DC_Gui() .AND. !DC_MsgBoxGui()
  DC_IMPL( cSaveScreen )
  DC_INKEYRELE(0)
  SET(_SET_CURSOR,nCursor)
  SET(_SET_PRINTER,lPrint)
  SET(_SET_DEVICE,cDevice)
  SET(_SET_CONSOLE,lConsole)
  SETCOLOR( cSaveColor )
ELSE
  // DC_ClearEvents()
ENDIF
IF Valtype(oAppFocus) = 'O'
  SetAppFocus(oAppFocus)
ENDIF

IF l_EscHit // .OR. !lOutput
  lYesNo := .f.
  nChoice := 0
ENDIF

RETURN lYesNo

* ---------------

STATIC FUNCTION ;
  DlgHandler ( nEvent, mp1, mp2, oXbp, oDlg, GetList, aLocals )

IF l_YesNo .AND. nEvent = xbeP_Keyboard
   IF mp1 = Asc(Upper(Substr(Strtran(DC_LangMsg(DCMSG_YES),'&',''),1,1))) .OR.  ;
      mp1 = Asc(Lower(Substr(Strtran(DC_LangMsg(DCMSG_YES),'&',''),1,1)))
     SetAppFocus(oYes)
     PostAppEvent( xbeP_Keyboard, xbeK_ENTER, nil, oYes )
   ELSEIF mp1 = Asc(Upper(Substr(Strtran(DC_LangMsg(DCMSG_NO),'&',''),1,1))) .OR.  ;
      mp1 = Asc(Lower(Substr(Strtran(DC_LangMsg(DCMSG_NO),'&',''),1,1)))
     SetAppFocus(oNo)
     PostAppEvent( xbeP_Keyboard, xbeK_ENTER, nil, oNo )
   ELSEIF mp1 == xbeK_ESC .AND. l_Escape
     l_EscHit := .t.
     RETURN DCGUI_EXIT_ABORT
   ENDIF
ENDIF

RETURN DCGUI_NONE

*-----------------


STATIC FUNCTION _ActionBlock( i, nChoice, cHotKey, GetList, cKey )

RETURN {||nChoice := i, ;
          cHotKey := cKey, ;
          DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)}

*-----------------

STATIC FUNCTION _EvalBlock( i, nChoice )

RETURN {|o|IIF(nChoice == i, SetAppFocus(o),nil)}

*-----------------

FUNCTION dc_yesno ( nSrow, nScol, nChoice, lNoBox, cMenuName )

LOCAL cSaveScrn, cColor1, cColor2, oDlg, oXbp

DC_VALTYPE( @nSrow,0,  @nScol,0,  @nChoice,1,  @lNoBox,.f. )
nSrow := IIF( nSrow <> 0, nSrow,INT( (DC_Maxrow()-1) /2 -1 ) )
nScol := IIF( nScol <> 0 ,nScol,INT( (DC_Maxcol()-15 )/2 - 1 ) )
IF !lNoBox
  cSaveScrn := DC_EXPL( nSrow, nScol, nSrow+2, nScol+15 )
ENDIF
DC_At_Prompt( nSrow+1, nScol+2, ' Yes ',,PAD('YES',8) )
DC_At_Prompt( nSrow+1, nScol+9,' No ',,PAD('NO',8) )
nChoice := DC_Menu_To( nChoice, 17, -1,, cMenuName )
DC_IMPL(cSaveScrn)
RETURN nChoice=1

*---------------

FUNCTION dc_ok ( nSrow, nScol, nChoice, lNoBox )

LOCAL cSaveScrn, lInkeyWin := DC_InkeyWin(.t.)
nSrow   := IIF(Valtype(nSrow)='N',nSrow,0)
nScol   := IIF(Valtype(nScol)='N',nScol,0)
nChoice := IIF(Valtype(nChoice)='N',nChoice,1)
lNoBox  := IIF(Valtype(lNoBox)='L',lNoBox,.f.)
nSrow := IIF( nSrow <> 0, nSrow,INT( (DC_Maxrow()-1) /2 -1 ) )
nScol := IIF( nScol <> 0 ,nScol,INT( (DC_Maxcol()-15 )/2 - 1 ) )
IF !lNoBox
  cSaveScrn := DC_EXPL( nSrow, nScol, nSrow+2, nScol+15 )
ENDIF
DC_At_Prompt( nSrow+1, nScol+6, ' OK ' )
nChoice := DC_MENU_TO( nChoice, 17, -1 )
DC_IMPL(cSaveScrn)
DC_InkeyWin(lInKeyWin)
RETURN nChoice=1

*---------------

STATIC FUNCTION ;
       dc_msgitems ( nSrow, nScol, nChoice, aItems, aMenuId, cMenuName )

nChoice := IIF(Valtype(nChoice)='N',nChoice,1)

RETURN DC_MenuPull( { nSrow,nScol+2,,, 'A',.t.,.f.,,,.f.,,,,,,,;
                      aItems,,,,,,,,aMenuId }, @nChoice, .f., cMenuName )

/*--------------------*/

FUNCTION dc_confirm ( nRow, nChoice )

DC_INKEYRELE(0)
RETURN DC_MSGBOX( nRow,,,,,,, @nChoice, ;
                 { DC_MSG_2_1, DC_MSG_2_2, DC_MSG_2_3 } )

/*--------------------*/

FUNCTION dc_errormsg( aMessage, lSound, cTitle )

LOCAL i, lGui := DC_Gui(), cMessage

DEFAULT lSound := .f., ;
        cTitle := 'Error', ;
        aMessage := {'An Error Occured!'}

cMessage := ''
IF lSound
  FOR i := 1 TO Len(aMessage)
    cMessage += aMessage[i] + Chr(13)
  NEXT
  DC_WinAlert(cMessage)
ELSE
  DC_Gui(.t.)
  DC_MsgBox(,,aMessage)
  DC_Gui(lGui)
ENDIF

RETURN nil

/* --------------------- */

FUNCTION dc_msgboxyesno ( lMode )

STATIC lYesNo := .f.

LOCAL lSaveYesNo := lYesNo
lYesNo := IIF(Valtype(lMode)='L',lMode,lYesNo)
RETURN lSaveYesNo


/* ----------------------- */

/*
xButtons  - can be array of button captions, or:
            XBPMB_OK, XBPMB_OKCANCEL, XBPMB_ABORTRETRYIGNORE, XBPMB_YESNO,
            XBPMB_YESNOCANCEL
nStyle    - when <xButtons> is an array, <nStyle> is an icon of type:
            XBPSTATIC_SYSICON_ otherwise,
            XBPMB_NOICON, XBPMB_QUESTION, XBPMB_WARNING, XBPMB_INFORMATION,
            XBPMB_CRITICAL
            XBPMB_APPMODAL  modal in relation to the Xbase++ app
            XBPMB_SYSMODAL  modal system wide
            XBPMB_MOVEABLE  box can be moved
 nDefButton- XBPMB_DEFBUTTON1, XBPMB_DEFBUTTON2, XBPMB_DEFBUTTON3
*/

FUNCTION DC_WinAlert( cMessage, cTitle, xButtons, nStyle, ;
                      nDefButton, oOwner )

LOCAL nReturn, oAppFocus := SetAppFocus()

DEFAULT cTitle TO AppName()

IF ValType(xButtons) == "A"
  nReturn := DC_GuiAlert( oOwner, StrTran(cMessage,Chr(10),";"), ;
                          xButtons, nStyle, cTitle )
  SetAppFocus(oAppFocus)
  // DC_ClearEvents()
  RETURN nReturn
ENDIF

DEFAULT xButtons TO XBPMB_OK
DEFAULT nStyle   TO XBPMB_WARNING + XBPMB_MOVEABLE + XBPMB_APPMODAL

DO CASE
   CASE nDefButton == Nil; nDefButton := XBPMB_DEFBUTTON1
   CASE nDefButton == 2  ; nDefButton := XBPMB_DEFBUTTON2
   CASE nDefButton == 3  ; nDefButton := XBPMB_DEFBUTTON3
   OTHERWISE             ; nDefButton := XBPMB_DEFBUTTON1
ENDCASE

cMessage := Strtran(cMessage,';',Chr(13))

nReturn := ConfirmBox( oOwner, cMessage, cTitle, xButtons, ;
                       nStyle, nDefButton )

SetAppFocus(oAppFocus)
// DC_ClearEvents()

DO CASE
   CASE nReturn == XBPMB_RET_OK     ; RETURN XBPMB_RET_OK
   CASE nReturn == XBPMB_RET_ABORT  ; RETURN XBPMB_RET_ABORT
   CASE nReturn == XBPMB_RET_YES    ; RETURN XBPMB_RET_YES
   CASE nReturn == XBPMB_RET_CANCEL ; RETURN iif(xButtons == XBPMB_OKCANCEL, XBPMB_RET_CANCEL, XBPMB_RET_ABORT)
   CASE nReturn == XBPMB_RET_RETRY  ; RETURN XBPMB_RET_RETRY
   CASE nReturn == XBPMB_RET_IGNORE ; RETURN XBPMB_RET_IGNORE
   CASE nReturn == XBPMB_RET_NO     ; RETURN XBPMB_RET_NO
   CASE nReturn == XBPMB_RET_ENTER  ; RETURN XBPMB_RET_ENTER
ENDCASE

RETURN 0

* ------------------ *

FUNCTION DC_IconDefault( noIcon )

STATIC snoIcon := nil

LOCAL noOldIcon := snoIcon

snoIcon := IIF(Valtype(noIcon)$'NO',noIcon,snoIcon )

RETURN noOldIcon

* ----------------------

STATIC FUNCTION _CenterStatic( oDlg, aLocals )

LOCAL nWidth, nDlgWidth, nCol

nWidth := o_Static:currentSize()[1]
nDlgWidth := oDlg:drawingArea:currentSize()[1]
nCol := (nDlgWidth-nWidth)/2
o_Static:setPos({nCol, o_Static:currentPos()[2] } )

RETURN nil

* ----------------------

FUNCTION DC_MsgBoxTitle( cTitle )

STATIC scTitle := nil
LOCAL cOldTitle := scTitle

scTitle := IIF(Valtype(cTitle)='C',cTitle,scTitle )

IF cOldTitle == nil
   cOldTitle := AppName()
ENDIF

RETURN cOldTitle

* -----------------------

FUNCTION DC_MsgBoxGui( lGui )

STATIC slGui := .f.

LOCAL lOldGui := slGui

IF Valtype(lGui) = 'L'
  slGui := lGui
ENDIF

RETURN lOldGui

* ------------------------

FUNCTION DC_BusyOn( oParentDlg, bDialog )

LOCAL oBusyDlg := Eval( bDialog, oParentDlg )
DEFAULT oParentDlg := AppDeskTop()

oBusyDlg:setParent(oParentDlg)
IF oParentDlg:IsDerivedfrom('XbpDialog')
   oParentDlg:drawingArea:disable()
ELSE
   oParentDlg:Disable()
ENDIF
DC_CenterObject(oBusyDlg,oParentDlg)
oBusyDlg:show()
oBusyDlg:toFront()

RETURN oBusyDlg

* ------------------------

FUNCTION DC_BusyOff( oBusyDlg )

LOCAL oParentDlg

oParentDlg := oBusyDlg:setParent()
IF oParentDlg:IsDerivedfrom('XbpDialog')
   oParentDlg:drawingArea:enable()
ELSE
   oParentDlg:enable()
ENDIF
oBusyDlg:destroy()

RETURN nil

* ------------------

GETSETFUNCTION DC_MsgBoxEscape DEFAULT .f.

* ------------------

GETSETFUNCTION DC_MsgBoxColor DEFAULT { nil, nil }


FUNCTION Xb2NetKey(); Return(********)    // <-- put your Xb2.NET license key here

[/size]

[Cliff Wiernik]

This is the sample ftptest.prg from xb2.net. I have changed the file name used to a file test.exe that is 22,637,568 in size. It uploads and downloads just fine.

This is the command line: ftptest ftp.ftpsite.com user password test /passive /show.

No problems. 42 sec upload, 21 sec download.

Code: Select all

///////////////////////////////////////////////////////////////////////////////
//
//  FTPTEST.PRG
//
//  Xb2.NET xbFTPClient test program
//
//  Copyright (c) 2004-2009, Xb2.NET inc.
//  All rights reserved.
//
//  Author:   Boris Borzic
//  Email:    support@xb2.net
//  Web:      http://www.xb2.net
//
///////////////////////////////////////////////////////////////////////////////



#include "xb2net.ch"


procedure Main( cServer, cUserID, cPassword, cPath, cFlag, cFlag2, cFlag3 )
   Local oFtp, bCallback

   if PCount() == 0 .or. "/?" $ cServer
      ?
      ? "USAGE: " + Lower(AppName()) + " URL [uid] [pwd] [path] [/passive] [/securedata] [/show]"
      ?
      ? "  URL         - FTP/FTPS server address or domain name"
      ? "  uid         - login userid, default is 'anonymous'"
      ? "  pwd         - login password, default is a null string"
      ? "  path        - switch to a specific directory"
      ? "  /passive    - use passive mode if connecting through a firewall"
      ? "  /securedata - use secure data channel (when using FTPS)"
      ? "  /show       - display detailed progress information"
      ?
      ? "EXAMPLE:"
      ? Lower(AppName()) + " ftps://TheBatCave.com batman 1o7T&x0 batfiles /passive/securedata"
      ?
      inkey(0)
      quit
   endif

   // make the console window bigger
   SetAppWindow():Configure( NIL, NIL, {0,23}, 45, 80, AppName())

   cFlag := lower(var2char(cFlag) + var2char(cFlag2) + var2char(cFlag3))

   oFtp := xbFTPClient():new()

   oFtp:PassiveMode      := "/passive" $ cFlag
   oFtp:SecureDataChannel:= "/securedata" $ cFlag
   oFtp:RecvTimeout(10000)
   oFtp:SendTimeout(10000)

   if "/show" $ cFlag
      // set callback to see what's going on
      // this codeblock will display status/progress info in terminal window:
      SetColor("w+/n")
      oFtp:SetCallBack({|a,b| DisplayStatus(a,b)})
   endif


   // if the FTP server needs a certificate from the client do this:
   //
   // (1) create xbSSLContext object:
   //
   //    oSSL := xbSSLContext():new(SSL_v23)
   //
   // (2a) if the certificate is in PKCS12 (.PFX) format do this:
   //
   //    if ! oSSL:UsePKCS12File(".\MyCert.pfx", "MyPassword")
   //       ? "Certificate Error:", xbSSLGetErrorString()
   //    endif
   //
   // (2b) if the certificate is in PEM (base64 encoded) format do this:
   //
   //    oSSL:UseCertificateFile(".\MyCert.pem")
   //    oSSL:UsePrivateKeyFile(".\MyCert.pem")
   //
   // (3) attach oSSL to oFtp:
   //
   //    oFtp:SetSSLContext(oSSL)
   //


   // connect to FTP server
   if ! oFtp:Connect( cServer )
      Terminate( "*** ERROR: Failed to connect to FTP server: " + cServer )
   endif

   // do login
   if oFtp:Login(cUserID, cPassword)
      ? "Connected to ", cServer
   else
      Terminate( "*** ERROR: Login failed!" )
   endif

   // get current directory
   ? "current dir =", oFtp:GetCurrentDirectory()

   if !empty(cPath)
      // change directory
      if ! oFtp:SetCurrentDirectory(cPath)
         Terminate( "*** ERROR: Unable to change path to: " + cPath )
      endif

      ? "path changed, current dir =", oFtp:GetCurrentDirectory()
   endif

   ShowDir( oFtp )

   ? "Create directory 'TEST'"
   if !oFtp:CreateDirectory("TEST")
      Terminate( "*** ERROR: Failed to create directory 'TEST'", .F.)
   endif

   ? "Change path to 'TEST'"
   if ! oFtp:SetCurrentDirectory("TEST")
      Terminate( "*** ERROR: Unable to change path to: 'TEST'", .F. )
   endif

   ? "path changed, current dir =", oFtp:GetCurrentDirectory()

   ShowDir( oFtp )

   ? "Upload file: " + AppName(.t.)
//   if oFtp:PutFile(AppName(.T.), "test.exe")
   if oFtp:PutFile("test.exe", "test.exe")
      ? "Transmitted:", oFtp:BytesTransferred, "bytes in", oFtp:ElapsedTime, "seconds"
   else
      Terminate( "*** ERROR: Unable to upload file!")
   endif

   ShowDir( oFtp )

   ? "Rename file test.exe -> test-1.EXE"
   if ! oFtp:RenameFile("test.exe", "test-1.EXE")
      Terminate( "*** ERROR: Unable to rename file!")
   endif

   ShowDir( oFtp )

   ? "Download file: test-1.EXE"
   if oFtp:GetFile("test-1.EXE")
      ? "Received:", oFtp:BytesTransferred, "bytes in", oFtp:ElapsedTime, "seconds"
   else
      Terminate( "*** ERROR: Unable to download file!")
   endif

   ?
   ? "Delete file test-1.EXE"
   if ! oFtp:DeleteFile("test-1.EXE")
      Terminate( "*** ERROR: Unable to delete file!")
   endif

   ShowDir( oFtp )

   ? "Change to parent directory and delete directory 'TEST'"
   oFtp:SetCurrentDirectory()
   if ! oFtp:DeleteDirectory("TEST")
      Terminate( "*** ERROR: Unable to delete directory!", .F.)
   endif

   ShowDir( oFtp )

   oFtp:Destroy()

   Terminate("end of test...")
   Return


procedure DisplayStatus( nStatus, cMessage )
   Local cColor := SetColor(iif(isFTP_ST(nStatus), "n+/n", "r/n"))
   ? nStatus, cMessage
   SetColor(cColor)
   Return

procedure Terminate( cMessage, lQuit )
   Local cColor

   if cMessage != NIL
      cColor := SetColor("gr+/n")
      ? cMessage
      inkey(0)
      SetColor(cColor)
   endif
   if lQuit == NIL .or. lQuit
      quit
   endif
   Return

Procedure ShowDir( oFtp )
   Local aDir, cColor

   cColor := SetColor("g/n")
   ?
   ? "Push a key to get directory listing..."
   SetColor(cColor)
   inkey(0)
   aDir := oFtp:Directory()
   if empty(aDir)
      ? "dir: <empty>"
   else
      ? "dir: "
      AEval(aDir, {|x| QOut(x)})
   endif
   ?
   Return