We use the asinet10 ftp for many years and it works fine. Have run across one odd issue recently.
We have an ftp site that two of our clients download fuel transactions daily. In their case they have more than one account and login two times for each days transactions. The problem is the file names are identical.
As a note these downloads are done from different folders (company folders).
If one file is downloaded and the next company is downloaded for the same day, the information in memory is loaded from the first download. The files in each folder are identical. We easily confirm that the downloads attempted are completely different. If the user reboots or tries from another work station they then get the proper information.
Also, if they do not do anything but download the prior days file it is ok.
It appears the file contents are being saved in memory by file name and asinet does not load the new file.
We have tested extensively here with the same results.
The issue is unique, as all other ftp sites with multiple logins name the files differently, normally with some reference to the account id and the date. It works fine using the command prompt ftp (batch file) but do not like to use that.
Just curious to see if anybody else has ever run across this problem, or know if there is a method to "empty" the memory for the prior downloaded file with that same name.
Fred
Omni
Alaska FTP
-
Eugene Lutsenko
- Posts: 1649
- Joined: Sat Feb 04, 2012 2:23 am
- Location: Russia, Southern federal district, city of Krasnodar
- Contact:
Re: Alaska FTP
This FTP client to verify the update files (on my website) and download them if necessary. I did not check the update by downloading it directly on the site date and time. If it is later than the date of running the system file, downloading the update. You can also check the file date and, if available on your computer is outdated, then remove it and download a new one with the same name.
[/size]
Code: Select all
#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)
Xb2NetKey()
SET DECIMALS TO 15
SET DATE GERMAN
SET ESCAPE On
SET COLLATION TO SYSTEM // Русификация
*SET COLLATION TO ASCII // Русификация
CrLf = CHR(13)+CHR(10) // Конец строки (записи)
m1 = "Login" // FTP-server
m2 = "Password"
*** 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:="ftp://lc.kubagro.ru/"
Ftp_User :=m1
Ftp_Passw:=m2
oFtp := XbFTPClient():new()
IF oFtp:Connect(cGDServer) // Соединение
IF oFtp:Login(Ftp_User, Ftp_Passw) // Авторизация
oFtp:PassiveMode:=.T. // Пассивный режим
// Flag = 1. Если в текущей папке исполнимого файла системы нет, то скачивание и разархивирование полного архива и запуск системы на исполнение
IF Flag = 1
oScrn := DC_WaitOn( 'Скачивание полного обновления системы "Эйдос-Х++" около 70 Мб.' )
IF oFtp:GetFile("Update.exe")
* LB_Warning('Полное обновление и старт системы "Эйдос-Х++"', '(C) Система "Эйдос-Х++"' )
ELSE
LB_Warning('Файла обновлений нет на FTP-сервере', '(C) Система "Эйдос-Х++"')
ENDIF
DC_Impl(oScrn)
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 // Система устарела, надо скачать и развернуть обновления
oScrn := DC_WaitOn( 'Скачивание обновления исполнимого модуля системы "Эйдос-Х++" 5 Мб.' )
IF oFtp:GetFile("Downloads.exe") // Скачивание файла обновлений
* LB_Warning('Обновление исполнимого модуля и старт системы "Эйдос-Х++"', '(C) Система "Эйдос-Х++"' )
ELSE
LB_Warning('Файла обновлений нет на FTP-сервере', '(C) Система "Эйдос-Х++"')
ENDIF
DC_Impl(oScrn)
ELSE
Flag = 3 // Система не устарела, просто запустить ее
ENDIF
ENDIF
ELSE
LB_Warning('Не удалось авторизоваться на FTP-сервере', '(C) Система "Эйдос-Х++"' )
ENDIF
ELSE
LB_Warning('Нет соединения с FTP-сервером', '(C) Система "Эйдос-Х++"' )
ENDIF
oFtp:close()
oFTP:destroy()
*** Если файл обновлений новее установленной на компьютере системы, то развернуть его, иначе просто запустить систему
DO CASE
CASE Flag = 0 // Что-то не то
LB_Warning('Error! Error! Error! Error!', '(C) Система "Эйдос-Х++"' )
CASE Flag = 1 // Flag = 1. Если в текущей папке исполнимого файла системы нет, то скачивание и разархивирование полного архива и запуск системы на исполнение
RunShell("","Update.exe",.T.) // Полный архив - инсталляция
aMess := {}
AADD(aMess, 'Необходимо выполнить разархивирование')
AADD(aMess, 'и только ПОСЛЕ этого закрыть данное окно')
AADD(aMess, 'после чего система будет запущена.')
AADD(aMess, '')
AADD(aMess, 'Если некоторые библиотеки заняты модулем')
AADD(aMess, 'обновления, то они не будут разархивированы.')
AADD(aMess, 'Поэтому лучше сделать полное обновление')
AADD(aMess, 'вручную: http://lc.kubagro.ru/Aidos-X.exe')
AADD(aMess, '')
AADD(aMess, 'При разархивировании необходимо выбрать')
AADD(aMess, 'опцию: "Копировать поверх всех файлов"')
AADD(aMess, '"Yes to All" или "OwerWrite All"')
LB_Warning(aMess, '(C) System "Aidos-X++"' )
ERASE("Update.exe")
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(№Xb2Net) // <-- put your Xb2.NET license key here