Like all commented out functions related to the information output to the screen. Everything works as it should, in the sense of changing the structure of the database while preserving their content, but still in the lower left corner of the current window flashes a small empty window without a title and I can not find the code, which causes the appearance of the window.
Code: Select all
************************************************************************************
******** Функция Роджера для изменения структуры базы данных с сохранием содержания
************************************************************************************
/*
╓──────────────────────────────────────────────────────────────────╖
║ Program..: _DCDBFIL.PRG ║
║ Author...: Roger J. Donnay ║
║ Notice...: (c) DONNAY Software Designs 1987-2000 ║
║ Date.....: Jan 22, 2000 ║
║ Notes....: Open a data file ║
║ ║
║ Functions: dc_dbfile(), dc_dbfsel(), dc_dbfopen() ║
╙──────────────────────────────────────────────────────────────────╜
Note : Removed DC_OPENDBF() - Use DC_DBFILE()
#include 'dcdialog.ch'
#include 'dcpick.ch'
#include 'dcfiles.ch'
#include '_dcdbfil.ch'
#include 'inkey.ch'
#include 'set.ch'
#INCLUDE "dcads.CH"
MEMVAR dCCOLOR
*/
// ----------------- //
FUNCTION dc_dbfile ( cDirectory, cDataFile, lUserPrompt, ;
lExclusive, nWait, xDbe, lReOpen, ;
aStructure, cAlias, lNoErrorDsp, ;
lCreateDbf, lStruUpdated, lStruMsg, ;
lReadOnly )
LOCAL cFileAlias, cSaveScreen, nStruError, cFileCreate,;
lForever, cExtension, lFileIsOpen, cField, i, aReadArea,;
cFileDos, cFile, cNewPath, cOldPath, cFilePath, GetList := {},;
lCreateError, bErrorBlock, lError, lChangedType, lChangedName,;
aStruCreate, lOk, cConnect, lAdsDict, cDbe
cDataFile := Upper(AllTrim(DC_DefType(cDataFile,'')))
cDirectory := Upper(AllTrim(DC_DefType(cDirectory,'')))
lUserPrompt := DC_DefType(lUserPrompt,.f.)
lExclusive := DC_DefType(lExclusive,SET(_SET_EXCLUSIVE))
nWait := DC_DefType(nWait,.1)
lReOpen := DC_DefType(lReOpen,.f.)
lNoErrorDsp := DC_DefType(lNoErrorDsp,.f.)
lCreateDbf := DC_DefType(lCreateDbf,.t.)
lStruMsg := DC_DefType(lStruMsg,.f.)
cFilePath := DC_PATH(cDataFile)
lAdsDict := .f.
IF !EMPTY(cFilePath)
cDirectory := cFilePath
ENDIF
cDataFile := DC_PATH(cDataFile,.t.)
IF EMPTY(xDbe)
xDbe := DbeSetDefault()
cDbe := xDbe
ELSEIF Valtype(xDbe) == 'C' .AND. xDbe='FOXRDD'
xDbe := DC_FoxRdd()
cDbe := xDbe
ELSEIF Valtype(xDbe) == 'O'
cConnect := Upper(xDbe:getConnectionString())
IF 'ADSDBE' $ cConnect
cDbe := 'ADSDBE'
IF '.ADD' $ cConnect
lAdsDict := .t.
ENDIF
ELSE
cDbe := DbeSetDefault()
ENDIF
ELSE
cDbe := xDbe
ENDIF
cExtension := DC_DbfExt(cDbe,cDataFile)
IF Empty(cExtension)
cExtension := '.DBF'
ENDIF
IF '.'$cDataFile
cDataFile := SubStr(cDataFile,1,AT('.',cDataFile)-1)
ENDIF
cFileAlias := cDataFile
cOldPath := SET(_SET_PATH)
lStruUpdated := .f.
DO WHILE .T.
IF ':'$cFileAlias
cFileAlias := SubStr(cFileAlias,AT(':',cFileAlias)+1,LEN(cFileAlias))
LOOP
ENDIF
IF '\'$cFileAlias
cFileAlias := SubStr(cFileAlias,AT('\',cFileAlias)+1,LEN(cFileAlias))
LOOP
ENDIF
EXIT
ENDDO
cDirectory += IIF(Len(cDirectory)=0 .OR. Right(cDirectory,1)$'\:','','\')
cFile := cDirectory + cDataFile
IF Valtype(cAlias)='C'
cFileAlias := cAlias
ENDIF
IF Select(cFileAlias)#0 .AND. !lExclusive .AND. !lReOpen
IF DC_DbSel(cAlias)
lFileIsOpen := .t.
RETURN .T.
ENDIF
ENDIF
cFileDos := cDirectory + cDataFile + cExtension
cFileCreate := cFileDos
lFileIsOpen := .f.
lForever := (nWait=0)
lCreateError := .f.
lError := .f.
DO WHILE !lFileIsOpen
IF File(cFileDos) .OR. FExists(cFileDos) .OR. Valtype(xDbe) == 'O'
DO WHILE lForever .OR. nWait>0
DC_UseArea( .f., xDbe, cFileDos, cAlias, ;
!lExclusive,lReadOnly,!lNoErrorDsp,,@lError )
IF lError
RETURN .f.
ENDIF
IF !NetErr()
lFileIsOpen := .t.
EXIT
ENDIF
INKEY(1)
nWait--
ENDDO
ELSEIF !Empty(cDirectory)
cDirectory := ''
cFileDos := cDataFile + cExtension
LOOP
ENDIF
IF VALTYPE(aStructure)$'AB'
IF !lCreateDbf .AND. !lFileIsOpen
EXIT
ENDIF
IF !lFileIsOpen
IF ValType(aStructure)='B'
aStructure := Eval(aStructure)
IF Valtype(aStructure)#'A'
EXIT
ENDIF
ENDIF
CLOSE
lCreateError := .t.
bErrorBlock := ErrorBlock( {|e| _dcdbfil6(e,cFileDos,lNoErrorDsp) } )
BEGIN SEQUENCE
cFileDos := cFileCreate
aStruCreate := AClone(aStructure)
FOR i := 1 TO LEN(aStruCreate)
ASize(aStruCreate[i],4)
NEXT
DbCreate( cFileDos, aStruCreate, cDbe )
lCreateError := .f.
END SEQUENCE
ErrorBlock( bErrorBlock )
CLOSE
DC_UseArea( .f., xDbe, cFileDos, cAlias, !lExclusive,lReadOnly,,@lError )
IF lError
RETURN .f.
ENDIF
IF LEN(aStructure[1]) > 4
IF DC_ADDREC(5)
FOR i := 1 TO LEN(aStructure)
IF LEN(aStructure[i])>4 .AND. VALTYPE( aStructure[i,5] ) # 'U'
cField := FIELDName(i)
REPL &cField WITH aStructure[i,5]
ENDIF
NEXT
UNLOCK
ENDIF
ENDIF
ELSE
IF VALTYPE(aStructure)='B'
aStructure := Eval(aStructure)
ENDIF
IF Valtype(aStructure)='A'
STORE .f. TO lChangedType, lChangedName
DC_IsStru(aStructure, @nStruError, .f., @lChangedType, @lChangedName)
IF nStruError >= 3
* IF !lStruMsg .OR. ;
* DC_MsgBox(,,{ DC_DBMSG_23_1+cFileDos,DC_DBMSG_23_2, ;
* DC_DBMSG_23_3 },,,,.t. )
IF !lStruMsg
DC_UseArea( .f., xDbe, cFileDos, cAlias, .f.,lReadOnly, .t. )
IF Empty(Alias()) .OR. ;
!DC_StruUpdate( aStructure,,lChangedType,lChangedName,.f. )
lFileIsOpen := .f.
ENDIF
lStruUpdated := .t.
EXIT
ENDIF
ENDIF
ENDIF
ENDIF
IF !Empty(Alias())
lFileIsOpen := .t.
ENDIF
ENDIF
IF !lFileIsOpen .AND. !lCreateError .AND. !lNoErrorDsp
IF lUserPrompt
cNewPath := SPACE(65)
* @ 3,3 DCSAY DC_DBMSG_3 SAYSIZE 43
* @ 5,3 DCSAY DC_DBMSG_2 SAYSIZE 43
* @ 6,3 DCGET cNewPath GETSIZE 43 ;
* POPUP {|c|DC_PopFile(c)}
* DCREAD GUI EXPRESS FIT ADDBUTTONS TO lOk ENTEREXIT TITLE DC_DBMSG_12
IF !lOk
lFileIsOpen := .f.
USE
EXIT
ENDIF
IF '.' $ cNewPath
cNewPath := DC_Path(cNewPath)
ENDIF
SET(_SET_PATH,ALLTRIM(cNewPath))
cFile := UPPER(LTRIM(TRIM(cDataFile)))
cFileDos := cFile+cExtension
ELSE
EXIT
ENDIF
ELSE
EXIT
ENDIF
ENDDO
SET(_SET_PATH, cOldPath)
RETURN lFileIsOpen
* ------------------ *
FUNCTION dc_dbfsel
LOCAL nSelectArea, nWorkArea, cAlias, aSelect[255,1], lOk, GetList := {}, ;
GetOptions, oBrowse
FOR nSelectArea := 1 TO 255
aSelect[nSelectArea,1] := PadL( Str( nSelectArea, 3 ), 9 ) + ' ' + ;
Pad( Alias( nSelectArea ), 12 ) + ' '+;
IIF( !Empty( Alias( nSelectArea ) ), DC_DbfName(nSelectArea), '' )
NEXT
cAlias := Alias()
nWorkArea := Sele()
nSelectArea := Sele()
*@ 1,0 DCSAY DC_DBMSG_5 FONT '10.Courier Bold' COLOR GRA_CLR_BLUE SAYSIZE 0
*@ 2,0 DCSAY DC_DBMSG_6 FONT '10.Courier Bold' COLOR GRA_CLR_BLUE SAYSIZE 0
*@ 3,0 DCBROWSE oBrowse DATA aSelect SIZE 80,11.5 FONT '10.Courier' ;
* POINTER nSelectArea ;
* ITEMSELECTED {||DC_ReadGuiEvent(DCGUI_EXIT_OK,GetList)} ;
* PRESENTATION DC_BrowPres()
*DCBROWSECOL ELEMENT 1 HEADER DC_DBMSG_4 PARENT oBrowse WIDTH 65
*DCGETOPTIONS NOMINBUTTON NOMAXBUTTON HIDE
*DCREAD GUI ;
* EXPRESS ;
* FIT ;
* *ADDBUTTONS ;
* MODAL ;
*OPTIONS GetOptions ;
* TO lOk ;
* TITLE DC_DBMSG_1 ;
*EVAL {|o|DC_CenterObject(o,SetAppWindow()),o:show(),;
* SetAppWindow(o),SetAppFocus(oBrowse:getColumn(1))}
IF !lOk
RETURN 0
ENDIF
IF (nSelectArea=nWorkArea .AND. !Empty(cAlias)) .OR. nSelectArea=0
SELECT (nWorkArea)
RETURN nWorkArea
ENDIF
SELECT (nSelectArea)
IF Empty(Alias(nSelectArea))
DC_DbfOpen()
ENDIF
RETURN nSelectArea
* -----------------
FUNCTION dc_dbfopen
LOCAL cDataFile, cIndexFile, lShared, cRdd, i, oIndexList, ;
GetList := {}, cAlias, lReadOnly, lError, cPath, ;
oGroup1, lOk, GetOptions, aPickIndex, aListIndex
BEGIN SEQUENCE
STORE Space(75) TO cDataFile, cIndexFile
lShared := !(SET(_SET_EXCLUSIVE))
lReadOnly := .f.
lOk := .f.
lError := .t.
cRdd := Pad(DbeSetDefault(),10)
cAlias := SPACE(10)
aPickIndex := {}
aListIndex := _IndexList(cRdd)
*@ 1,1 DCSAY DC_DBMSG_8 // Select Area
*@ 2,1 DCSAY DC_DBMSG_10 // Filename
*@ 3,1 DCGET cDataFile GETSIZE 60 ;
* POPUP {|c|DC_PopFile(c,Set(_SET_DEFAULT),'*'+DC_DBFEXT()) } ;
*@ 4,1 DCSAY DC_DBMSG_16 GET cRdd POPUP {|c|DC_RddSel()} SAYRIGHT ;
* DATALINK {||aListIndex := _IndexList(cRdd,cDataFile), ;
* DC_VarToListBox(oIndexList,aListIndex),DC_ClearEvents()} ;
* VALID {||_dcdbfil3(@cRdd,GetList)}
*@ 5,1 DCSAY DC_DBMSG_19 GET cAlias PICT '@!' ;
* WHEN {||_dcdbfil5( @cAlias, cDataFile )} SAYRIGHT // Alias
*@ 8,1 DCGROUP oGroup1 SIZE 25,4 CAPTION ''
*@ 1,3 DCCHECKBOX lShared PROMPT DC_DBMSG_11 PARENT oGroup1
*@ 2,3 DCCHECKBOX lReadOnly PROMPT DC_DBMSG_20 PARENT oGroup1
*@ 7,30 DCSAY DC_DBMSG_21 SAYSIZE 0
*@ 8,30 DCPICKLIST aPickIndex LIST aListIndex SIZE 45,8 ;
* IMMEDIATE OBJECT oIndexList
*DCGETOPTIONS NOMINBUTTON NOMAXBUTTON HIDE
*DCREAD GUI ;
* EXPRESS ;
* FIT ;
* ADDBUTTONS ;
* MODAL ;
* OPTIONS GetOptions ;
* TITLE DC_DBMSG_7 ;
* TO lOk ;
* EVAL {|o|DC_CenterObject(o,SetAppWindow()),o:show(),;
* SetAppWindow(o)}
IF !lOk .OR. Empty(cDataFile)
BREAK
ENDIF
cAlias := AllTrim(cAlias)
cRdd := AllTrim(cRdd)
IF EMPTY(cAlias)
cAlias := nil
ENDIF
DC_UseArea( .f., TRIM(cRdd), cDataFile, cAlias, lShared, lReadOnly,,,@lError )
IF lError
lOk := .f.
BREAK
ENDIF
OrdListClear()
cPath := DC_Path(cDataFile)
IF !Empty(cPath)
cPath += '\'
ENDIF
FOR i := 1 TO Len(aPickIndex)
OrdListAdd(cPath + aPickIndex[i])
NEXT
END SEQUENCE
RETURN lOk
* -----------------
STATIC FUNCTION _dcdbfil3( cRdd, GetList )
IF !DC_ISRDD(cRdd)
cRdd := Pad(DC_RddSel(),10)
DC_GetRefresh(GetList)
ENDIF
RETURN .t.
* -----------------
STATIC FUNCTION _dcdbfil5 ( cAlias, cDataFile )
IF EMPTY( cAlias )
cAlias := Upper(DC_Path(AllTrim(cDataFile),.t.))
IF '.'$cAlias
cAlias := SubStr(cAlias,1,AT('.',cAlias)-1)
ENDIF
cAlias := Pad(cAlias,10)
ENDIF
RETURN IIF(Empty(cAlias),.f.,.t.)
* -----------------
STATIC FUNCTION _dcdbfil6 ( e, cFileName, lNoErrorDsp )
LOCAL cErrorInfo, GetList[0], GetOptions
cErrorInfo := e:description+' '+e:operation+;
IIF(!EMPTY(e:subsystem),;
" "+e:subsystem + "[" + LTrim(Str(e:subCode)) + "]",'')+;
IIF(e:OSCode>0," OS Code["+LTrim(Str(e:OSCode))+"]",'')
IF !lNoErrorDsp
* @ 0,0 DCSAY DC_DBMSG_22 SAYSIZE 0
* @ 1,0 DCSAY cFileName SAYSIZE 0
* @ 3,0 DCSAY cErrorInfo SAYSIZE 0
* @ 5,0 DCPUSHBUTTON CAPTION 'Show Error Object' SIZE 15,2 ;
* ACTION {||DC_InspectObject(e)}
* DCGETOPTIONS NORESIZE
* DCREAD GUI FIT MODAL TITLE 'File Creation Error' OPTIONS GetOptions ;
* BUTTONS DCGUI_BUTTON_OK
ENDIF
BREAK
RETURN .t.
* ------------------
STATIC FUNCTION _IndexList( cRdd, cDataFile )
LOCAL aListIndex, cPath, cCurPath := DC_CurPath(), aRddInfo, i, ;
aDir
cPath := DC_Path(cDataFile)
DC_ChDir(cPath)
aRddInfo := DC_RddInfo(cRdd)
IF !Empty(aRddinfo[4])
aListIndex := Directory('*' + aRddInfo[4])
ELSE
aListIndex := {}
ENDIF
IF !Empty(aRddInfo[5])
aDir := Directory('*' + aRddInfo[5])
ELSE
aDir := {}
ENDIF
FOR i := 1 TO Len(aDir)
AAdd(aListIndex,aDir[i])
NEXT
DC_ChDir(cCurPath)
IF Empty(aListIndex)
RETURN {}
ENDIF
aListIndex := DC_AConvert(aListIndex)[1]
FOR i := 1 TO Len(aListIndex)
aListIndex[i] := Upper(aListIndex[i])
NEXT
ASort(aListIndex)
RETURN aListIndex
/*
╓──────────────────────────────────────────────────────────────────╖
║ Program..: _DCSTRU.PRG ║
║ Author...: Roger J. Donnay ║
║ Notice...: (c) DONNAY Software Designs 1987-2000 ║
║ Date.....: May 23, 2000 ║
║ Notes....: Validate and update a data structure ║
║ ║
║ Functions: dc_struupd(), dc_isstru() ║
╙──────────────────────────────────────────────────────────────────╜
#include 'inkey.ch'
#include '_dcstru.ch'
// #include 'dcget.ch'
#include 'dcfields.ch'
#include 'dccolor.ch'
#INCLUDE "dcdialog.ch"
MEMVAR dCBROWSE, dCEDIT, dCCOLOR
*/
FUNCTION dc_struupdate ( aStructure, cNewFileName, lChangedType, ;
lChangedName, lPrompt, lTestDict )
LOCAL cSaveScreen, lError, lConfirm, nWorkArea, cOldAlias, ;
cPath, cNewFileExt, cNewDbtExt, aReadArea, cScrn, aIndex,;
cOldFileName, cOldDbtName, cNewDbtName, cOldRdd, cOldFileExt,;
cOldDbtExt, cOldSetRdd, cFileStru, cBakFileName, cBakDbtName,;
cBakData, cNewType, cOldType, i, cFieldName, cNewField,;
cFieldType, nFieldLoc, nFieldCount, aFields, nFields, ;
nWorkBak, lIsShared, lReadOnly, lDeleted, aStruCreate, oDlg, ;
lNewFile, cNewAlias, cOldCdxName, cOldCdxExt, lGui, cBakCdxName
LOCAL aOldFields := {}, aNewFields := {}, GetList :={}
lChangedName := IIF(Valtype(lChangedName)='L',lChangedName,.f.)
lChangedType := IIF(Valtype(lChangedType)='L',lChangedType,.f.)
lPrompt := IIF(Valtype(lPrompt)='L',lPrompt,.t.)
lTestDict := IIF(Valtype(lTestDict)='L',lTestDict,.f.)
IF DC_IsStru( aStructure )
RETURN .t.
ENDIF
lGui := DC_Gui(.t.)
cOldAlias := ALIAS()
lError := .t.
BEGIN SEQUENCE
IF !EMPTY(cOldAlias)
lNewFile := !(cNewFileName == DC_DbfName()) .AND. !Empty(cNewFileName)
cOldRdd := DC_SETRDD()
cOldFileName := DC_DBFNAME()
lIsShared := DC_IsShared()
lReadOnly := DC_ReadOnly()
IF lIsShared .OR. lReadOnly
* IF !lPrompt .OR. DC_MsgBox(,,{IIF(lIsShared,DC_STRMSG_1_1,DC_STRMSG_1_2),;
* DC_STRMSG_1_3, DC_STRMSG_1_4, DC_STRMSG_1_5 },,,,.t.)
IF !lPrompt
IF !DC_IsCombined()
aIndex := DC_IndexSave()
ENDIF
CLOSE
DC_UseArea( .f., cOldRdd, cOldFileName, cOldAlias, .f., .f.,;
.f., , @lError )
IF lError
* DC_MsgBox(,,{DC_STRMSG_1_6,DC_STRMSG_1_7},,.t.)
DC_UseArea( .f., cOldRdd, cOldFileName, cOldAlias, .t., .f.)
lError := .f.
BREAK
ENDIF
IF !DC_IsCombined()
DC_IndexRestore(aIndex)
ENDIF
ENDIF
ENDIF
FOR i := 1 TO LEN(aStructure)
ASize( aStructure[i],7 )
IF Empty(aStructure[i,5])
aStructure[i,5] := aStructure[i,1]
aStructure[i,6] := aStructure[i,2]
ENDIF
aStructure[i,1] := TRIM(aStructure[i,1])
aStructure[i,5] := TRIM(aStructure[i,5])
IF !( aStructure[i,1] == aStructure[i,5] )
lChangedName := .t.
ENDIF
IF !( aStructure[i,2] == aStructure[i,6] )
lChangedType := .t.
ENDIF
IF aStructure[i,2] == 'CA'
aStructure[i,2] := 'M'
ENDIF
NEXT
IF lChangedName
nFieldCount := 1
ASIZE( aOldFields, LEN(aStructure) )
AFILL(aOldFields,'')
ASIZE( aNewFields, LEN(aStructure) )
AFILL(aNewFields,'')
FOR i := 1 TO LEN(aStructure)
IF !(aStructure[i,1]==aStructure[i,5])
aOldFields[nFieldCount] := PAD(aStructure[i,5],10)
aNewFields[nFieldCount] := PAD(aStructure[i,1],10)
nFieldCount++
ENDIF
NEXT
ENDIF
* IF (lChangedName .OR. lChangedType) .AND. lPrompt .AND. ;
* !DC_MsgBox(,,{ Alias(),'', DC_STRMSG_2_1, DC_STRMSG_2_2, ;
* DC_STRMSG_2_3,DC_STRMSG_2_4 },,,,.t.)
IF (lChangedName .OR. lChangedType) .AND. lPrompt
lError := .f.
BREAK
ENDIF
cBakFileName := SubStr( cOldFileName, 1, AT('.',cOldFileName)) + 'DBK'
cOldDbtName := DC_DBTNAME()
cOldCdxName := DC_CDXNAME()
cBakDbtName := SubStr( cOldDbtName, 1, AT('.',cOldFileName)) + 'DTK'
cBakCdxName := SubStr( cOldCdxName, 1, AT('.',cOldFileName)) + 'CDK'
cOldFileExt := DC_DBFEXT( , cOldFileName )
cOldDbtExt := DC_DBTEXT( , cOldDbtName )
cPath := DC_PATH( cOldFileName, .f. ) // get path of old file name
cNewDbtName := cOldDbtName
cNewFileExt := DC_DBFEXT( , cNewFileName )
cNewDbtExt := DC_DBTEXT( , cNewDbtName )
cNewFileName := DC_Path(cNewFileName,.t.)
IF '.' $ cNewFileName
cNewFileName := SubStr(cNewFileName,1,AT('.',cNewFileName)-1)
ENDIF
IF !lNewFile
cNewFileName := cOldFileName
cNewDbtName := cOldDbtName
FOR i := 1 TO 99
cBakData := 'BAKDAT'+ALLTRIM(STR(i))
IF !FILE(cPath + cBakData +cOldFileExt)
EXIT
ENDIF
NEXT
ELSE
cNewFileName := cPath + cNewFileName + cNewFileExt
cNewDbtName := cPath + STRTRAN( cNewFileName, ;
IIF(Empty(cNewFileExt),' ',cNewFileExt), cNewDbtExt )
cBakData := cOldFileName
cPath := ''
cOldFileExt := ''
ENDIF
* cSaveScreen := DC_Expl( 8,10,20,70, DC_STRMSG_3)
BEGIN SEQUENCE
lDeleted := Set(_SET_DELETED,.f.)
CLOSE
IF !lNewFile
* DC_Say(cSaveScreen,2,3,DC_STRMSG_4)
FErase( ( cPath + cBakData + cOldFileExt ) )
FRename( (cOldFileName), ( cPath + cBakData + cOldFileExt ) )
IF !EMPTY(cOldDbtName)
FErase( ( cPath + cBakData + cOldDbtExt ) )
FRename( (cOldDbtName), ( cPath + cBakData + cOldDbtExt ) )
ENDIF
FErase( ( cPath + cBakData + '.CDX' ) )
FRename( (cOldCdxName), ( cPath + cBakData + '.CDX' ) )
* DC_Say(cSaveScreen,4,3,DC_STRMSG_5)
ENDIF
cOldSetRdd := DbeSetDefault()
DbeSetDefault( cOldRdd )
aStruCreate := AClone(aStructure)
FOR i := 1 TO LEN(aStruCreate)
ASize(aStruCreate[i],4)
NEXT
DbCreate( cNewFileName, aStruCreate, cOldRdd )
* 'Using '+cNewFileName
* DC_Say(cSaveScreen,6,3,DC_STRMSG_6)
CLOSE
IF lNewFile
cNewAlias := NIL
ELSE
cNewAlias := cOldAlias
ENDIF
DC_USEAREA( .f., cOldRdd, cNewFileName, cNewAlias, .f., .f.,,,,.f. )
nWorkArea := SELE()
DC_DO('DC_BrowClear("' +Str(nWorkArea) + '")',,.f.)
* 'Appending from BACKUP data files... '
* DC_Say(cSaveScreen,8,3,DC_STRMSG_7)
IF lChangedType .OR. lChangedName
SELE 0
DC_USEAREA( .f., cOldRdd, cPath+cBakData+cOldFileExt , , .f., .f. )
// lDeleted := SET(_SET_DELETED,.t.)
GO TOP
DO WHILE !EOF() .AND. Inkey()#K_ESC
IF RecNo() % 100 == 0
* DC_Say(cSaveScreen,10,3,STR(RECNO(),7))
ENDIF
SELECT (nWorkArea)
APPE BLANK
FOR nFieldCount := 1 TO FCOUNT()
cFieldName := FieldName(nFieldCount)
cNewField := cFieldName
nFieldLoc := ASCAN(aNewFields,PAD(cFieldName,10))
IF nFieldLoc>0
IF EMPTY(ALLTRIM(aOldFields[nFieldLoc]))
LOOP
ENDIF
cFieldName := (cBakData)+'->'+ALLTRIM(aOldFields[nFieldLoc])
cNewField := ALLTRIM(aNewFields[nFieldLoc])
ELSE
cFieldName := (cBakData)+'->'+cFieldName
ENDIF
cFieldType := DC_FLDTYPE(cFieldName)
DO CASE
CASE cFieldType$'CMA'
cFieldName := &(cFieldName)
CASE cFieldType='N'
cFieldName := STR(&(cFieldName))
CASE cFieldType='D'
cFieldName := DTOC(&(cFieldName))
CASE cFieldType='L'
cFieldName := IIF(&(cFieldName),'Y','N')
CASE cFieldType='U'
IF Valtype(aStructure[nFieldCount,7]) == Valtype(&(cNewField))
cFieldName := DC_XtoC(aStructure[nFieldCount,7])
ELSE
cFieldName := ''
ENDIF
ENDCASE
cNewType := VALTYPE(&(cNewField))
DO CASE
CASE cNewType$'CMA'
REPL &(cNewField) WITH cFieldName
CASE cNewType='N'
IF LEN(STR(INT(&(cNewField))))>=LEN(ALLTRIM(STR(INT(VAL(cFieldName)))))
REPL &(cNewField) WITH VAL(cFieldName)
ENDIF
CASE cNewType='D'
REPL &(cNewField) WITH CTOD(cFieldName)
CASE cNewType='L'
REPL &(cNewField) WITH IIF(cFieldName='Y',.t.,.f.)
ENDCASE
NEXT
IF (cBakData)->(Deleted())
dbDelete()
ENDIF
DC_DBSEL(cBakData)
SKIP
ENDDO
DC_DBSEL(cBakData)
CLOSE
ELSE
DC_Escape(nil,nil,.t.,0,@oDlg)
APPEND FROM ( cPath + cBakData + cOldFileExt ) ;
;// FOR !Deleted() ;
WHILE !DC_Escape(17,12,.t.,1,oDlg) VIA (cOldRdd)
DC_Escape(nil,nil,nil,2,oDlg)
ENDIF
DbeSetDefault( cOldSetRdd )
SELE (nWorkArea)
GOTO TOP
DC_SETORDER(1)
COMMIT
lConfirm := .f.
Set(_SET_DELETED,lDeleted)
IF !lNewFile
FErase( ( cBakFileName ) )
FRename( ( cPath + cBakData + cOldFileExt ), ( cBakFileName ) )
IF !EMPTY(cOldDbtName)
FErase( ( cBakDbtName ) )
FRename( ( cPath + cBakData + cOldDbtExt ), ( cBakDbtName ) )
ENDIF
FErase( ( cBakCdxName ) )
FRename( ( cPath + cBakData + '.CDX' ), ( cBakCdxName ) )
ENDIF
/*
* IF DC_MsgBox(,,{DC_STRMSG_8},,,,.t.)
ERASE ( cBakFileName )
IF !EMPTY( cOldDbtName )
ERASE ( cBakDbtName )
ENDIF
* ENDIF
*/
END SEQUENCE
DC_IMPL(cSaveScreen)
IF !Empty(DC_IndexName())
cScrn := DC_WaitOn('Reindexing. Please wait...')
REINDEX
DC_Impl(cScrn)
ENDIF
IF DC_DbSel(cNewAlias)
CLOSE
DC_UseArea( .f., cOldRdd, cOldFileName, cOldAlias, lIsShared, lReadOnly )
ENDIF
IF lTestDict
DC_FieldLoad ( Alias(),,.f.,,,,, .t. )
ENDIF
ELSE
* DC_MsgBox(,,{DC_STRMSG_9},,.t.)
lError := .f.
ENDIF
END SEQUENCE
*DC_Gui(lGui)
RETURN lError
* -----------------
FUNCTION dc_isstru ( aNewStru, nError, lExactMatch, lChangedType,;
lChangedName )
LOCAL aCurrStru := DBSTRUCT(), i, nNewLen, nCurrLen
lExactMatch := IIF(Valtype(lExactMatch)='L',lExactMatch,.t.)
nError := 0
IF Empty( aCurrStru )
nError := 2
RETURN .f.
ELSEIF Valtype( aNewStru ) # 'A'
nError := 3
RETURN .f.
ENDIF
nCurrLen := LEN(aCurrStru)
nNewLen := LEN(aNewStru)
FOR i := 1 TO nNewLen
IF i > nCurrLen
nError := 4
EXIT
ENDIF
IF !(UPPER(PAD(aNewStru[i,1],10))==UPPER(PAD(aCurrStru[i,1],10)))
lChangedName := .t.
nError := 5
ENDIF
IF !(aNewStru[i,2]==aCurrStru[i,2])
IF UPPER(aNewStru[i,2])=='CA' .AND. UPPER(aCurrStru[i,2])=='M'
LOOP
ENDIF
lChangedType := .t.
nError := 5
ELSEIF aNewStru[i,2] = 'M' .AND. aCurrStru[i,2] = 'M'
LOOP
ENDIF
IF nError = 0 .AND. ( (aNewStru[i,3]#aCurrStru[i,3]) .OR. ;
(aNewStru[i,4]#aCurrStru[i,4]) )
nError := 5
ENDIF
NEXT
IF nError >= 4
RETURN .f.
ENDIF
IF nCurrLen > nNewLen
nError := 1
IF lExactMatch
RETURN .f.
ENDIF
ELSE
nError := 0
ENDIF
RETURN .t.
************************************************************************************