Upload via FTP updates

This forum is for eXpress++ general support.
Post Reply
Message
Author
User avatar
Eugene Lutsenko
Posts: 1649
Joined: Sat Feb 04, 2012 2:23 am
Location: Russia, Southern federal district, city of Krasnodar
Contact:

Upload via FTP updates

#1 Post by Eugene Lutsenko »

For some reason it does not download files larger than 3.5 MB
He writes that he used a demo version Xb2.NET, even though I bought it and have license key here

Code: Select all

#include "xb2net.ch" 

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   // Русификация

CrLf = CHR(13)+CHR(10)     // Конец строки (записи)

m1 = ""
FOR j=1 TO LEN(a1)
    m1 = m1 + a1[j]
NEXT

m2 = ""
FOR j=1 TO LEN(a2)
    m2 = m2 + a2[j]
NEXT

*** 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  :=m1
Ftp_Passw:=m2
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]
Attachments
Безымянный.jpg
Безымянный.jpg (30.08 KiB) Viewed 10348 times

Post Reply