// Copyright (c) 1993-2005 "Компания БЭСТ". Все права сохраняются.

//Titov - Export to Excel


#INCLUDE "inkey.ch"
#INCLUDE "s_public.ch"
#include "achoice.ch"
#include "fileio.ch"
#include "hdll.ch"
#include "directry.ch"
#include "excel.ch"
#include "assocarr.ch"


#define NAMESPACE "http://bestnet.ru/xmlns/"


STATIC aResultCol:={},aRes0:={}
STATIC cListSep,cDecSep,lIsRus


STATIC cc1:=" ."
STATIC cc2:="__"

STATIC sVidImport



PROCEDURE NewExportImport()
LOCAL cSpecKey:=GetSpecKey()
LOCAL nWi:=WSELECT()
LOCAL cFile:=SPACE(60)
LOCAL GetList:={}
LOCAL cScreen:=SAVESCREEN()
LOCAL nArea:=SELECT()
LOCAL aSave:=DbSave()
LOCAL nRec:=RECNO(),cKey:=GetSpecKey()
LOCAL aSelect:={;
"  Экспорт в MS Excel            ",;
"  Экспорт в MS Excel по шаблону ",;
"  Импорт из MS Excel            ",;
"  Разметка шаблона              ",;
"  Экспорт в XML                 ",;
"  Импорт из XML                 ",;
"  Экспорт в OO Calc 2.0         ";
}

LOCAL aSelectType:={;
"ToExcel",;
"ToExcelTemplate",;
"FromExcel",;
"Template",;
"ToXml",;
"FromXml",;
"ToCalc";
}


LOCAL cColor,aSetKey,cTrap,nSelectMode,cSelectType,aFields,lEof


altd()


IF SELECT('CARGO')>0.AND.Cargo->(LASTREC())>=199
   Cargo->(DBGOTO(199))
   IF !Parol(Cargo->Cargo)
      WSELECT(nWi)
      RETURN
   ENDIF
ENDIF


NetUse("Tables",_PRO_PATH+"dic\b4tables",,,,.T.)
lEof:=Tables->(EOF())
IF !_REC_YES.OR.!(DbSeek(GetxKey(nArea)).AND.;
   (;
   (Import=="1".AND.!EMPTY(FIELD->TagName)).OR.;
   Import=="2";
   );
   )
   ADEL(aSelect,3)
   ADEL(aSelectType,3)
   ASIZE(aSelect,LEN(aSelect)-1)
   ASIZE(aSelectType,LEN(aSelectType)-1)
   ADEL(aSelect,5)
   ADEL(aSelectType,5)
   ASIZE(aSelect,LEN(aSelect)-1)
   ASIZE(aSelectType,LEN(aSelectType)-1)
ELSE
   sVidImport:=FIELD->Import
   //"1" - стандартный по индексу
   //"2" - по спецфункции
ENDIF

SELECT(nArea)
IF lEof
   WSELECT(nWi)
   RETURN
ENDIF


cTrap:=TRAPSHIFT("")
cColor:=SETCOLOR(COL_HEADR)
aSetKey:=SAVESETKEY()


altd()
IF EMPTY(aResultCol:=GetCheckPos())
   nSelectMode:=0
ELSE
   nSelectMode:=aResultCol[1]
   IF LEN(aResultCol)>1
      cFile:=aResultCol[2]
      IF "."$cFile
         cFile:=LEFT(cFile,AT(".",cFile)-1)
      ENDIF
      ADEL(aResultCol,1)
      ASIZE(aResultCol,LEN(aResultCol)-1)
   ENDIF
   ADEL(aResultCol,1)
   ASIZE(aResultCol,LEN(aResultCol)-1)
ENDIF


nSelectMode:=BoxMenu("",5,10,aSelect,,nSelectMode)

WSELECT(0)


IF LASTKEY()!=K_ESC.AND.nSelectMode>0
   cSelectType:=aSelectType[nSelectMode]
   DO CASE
      CASE cSelectType == "ToExcel".AND.!EMPTY(aFields:=SelectFields(,.T.,256,,cKey+"E"))
         ExportToExcel(,aFields,,cKey+"E")
      CASE cSelectType == "ToExcelTemplate".AND.!EMPTY(cFile:=InputFile(cFile,".xlt",.T.,.T.,cKey+"E")).AND.LASTKEY()!=K_ESC.AND.;
         !EMPTY(aFields:=SelectFields(.T.))
         ExportToExcel(,aFields,OemToAnsi(cFile),cKey+"E")
      CASE cSelectType == "FromExcel".AND.!EMPTY(cFile:=InputFile(cFile,".xls",,,IF(sVidImport=="2",cKey+"I",NIL))).AND.LASTKEY()!=K_ESC.AND.;
         !EMPTY(aFields:=SelectFields(.T.))
         ImportFromExcel(OemToAnsi(cFile),aFields,,cKey+"I")
      CASE cSelectType == "Template".AND.(cFile:=InputFile(cFile,".xlt",.T.,.T.))==cFile.AND.LASTKEY()!=K_ESC.AND.;
         !EMPTY(aFields:=SelectFields(.T.))
         CreateXLSTemplate(aFields,OemToAnsi(cFile))
      CASE cSelectType == "ToXml".AND.!EMPTY(cFile:=InputFile(cFile,".xml",.T.,,cKey+"E")).AND.LASTKEY()!=K_ESC.AND.;
         !EMPTY(aFields:=SelectFields(,.T.,,.T.,cKey+"E"))
         ExportToXml(OemToAnsi(cFile),aFields,cKey+"E")
      CASE cSelectType == "FromXml".AND.!EMPTY(cFile:=InputFile(cFile,".xml",,,IF(sVidImport=="2",cKey+"I",NIL))).AND.LASTKEY()!=K_ESC.AND.;
         !EMPTY(aFields:=SelectFields(.T.,,,.T.))
         ImportFromXml(OemToAnsi(cFile),aFields,,cKey+"I")
      CASE cSelectType == "ToCalc".AND.!EMPTY(aFields:=SelectFields(,.T.,256,,cKey+"E"))
         ExportToCalc(aFields,cKey+"E")

   ENDCASE
   SetCheckPos(nSelectMode,aResultCol,cFile)
ENDIF
WSELECT(nWi)
RESTSETKEY(aSetKey)
TRAPSHIFT(cTrap)
RESTSCREEN(,,,,cScreen)
SETCOLOR(cColor)
IF SELECT("Tables")>0
   Tables->(DbCloseArea())
ENDIF
SELECT(nArea)
DbRest(aSave)
altd()
IF !EMPTY(ALIAS())
   DbGoto(nRec)
ENDIF
RETURN 2



FUNCTION ExportToXML(cFile,aFields,cKey)
LOCAL oXml,oElement,o,cTable:=" ",oBestData,cAliasName
LOCAL i:=1,j,k,nRec,oTableRoot
LOCAL aTable:={},cTable0:="X",cTable1,cFi,cTableNew,cFiNew,n:=0,xVal,cTemp,cTempi,nArea:=SELECT()
LOCAL nProces,cNameSpace,cOrder,aKeyFields
LOCAL aStru:={;
{"REC","N",8,0};
}
LOCAL cAlias:=ALIAS()
altd()


TRY
   oXml := CreateObject( "MSXML2.DomDocument.4.0" )
CATCH
   Alert( "MsXml2 не доступен!")
   RETURN NIL
END


oXml:setProperty("NewParser",.T.)


IF EMPTY(cFile)
  IF !EMPTY(aResultCol:=GetCheckPos())
     cFile:=aResultCol[2]
  ENDIF
  IF !EMPTY(cFile:=InputFile(cFile,".xml",.T.)).AND.LASTKEY()!=K_ESC
     SetCheckPos(0,{0},cFile)
     cFile:=OemToAnsi(cFile)
  ELSE
     RETURN NIL
  ENDIF
ENDIF
cFile:=ALLTRIM(cFile)
IF UPPER(RIGHT(cFile,4))$".XML.XSD"
   cFile:=LEFT(cFile,LEN(cFile)-4)
ENDIF


altd()


F_EvalAltX(cKey)




nProces:=Proces_ini(LASTREC(),,, "Экспорт в XML")


cTable1:=IF(EMPTY(aFields[1,1]).OR.SELECT(aFields[1,1])==0,ALIAS(),aFields[1,1])
cAliasName:=MyTable(aFields[1],.T.)



FOR i:=1 TO LEN(aFields)
cTable:=IF(EMPTY(aFields[i,1]).OR.SELECT(aFields[i,1])==0,ALIAS(),aFields[i,1])
cFi:=aFields[i,2]
cTableNew:=MyTable(aFields[i],.T.)

cFiNew:=MyAlias(aFields[i],.T.)
cOrder:=GetOrder(aFields,i)


IF !UPPER(cTable)==UPPER(cTable0)
   aKeyFields:=(cTable)->(GetKeyFields(IF(UPPER(cTable)==UPPER(cTable1),cOrder,ORDSETFOCUS())))
   AADD(aTable,{;
    cTable,;
    {},;
    aKeyFields,;
    {},;
    (cTemp:=TempFile(m->GlobalTmpPath,"dbf")),;
    (cTempi:=TempFile(m->GlobalTmpPath,"cdx")),;
    cTableNew;
    })
   n:=LEN(aTable)
   IF !UPPER(cTable)==UPPER(cTable1) //если не первая
      dbCreate(cTemp,aStru)
      USE (cTemp) ALIAS ("Temp"+ALLTRIM(STR(n))) EXCLUSIVE NEW
      INDEX ON FIELD->REC TO (cTempi)
      SELECT(nArea)
   ENDIF
   cTable0:=cTable
ENDIF
IF !EMPTY(cFi)
   AADD(aTable[n,2],{UPPER(cFiNew),UPPER(cFi)})
   IF !UPPER(cFi) in aTable[n,3]
      AADD(aTable[n,4],UPPER(cFi))
   ENDIF
ENDIF
NEXT


cNameSpace:=NAMESPACE + cAliasName


oXml:appendChild(oXml:createProcessingInstruction('xml', 'version="1.0" encoding='+GetCPXML()))
oElement:=oXml:AppendChild(oXml:createElement("bestdata"))

oElement:setAttribute("xmlns",cNameSpace)


nArea:=SELECT()

FOR i:=1 TO LEN(aTable)
cTable:=LOWER(aTable[i,1])
cTableNew:=LOWER(aTable[i,7])
DbSelectArea(cTable)

oTableRoot:=oElement:AppendChild(oXml:createNode(1,cTableNew,cNameSpace))

nRec:=RECNO()
DbGoTop()
WHILE !EOF()

   Proces_Update(nProces)
   IF LEN(aTable)>1.AND.i=1
      FOR j:=2 TO LEN(aTable)
      DbSelectArea("Temp"+ALLTRIM(STR(j)))
      IF !(aTable[j,1])->(EOF()).AND.!DBSEEK((aTable[j,1])->(RECNO()))
         APPEND BLANK
         REPLACE Rec WITH (aTable[j,1])->(RECNO())
      ENDIF
      NEXT
      SELECT(nArea)
   ENDIF

   IF i==1.OR.("Temp"+ALLTRIM(STR(i)))->(DBSEEK((aTable[i,1])->(RECNO())))

      o:=oTableRoot:AppendChild(oXml:createNode(1,cTableNew+"item",cNameSpace))

      FOR j:=1 TO LEN(aTable[i,2])

      xVal:=xmlVal(&(aTable[i,2,j,2]))
      o:SetAttribute(LOWER(aTable[i,2,j,1]),xVal)
      NEXT

   ENDIF
   SKIP
ENDDO
DbGoto(nRec)
NEXT


FOR i:=1 TO LEN(aTable)
IF !EMPTY(SELECT("Temp"+ALLTRIM(STR(i))))
   ("Temp"+ALLTRIM(STR(i)))->(DbCloseArea())
ENDIF
FERASE(aTable[i,5])
FERASE(aTable[i,6])
NEXT
SELECT(nArea)

oXml:save(cFile+".xml")

oXml:=NIL

Proces_End(nProces)

RETURN 1



STATIC FUNCTION GetXmlType(cType)
DO CASE
   CASE cType$"CM"
   RETURN "xs:string"
   CASE cType=="N"
   RETURN "xs:decimal"
   CASE cType=="D"
   RETURN "xs:date"
   CASE cType=="L"
   RETURN "xs:boolean"
ENDCASE
RETURN "xs:string"



FUNCTION ImportFromXml(cFile,aFields,nArray,cKey)
//aFields: cAlias,cField,cAliasA,cFieldA
//lArray - выдать в массиве

LOCAL oXml,tables,table,rows,row
LOCAL cTable,cOrder
LOCAL oldOrder,oldScope,oldFilter
LOCAL aa:={},xKey
LOCAL i,j,k,n,cField,cField0,xValue
LOCAL cOldTrapShift
LOCAL nArea:=SELECT(),nOrd:=ORDSETFOCUS(),nRec:=RECNO()
LOCAL aVal:={},nFile
LOCAL nAll,nAdd,nEdit,nProces,lAdd,lEdit
LOCAL cAlias0:=ALIAS(),cAlias,lContinue:=.T.,lNoSay:=.F.
LOCAL aFieldName,aFieldValue,nFieldNum
LOCAL lTemp,lArray:=nArray!=NIL
LOCAL cTemp,lSpec:=IsFeval(cKey),aAlias:={}

IF sVidImport=="2".AND.!lSpec
   SayError("Настройка импорта предполагает наличие спецфункции для импорта!")
   RETURN aVal
ENDIF

lSpec:=lSpec.AND.sVidImport=="2"


PRIVATE cKeyExp

AADD(aa,"                              │Обработано│Добавлено│Заменено│  Оставлено  ")
AADD(aa,"           Таблица            │ записей  │         │        │без изменений")
AADD(aa,"──────────────────────────────┼──────────┼─────────┼────────┼─────────────")



TRY
   oXml := CreateObject("MSXML2.DomDocument.4.0")
CATCH
   Alert( "MsXml не доступен!")
   RETURN aVal
END


oXml:setProperty("NewParser",.T.)


cOldTrapShift := TRAPSHIFT("")

altd()

IF EMPTY(cFile)
  IF !EMPTY(aResultCol:=GetCheckPos())
     cFile:=aResultCol[2]
  ENDIF
  IF !EMPTY(cFile:=InputFile(cFile,".xml")).AND.LASTKEY()!=K_ESC
     SetCheckPos(0,{0},cFile)
     cFile:=OemToAnsi(cFile)
  ELSE
     TRAPSHIFT(cOldTrapShift)
     RETURN aVal
  ENDIF
ELSE
  cFile:=ALLTRIM(cFile)
ENDIF


IF UPPER(RIGHT(cFile,4))==".XML"
   cFile:=LEFT(cFile,LEN(cFile)-4)
ENDIF

lTemp:="\B4P"$UPPER(cFile)


oXml:async:=.F.
oXml:load(cFile+".xml")

busy(.T.,"Загрузка данных")


tables = oXml:selectNodes("/*/*")

FOR i:=0 TO tables:length-1 //цикл по таблицам
aFieldName:=NIL
nAll:=nAdd:=nEdit:=0
table:=tables:item(i)
cTable:=table:nodeName
IF ":"$cTable
   cTable:=SUBSTR(cTable,AT(":",cTable)+1)
ENDIF
IF (j:=ASCAN(aFields,{|x|UPPER(x[1])==UPPER(cTable).OR.UPPER(x[3])==UPPER(cTable).OR.UPPER(x[7])==UPPER(cTable)   }) )==0.AND.i>0
//   lContinue:=.F.
   EXIT
ENDIF
cAlias:=IF(j==0.OR.EMPTY(aFields[j,1]),ALIAS(),aFields[j,1])


DbSelectArea(cAlias)
IF !AllowImport()
   LOOP
ENDIF



IF lSpec
   cTemp:=TempFile(m->GlobalTmpPath,"dbf")
   dbCreate(cTemp,DbStruct())
   USE (cTemp) ALIAS (cAlias:="u"+cAlias) EXCLUSIVE NEW
   altd()
   AADD(aAlias,{cAlias,cTemp})
   &(cAlias):=ARRAY(FCOUNT()) //PRIVATE
   AFILL(&(cAlias),.F.)
ELSEIF i==0
   cOrder:=GetOrder(aFields,j)
   OldOrder:=ORDSETFOCUS(cOrder)
   OldScope:=SetScope()
   OldFilter:=DBFILTER()
   SET FILTER TO
   cKeyExp:=OrdKey()
   IF EMPTY(cKeyExp).AND.!lArray.AND.!lTemp
      IF !(lContinue:=YesOrNo(;
          "Для данной таблицы возможно только добавление записей!"+CHR(13)+CHR(10)+;
           "Добавить записи?"))
         lNoSay:=.T.
         EXIT
      ENDIF
   ENDIF
ELSE
   cKeyExp:=OrdKey()
ENDIF



rows:=table:childnodes()


nProces:=Proces_ini(rows:length-1,,, "Импорт")




FOR j:=0 TO rows:length-1 //цикл по записям
Proces_Update(nProces)


row:=rows:item(j)


IF aFieldName==NIL
   //формирование перечня регулярных полей
   aFieldName:={}
   FOR n:=0 TO row:attributes:length-1
   cField0:=row:attributes:item(n):name

   k:=MyAscan(aFields,cField0,lArray)
   IF k>0
      IF FIELDNUM(aFields[k,2])>0
         cField:=aFields[k,2]
      ELSEIF lArray.AND.FIELDNUM(aFields[k,4])>0
         cField:=aFields[k,4]
      ELSEIF lArray.AND.LEN(aFields[k])>7.AND.FIELDNUM(aFields[k,8])>0
         cField:=aFields[k,8]
      ENDIF
      nFieldNum:=FIELDNUM(cField)
      AADD(aFieldName,{cField,FIELDTYPE(nFieldNum),;
      FIELDLEN(nFieldNum),n,nFieldNum})
      IF lSpec.AND.!&(cAlias)[nFieldNum]
         &(cAlias)[nFieldNum]:=.T.
      ENDIF
   ENDIF
   NEXT
ENDIF
IF lArray
   IF LEN(aFieldName)<nArray
      lContinue:=.F.
   ENDIF
ELSEIF LEN(aFieldName)=0
   lContinue:=.F.
   EXIT
ENDIF


aFieldValue:={}
IF !lArray
   SELECT(0)
ENDIF


FOR n:=1 TO LEN(aFieldName)
cField:=aFieldName[n,1]
xValue:=(GetXmlValue(;
   AnsiToOem(row:attributes:item(aFieldName[n,4]):value),;
   aFieldName[n,2],aFieldName[n,3]))
&cField:=xValue
AADD(aFieldValue,xValue)
NEXT
IF !lContinue
   EXIT
ENDIF
IF lArray
   AADD(aVal,aFieldValue)
ELSE
   lAdd:=.F.
   lEdit:=.F.
   IF !EMPTY(cKeyExp)
      IF !TYPE(cKeyExp)$"CN"
         IF i=0
            lContinue:=.F.
            DbSelectArea(cAlias)
            EXIT
         ELSE
            xKey:=""
         ENDIF
      ELSE
         xKey:=&(cKeyExp)
      ENDIF
   ENDIF
   DbSelectArea(cAlias)
   nAll++
   IF lSpec.OR.(i==0.AND.EMPTY(cKeyExp)).OR.(!EMPTY(xKey).AND.!DBSEEK(xKey))
      nAdd++
      AddRec()
      lAdd:=.T.
   ELSE
      RecLock()
   ENDIF
//   IF lAdd.OR.i==0
      FOR n:=1 TO LEN(aFieldName)
      IF aFieldName[n,2]!="M".AND.!(&(aFieldName[n,1])==aFieldValue[n])

         FIELDPUT(aFieldName[n,5],aFieldValue[n])
         lEdit:=.T.
      ENDIF
      NEXT
//   ENDIF
   IF !lAdd.AND.lEdit
      nEdit++
   ENDIF
   UNLOCK
ENDIF
NEXT


IF !lArray.AND.!lSpec
   AADD(aa,PADR(RIGHT(dbinfo(10),30),30)+"│"+STR(nAll,10,0)+"│"+STR(nAdd,9,0)+"│"+STR(nEdit,8,0)+"│"+STR(nAll-nAdd-nEdit,13,0))
ENDIF

IF i==0.AND.!lSpec
   OldOrder:=ORDSETFOCUS(oldOrder)
   OldScope:=SetScope(oldScope)
   IF !EMPTY(oldFilter)
      dbSetFilter(&("{||"+oldFilter+"}"),oldFilter)
   ENDIF
ENDIF


Proces_End(nProces)

oXml:=NIL

IF !lContinue
   EXIT
ENDIF

NEXT

IF lSpec.AND.LEN(aAlias)>0
   SELECT(aAlias[1,1])
   GO TOP
   F_EvalAltX(cKey)

altd()
   FOR i:=1 TO LEN(aAlias)
   IF SELECT(aAlias[i,1])>0
      (aAlias[i,1])->(DbCloseArea())
   ENDIF
   FERASE(aAlias[i,2])
   NEXT
ENDIF

SELECT(nArea)
ORDSETFOCUS(nOrd)
DbGoTo(nRec)


busy(.F.)

IF !lContinue
   aVal:={}
   IF !lNoSay
      SayError("XML-файл не соответствует"+CHR(13)+CHR(10)+;
     "структуре принимающей таблицы!")
   ENDIF
ELSEIF !lArray .AND.!lNoSay.AND.!lTemp.AND.!lSpec
   ShadowBox(" Импортировано: ",16-LEN(aa)-1,(80-LEN(aa[1]))/2-1,16,(80-LEN(aa[1]))/2+LEN(aa[1]),COL_HEADR,FRAMES1,,,"noShadow")
   FOR i:=1 TO LEN(aa)
   SAYSCREEN(aa[i],16-LEN(aa)-1+i,(80-LEN(aa[1]))/2)
   NEXT
   inkey(0)
ENDIF
TRAPSHIFT(cOldTrapShift)
RETURN aVal





FUNCTION ImportFromExcel(cFile,aFields,nArray,cKey)
//aFields:={cTable,cFi,cNewTable,cNewFi,cHead,cTagName,cNewTable1,cNewFi1}

LOCAL oApp,oName,cName,aName:={},aName0:={}
LOCAL cTable,cTable0,cDbfName,cOrder,OldOrder,OldScope,oldFilter
LOCAL oWorkBook,oAS
LOCAL xKey,aFieldValue:={}
LOCAL i,j,k,n,cField,cField0,xValue
LOCAL cOldTrapShift
LOCAL nArea:=SELECT(),nOrd:=ORDSETFOCUS(),nRec:=RECNO()
LOCAL aVal:={},nFile,nRow1,nRow2,lRow1
LOCAL aa:={},nAll:=0,nProces,lAdd
LOCAL cAlias0:=ALIAS(),cAlias,lContinue:=.T.,lNoSay:=.F.
LOCAL lTemp,lArray:=(nArray!=NIL)
LOCAL cTemp,lSpec:=IsFeval(cKey),aAlias:={},aLogic,nProxod,lExit:=.F.
LOCAL jMax,lGo

IF VALTYPE(aFields)=="A"
   aLogic:=ARRAY(LEN(aFields))
   AFILL(aLogic,.F.)
ENDIF



IF sVidImport=="2".AND.!lSpec
   SayError("Настройка импорта предполагает наличие спецфункции для импорта!")
   RETURN aVal
ENDIF

lSpec:=lSpec.AND.sVidImport=="2"

altd()

PRIVATE cKeyExp


AADD(aa,"                              │Обработано│Добавлено│Заменено│  Оставлено  ")
AADD(aa,"           Таблица            │ записей  │         │        │без изменений")
AADD(aa,"──────────────────────────────┼──────────┼─────────┼────────┼─────────────")


IF EMPTY(cFile)
  IF !EMPTY(aResultCol:=GetCheckPos())
     cFile:=aResultCol[2]
  ENDIF
  IF !EMPTY(cFile:=InputFile(cFile,".xls")).AND.LASTKEY()!=K_ESC
     SetCheckPos(0,{0},cFile)
     cFile:=OemToAnsi(cFile)
  ELSE
     RETURN {}
  ENDIF
ENDIF
cFile:=ALLTRIM(cFile)

lTemp:="\B4P"$UPPER(cFile)


TRY
  oApp := CreateObject( "Excel.Application" )
CATCH
   Alert("Excel не доступен!")
   RETURN {}
END

cOldTrapShift := TRAPSHIFT("")

oApp:Visible := .F.
oWorkBook:=oApp:WorkBooks:Open(cFile)
oAS:=oWorkBook:Worksheets(1)
oAS:Activate()


//идем по именованным ячейкам 
//два прохода - без поиска синоминов и с поиском синонимов при необходимости

FOR nProxod:=1 TO 2
FOR i:=1 TO oApp:Names:count
oName:=oApp:Names:item(i)
cName:=UPPER(TRIM(oName:Name))

IF !(lRow1:=UPPER(RIGHT(cName,4))!="_END")
   cName:=LEFT(cName,LEN(cName)-4)
ENDIF

k:=MyAscan(aFields,cName,lArray,nProxod)
IF k>0.AND.!aLogic[k]
    cTable:=aFields[k,1]
    IF SELECT(cTable)==0
       cTable:=ALIAS()
    ENDIF
    cField:=aFields[k,2]
    IF TYPE(cTable+"->"+cField)!="U"
       IF lRow1
          TRY
             nRow1:=oName:referstorange:row
          CATCH
             LOOP
          END
       ELSE
          TRY
             nRow2:=oName:referstorange:row
          CATCH
             LOOP
          END
          aLogic[k]:=.T.
          IF UPPER(cTable)==UPPER(cAlias0)
             AADD(aName0,{"",cField,oName:referstorange:column,GetOrder(aFields,k)})
          ELSE
             AADD(aName,{cTable,cField,oName:referstorange:column,""})
          ENDIF
          lExit:=!.F.$aLogic
       ENDIF
    ENDIF
ENDIF
IF lExit
   EXIT
ENDIF
NEXT
IF lExit
   EXIT
ENDIF
NEXT


IF LEN(aName0)==0 //поищем в заголовке

   TRY
     jMax:=oAS:rows(i):End(xlToRight):column
   CATCH
     jMax:=250
   END


   FOR nProxod:=1 TO 2
   FOR i:=1 TO 10
   FOR j:=1 TO jMax
   cName:=oAS:Cells(i,j):Value

   IF (k:=MyAscan(aFields,cName,lArray,nProxod))>0.AND.!aLogic[k]
      cTable:=aFields[k,1]
      IF SELECT(cTable)==0
         cTable:=ALIAS()
      ENDIF
      cField:=aFields[k,2]
      IF TYPE(cTable+"->"+cField)!="U"
          aLogic[k]:=.T.
          IF UPPER(cTable)==UPPER(cAlias0)
             AADD(aName0,{"",cField,j,GetOrder(aFields,k)})
          ELSE
             AADD(aName,{cTable,cField,j,""})
          ENDIF
      ENDIF
      nRow1:=i+1
      IF nRow2==NIL
         nRow2:=oAS:Cells(oAS:Rows:Count,i):End(xlUp):Row
      ENDIF
   ENDIF
   lExit:=!.F.$aLogic
   NEXT
   IF nRow1!=NIL.AND.nRow1>0.OR.lExit
      EXIT
   ENDIF
   NEXT
   IF nRow1!=NIL.AND.nRow1>0.OR.lExit
      EXIT
   ENDIF
   NEXT
ENDIF


IF !(nRow1!=NIL.AND.nRow2!=NIL.AND.nRow2>=nRow1.AND.LEN(aName0)>0)
   lContinue:=.F.
ELSE
   aName:=ASORT(aName,,,{|x,y|UPPER(x[1])<=UPPER(y[1])})
   aName0:=ASORT(aName0,,,{|x,y|UPPER(x[1])<=UPPER(y[1])})


   FOR i:=1 TO LEN(aName)
   AADD(aName0,aName[i])
   NEXT
   aName:={}
   	
   cTable0:="!!!"
   FOR i:=1 TO LEN(aName0)
   IF !(UPPER(cTable0)==UPPER(aName0[i,1]))
      AADD(aName,{aName0[i,1],{},aName0[i,4],0,0})
      cTable0:=aName0[i,1]
      n:=LEN(aName)
   ENDIF
   AADD(aName[n,2],{aName0[i,2],aName0[i,3]})
   NEXT
//   aName == {cTable, {cField,col},cOrdKey,nAdd,nEdit}


   busy(.T.,"Загрузка данных")
   nProces:=Proces_ini(nRow2-nRow1+1,,, "Импорт")


   //altd()
   FOR j:=nRow1 TO nRow2 //цикл по записям
   nAll++
   Proces_Update(nProces)


   FOR i:=1 TO LEN(aName) //цикл по таблицам


   //altd()
   cAlias:=cTable:=aName[i,1]
   IF EMPTY(cAlias)
      cAlias:=cAlias0
   ENDIF

   DbSelectArea(cAlias)




   IF !AllowImport()
      LOOP
   ENDIF


   IF lSpec
      IF SELECT(cAlias:="u"+cAlias)==0
         cTemp:=TempFile(m->GlobalTmpPath,"dbf")
         dbCreate(cTemp,DbStruct())
         USE (cTemp) ALIAS (cAlias) EXCLUSIVE NEW
         AADD(aAlias,{cAlias,cTemp})
         &(cAlias):=ARRAY(FCOUNT()) //PRIVATE
         AFILL(&(cAlias),.F.)
      ELSE
         DbSelectArea(cAlias)
      ENDIF
   ELSEIF i==1
      cOrder:=aName[i,3]
      OldOrder:=ORDSETFOCUS(cOrder)
      OldScope:=SetScope()
      OldFilter:=DBFILTER()
      SET FILTER TO
      cKeyExp:=OrdKey()
      IF EMPTY(cKeyExp).AND.!lArray.AND.!lTemp
         IF !(lContinue:=YesOrNo(;
             "Для данной таблицы возможно только добавление записей!"+CHR(13)+CHR(10)+;
              "Добавить записи?"))
            lNoSay:=.T.
            EXIT
         ENDIF
      ENDIF
   ELSE
      cKeyExp:=OrdKey()
   ENDIF

   aFieldValue:={}
   IF !lArray
      SELECT(0)
   ENDIF



   FOR n:=1 TO LEN(aName[i,2]) //по полям
   cField:=aName[i,2,n,1]
   k:=(cAlias)->(FIELDNUM(cField))
   xValue:=(cAlias)->(GetXlsValue(oAS:Cells(j,aName[i,2,n,2]):Value,FIELDTYPE(k),FIELDLEN(k)))
   &cField:=xValue
   AADD(aFieldValue,xValue)
   IF lSpec.AND.!&(cAlias)[k]
      &(cAlias)[k]:=.T.
   ENDIF
   NEXT
   IF !lContinue
      EXIT
   ENDIF
   IF lArray
      AADD(aVal,aFieldValue)
   ELSE
      lAdd:=.F.
      IF !EMPTY(cKeyExp)
         IF !TYPE(cKeyExp)$"CN"
            IF i=1
               lContinue:=.F.
               DbSelectArea(cAlias)
               EXIT
            ELSE
               xKey:=""
            ENDIF
         ELSE
            xKey:=&(cKeyExp)
         ENDIF
      ENDIF
      DbSelectArea(cAlias)
      lGo:=.F.
      IF EMPTY(cKeyExp)
         AddRec()
         lAdd:=.T.
         lGo:=.T.
      ELSEIF !EMPTY(xKey)
         IF !DBSEEK(xKey)
            AddRec()
            lAdd:=.T.
            lGo:=.T.
         ELSEIF RecLock()
            lGo:=.T.
         ENDIF
      ENDIF
      IF lGo
         lGo:=.F.
         FOR n:=1 TO LEN(aName[i,2])
         IF lAdd.OR.!EquVal(&(aName[i,2,n,1]),aFieldValue[n])
            FIELDPUT(FIELDNUM(aName[i,2,n,1]),aFieldValue[n])
            lGo:=.T.
         ENDIF
         NEXT
         UNLOCK
         IF lGo
            aName[i,IF(lAdd,4,5)]++
         ENDIF

      ENDIF
   ENDIF

   IF i==1
      OldOrder:=ORDSETFOCUS(oldOrder)
      OldScope:=SetScope(oldScope)
      IF !EMPTY(oldFilter)
         dbSetFilter(&("{||"+oldFilter+"}"),oldFilter)
      ENDIF
   ENDIF

   NEXT


   IF !lContinue
      EXIT
   ENDIF

   NEXT

   Proces_End(nProces)



   IF !lArray.AND.!lSpec

      FOR i:=1 TO LEN(aName)
      IF i==1
         AADD(aa,PADR(RIGHT(STRTRAN(LOWER((nArea)->(dbInfo(10))),lower(LoadPath()),""),30),30)+"│"+STR(nAll,10,0)+"│"+STR(aName[i,4],9,0)+"│"+STR(aName[i,5],8,0)+"│"+STR(nAll-aName[i,4]-aName[i,5],13,0))
      ELSE
         AADD(aa,PADR(RIGHT(STRTRAN(LOWER((aName[i,1])->(dbInfo(10))),lower(LoadPath()),""),30),30)+"│"+STRS(0,10,0)+"│"+STR(aName[i,4],9,0)+"│"+STR(aName[i,5],8,0)+"│"+STRS(0,13,0))
      ENDIF
      NEXT
   ENDIF




ENDIF


oApp:Quit()


IF lSpec.AND.LEN(aAlias)>0
   SELECT(aAlias[1,1])
   GO TOP
   F_EvalAltX(cKey)
   FOR i:=1 TO LEN(aAlias)
   IF SELECT(aAlias[i,1])>0
      (aAlias[i,1])->(DbCloseArea())
   ENDIF
   FERASE(aAlias[i,2])
   NEXT
ENDIF

SELECT(nArea)
ORDSETFOCUS(nOrd)
DbGoTo(nRec)


busy(.F.)

IF !lContinue
   aVal:={}
   IF !lNoSay
      SayError("Excel-файл не соответствует"+CHR(13)+CHR(10)+;
     "структуре принимающей таблицы!")
   ENDIF
ELSEIF !lArray .AND.!lNoSay.AND.!lTemp.AND.!lSpec
   ShadowBox(" Импортировано: ",16-LEN(aa)-1,(80-LEN(aa[1]))/2-1,16,(80-LEN(aa[1]))/2+LEN(aa[1]),COL_HEADR,FRAMES1,,,"noShadow")
   FOR i:=1 TO LEN(aa)
   SAYSCREEN(aa[i],16-LEN(aa)-1+i,(80-LEN(aa[1]))/2)
   NEXT
   inkey(0)
ENDIF
TRAPSHIFT(cOldTrapShift)
RETURN aVal


















STATIC FUNCTION GetKeyFields(nOrder,lWithAlias,a)
LOCAL cc:="+-^*/%=;.(),><}[]"+'"'+"'"
LOCAL cOrdKey
LOCAL i,j,cToken
IF a==NIL
   a:={}
ENDIF
IF !EMPTY(nOrder)
   cOrdKey:=ORDKEY(nOrder)
   FOR i:=1 TO NumToken(cOrdKey,cc)
   cToken:=TOKEN(cOrdKey,cc,i)
   IF (j:=FIELDNUM(cToken))>0
      AADD(a,IF(lWithAlias==NIL,"",UPPER(ALIAS())+".")+UPPER(FIELDNAME(j)))
   ENDIF
   NEXT
ENDIF
RETURN ACLONE(a)


STATIC FUNCTION GetKeyRelationFields(cTable)
LOCAL cc:="+-^*/%=;.(),><}[]"+'"'+"'"
LOCAL cOrdKey,a:={}
LOCAL i,j,n,cToken

j:=0
WHILE (n:=DBRSELECT(++j))>0.AND.!UPPER(ALIAS(n))==UPPER(cTable);ENDDO
IF n>0
   cOrdKey:=dbRelation(j)
   IF !EMPTY(cOrdKey)
      FOR i:=1 TO NumToken(cOrdKey,cc)
      cToken:=TOKEN(cOrdKey,cc,i)
      IF (j:=FIELDNUM(cToken))>0
         AADD(a,UPPER(FIELDNAME(j)))
      ENDIF
      NEXT
   ENDIF
ENDIF
RETURN a


STATIC FUNCTION  GetXmlValue(xVal,cTypeVal,nLen)
DO CASE
   CASE cTypeVal='C'
   IF "&"$xVal
      IF "&lt;"$xVal
         xVal:=STRTRAN(xVal,"&lt;","<")
      ENDIF
      IF "&gt;"$xVal
         xVal:=STRTRAN(xVal,"&gt;",">")
      ENDIF
      IF "&apos;"$xVal
         xVal:=STRTRAN(xVal,"&apos;","'")
      ENDIF
      IF "&quot;"$xVal
         xVal:=STRTRAN(xVal,"&quot;",'"')
      ENDIF
      IF "&amp;"$xVal
         xVal:=STRTRAN(xVal,"&amp;","&")
      ENDIF
   ENDIF
   xVal:=PADR(xVal,nLen)
   CASE cTypeVal='N'
   xVal:=VAL(xVal)
   CASE cTypeVal='D'
   xVal:=STOD(STRTRAN(xVal,"-",""))
   CASE cTypeVal='L'
   xVal:=IF(xVal=="0".OR.xVal='F'.OR.xVal='.F.'.OR.UPPER(xVal)='FALSE',.F.,.T.)
//   CASE cTypeVal='A'
//   xVal:= InTextArray(ALLTRIM(xVal),cParam)
   OTHERWISE
   xVal:=NIL
ENDCASE
RETURN xVal


STATIC FUNCTION  GetXlsValue(xVal,cTypeVal,nLen)
DO CASE
   CASE cTypeVal$'CM'.AND.VALTYPE(xVal)$"CM"
   IF cTypeVal=="C"
      xVal:=PADR(AnsiToOem(xVal),nLen)
   ELSE
      xVal:=TRIM(AnsiToOem(STRTRAN(xVal,"##",CHR(13)+CHR(10))))
   ENDIF
   CASE cTypeVal$'CM'.AND.xVal==NIL
   xVal:=SPACE(nLen)
   CASE cTypeVal='N'.AND.xVal==NIL
   xVal:=0
   CASE cTypeVal='N'.AND.VALTYPE(xVal)=="C"
   xVal:=VAL(xVal)
   CASE cTypeVal="D".AND.VALTYPE(xVal)=="C"
   xVal:=CTOD(xVal)
   CASE cTypeVal="L".AND.VALTYPE(xVal)=="C".AND.xVal="True"
   xVal:=.T.
   CASE cTypeVal="L".AND.VALTYPE(xVal)=="C".AND.xVal="False"
   xVal:=.F.
ENDCASE
RETURN xVal



FUNCTION InputFile(cFile,cExt,lExport,lTemplate,cSpecKey)
LOCAL GetList:={},cColor:=SETCOLOR(COL_HEADR)
LOCAL aSetKey:=SaveSetKey()
LOCAL cScreen:=SAVESCREEN()
CLEAR TYPEAHEAD

SetSpec(cSpecKey)


IF cFile==NIL
   cFile:=""
ENDIF
cFile:=PADR(cFile,60)
SETKEY(K_F2,{||GetFile(@cFile,cExt)})
ScrTitul(23,"F2:Поиск по диску")
ShadowBox("",07,2,11,77,COL_HEADR)
IF lTemplate==NIL
   @ 09, 4 SAY "Полный путь к файлу:"
ELSE
   @ 09, 4 SAY "Полный путь к шаблону:"
ENDIF
@ 09,72 SAY cExt
SETCOLOR( COL_GET )
@ 09, 27 GET cFile PICTURE "@KS45" VALID {||!'"'$cFile.AND.!"*"$cFile.AND.!"?"$cFile.AND.!"'"$cFile}
SETCURSOR(1)
READ
SETCURSOR(0)
RESTSetKey(aSetKey)
cFile:=ALLTRIM(cFile)
IF !EMPTY(cExt).AND."."$RIGHT(cFile,4)
   cFile:=LEFT(cFile,RAT(".",cFile)-1)
   altd()
ENDIF
IF LASTKEY()!=K_ESC.AND.EMPTY(lExport).AND.!FILE(OemToAnsi(cFile+cExt))
   SayError("Нет файла "+TRIM(cFile)+cExt)
   cFile:=""
ENDIF
RESTSCREEN(,,,,cScreen)
SETCOLOR(cColor)
RETURN cFile


STATIC FUNCTION GetFile(cFile,cExt)
LOCAL cDisk:="",aFile
LOCAL i:=RAT("\",cFile)
LOCAL cPath:=IF(i==0,"c:",LEFT(cFile,i-1))

IF !EMPTY(cFile).OR.!EMPTY(cDisk:=NextDisk())
   aFile := Select_Files( 3, 2, IF(!EMPTY(cFile),cPath,cDisk+":") , {UPPER(SUBSTR(cExt,2))})
   IF VALTYPE(aFile)="A".AND.!EMPTY(aFile)
       cFile:=ALLTRIM(aFile[1])
       IF !EMPTY(cExt)
          cFile:=LEFT(cFile,LEN(cFile)-LEN(cExt))
       ENDIF
    ENDIF
    cFile:=PADR(cFile,60)
ENDIF
RETURN cFile


/*************************
STATIC FUNCTION ErrorMsg(objError)
local a
a:={;
"Документ не прошел контроль.",;
"Ошибка : "+ ALLTRIM(STR(objError:errorCode)),;
objError:reason,;
"Строка  : "+ ALLTRIM(STR(objError:line)),;
"Колонка : " + ALLTRIM(STR(objError:linepos)),;
"Текст   : " + objError:srcText,;
"Файл    : " + objError:url,;
"Позиция : " + ALLTRIM(STR(objError:filepos));
}
RETURN SayError(a)
*************************/

   		


FUNCTION GetCheckPos(lOnlyStri)
LOCAL nArea:=SELECT(),a:={}
LOCAL cc:=m->GlobalTask
LOCAL i,cToken,lFont:=.F.,nSel:=0
LOCAL cKey:=STR(CheckSum(cc+PROCNAME(2)+PROCNAME(3)+PROCNAME(4)+PROCNAME(5)+PROCNAME(6)+PROCNAME(7)),15,0)

IF FILE("CheckPos.dbf").AND.NetUse("CheckPos","CheckPos")
   IF DBSEEK(UPPER(IDENT_USER+cKey))
      IF RIGHT(cc:=TRIM(FIELD->CheckPos),1)!=","
         cc+=","
      ENDIF
      FOR i:=1 TO NUMTOKEN(cc,",")
      cToken:=TOKEN(cc,",",i)
      IF !EMPTY(lOnlyStri).OR.i==2
         AADD(a,cToken)
      ELSE
         AADD(a,VAL(cToken))
      ENDIF
      NEXT
   ENDIF
   CLOSE
ENDIF
SELECT(nArea)
RETURN a


PROCEDURE SetCheckPos(n,aa,cFile)
LOCAL nCheckSum,cKey
LOCAL nArea:=SELECT(),c:=""
LOCAL lOpen,i
LOCAL a,cc:=m->GlobalTask,cc1
LOCAL lOnlyStri:=.F.


nCheckSum:=CheckSum(cc+PROCNAME(2)+PROCNAME(3)+PROCNAME(4)+PROCNAME(5)+PROCNAME(6)+PROCNAME(7))
cKey:=STR(nCheckSum,15,0)

IF VALTYPE(n)=="A" // значит только массив строк
   a:=ACLONE(n)
   lOnlyStri:=.T.
ELSE
   IF aa==NIL
      aa:={}
   ENDIF
   a:=ACLONE(aa)
   ASIZE(a,LEN(a)+2)
   AINS(a,1)
   AINS(a,1)
   a[1]:=n
   a[2]:=cFile
ENDIF

IF FILE("CheckPos.dbf").AND.NetUse("CheckPos","CheckPos")
   FOR i:=1 TO LEN(a)
   IF VALTYPE(a[i])="C"
      IF EMPTY(cc1:=ALLTRIM(a[i]))
         cc1:=" "
      ENDIF
      c+=cc1+","
   ELSE
      c+=ALLTRIM(STR(a[i]))+","
   ENDIF
   NEXT

altd()

   IF !DBSEEK(UPPER(IDENT_USER+cKey))
      APPEND BLANK
   ELSE
      Bs_RLock()
   ENDIF
   REPLACE USER WITH IDENT_USER, CheckSum WITH nCheckSum, CheckPos WITH c
   UNLOCK
   CLOSE
ENDIF
SELECT(nArea)
RETURN


FUNCTION xmlVal(xVal)
IF VALTYPE(xVal)="C"
   xVal:=OemToAnsi(xVal)
ELSEIF VALTYPE(xVal)="D"
   xVal:=DTOS(xVal)
   xVal:=LEFT(xVal,4)+"-"+SUBSTR(xVal,5,2)+"-"+SUBSTR(xVal,7,2)
ENDIF
RETURN xVal


STATIC FUNCTION GetTransField(cField,aTrans)
LOCAL i:=0
IF !EMPTY(aTrans)
   i:=ASCAN(aTrans,{|x|UPPER(x[1])==UPPER(cField)})
ENDIF
RETURN IF(i==0,cField,aTrans[i,2])



FUNCTION ExportToExcel(cFile,aFields,cTemplate,cKey)
#ifndef __PLATFORM__Linux
//aFields {cAlias,cField,cAliasA,cFieldA}
//cAlias-открытая область,cAliasA,cFieldA-альтернативное имя
LOCAL oWorkBook,i,j,nRow,nRow0,nLen,nDec,cType
LOCAL oApp,oAS,aName:={},oName,cName
LOCAL cTable,cFi,cMacro:=""
LOCAL nRec:=RECNO(),cBuffer:="",cString
LOCAL nProces
LOCAL cAliFi,nRow1,nRow00


IF cTemplate!=NIL
   IF !FILE(cTemplate+".xlt")
      SayError("Не могу открыть "+TRIM(AnsiToOem(cTemplate))+".xlt")
      RETURN .F.
   ELSE
      cTemplate:=cTemplate+".xlt"
   ENDIF
ENDIF


TRY
  oApp := CreateObject( "Excel.Application" )
CATCH
   Alert("Excel не доступен!")
   RETURN .F.
END


F_EvalAltX(cKey)


nProces:=Proces_ini(LASTREC(),,, "Экспорт в Excel")
cListSep:=oApp:International(xlListSeparator)
cDecSep:=oApp:International(xlDecimalSeparator)
lIsRus:=(oApp:International(xlCountryCode)==7)

altd()

oApp:Visible := .F.
oApp:screenUpdating:=.F.
oApp:displayAlerts:=.F.


IF cTemplate==NIL
   oWorkBook:=oApp:WorkBooks:Add()
ELSE
   oWorkBook:=oApp:WorkBooks:Add(cTemplate)
ENDIF
IF oWorkBook:Worksheets:Count<1
   oAS:=oWorkBook:Worksheets():Add()
ELSE
   oAS:=oWorkBook:Worksheets(1)
ENDIF
oAS:Activate()
oApp:calculation:=xlCalculationManual

IF cTemplate==NIL
   oAS:Name:="Report"
   FOR i:=1 TO LEN(aFields)
   cTable:=IF(EMPTY(aFields[i,1]),ALIAS(),aFields[i,1])
   cFi:=aFields[i,2]
   j:=(cTable)->(FIELDNUM(cFi))
   cType:=(cTable)->(FIELDTYPE(j))
   nDec:=(cTable)->(FIELDDECI(j))
   nLen:=(cTable)->(FIELDSIZE(j))

   IF cType$"CM"
      oAS:columns[i]:Rows:NumberFormat = "@"
      oAS:columns(i):VerticalAlignment:=xlTop
      IF cType="C"
         oAS:columns(i):ColumnWidth:=MIN(nLen+1,40)
      ENDIF
   ELSEIF cType="N"
      IF nDec=0
         oAS:columns[i]:Rows:NumberFormat:=REPLICATE("#",nLen)
      ELSE
         oAS:columns[i]:Rows:NumberFormat:=REPLICATE("#",nLen-nDec-2)+"0"+cDecSep+REPLICATE("0",nDec)
      ENDIF
   ENDIF

   IF LEN(aFields[i])>4
      oAS:Cells(1,i):Value:=OemToAnsi(aFields[i,5])
   ELSE
      OemToAnsi(aFields[i,3]+aFields[i,4])
   ENDIF
   oAS:Cells(1,i):Interior:colorIndex:=37
   oAS:Cells(1,i):NumberFormat:="@"
   AADD(aName,{cTable+"->"+cFi,2,i,MyAlias(aFields[i])})
   NEXT

ELSE
   FOR i:=1 TO oApp:Names:count
   oName:=oApp:Names:item(i)
   cName:=oName:Name
   IF (j:=ASCAN(aFields,{|x|UPPER(x[3]+x[4])==UPPER(cName).OR.UPPER(x[1]+x[2])==UPPER(cName)}))>0
      cTable:=aFields[j,1]
      cFi:=aFields[j,2]
      TRY
         AADD(aName,{cTable+"->"+cFi,oName:referstorange:row,oName:referstorange:column,MyAlias(aFields[j])})
         oName:Name:=oName:Name+"_End"
      END
   ENDIF
   NEXT
ENDIF



IF LEN(aName)>0
   aName:=ASORT(aName,,,{|x,y| x[3] <= y[3]})
   FOR i:=1 TO ATAIL(aName)[3] //по колонкам идем
   cMacro+=IF(i=1,"","+")
   j:=ASCAN(aName,{|x|x[3]==i})
   IF j>0
      cMacro+="XXTOC("+aName[j,1]+")+CHR(9)"
   ELSE
      cMacro+="CHR(9)"
   ENDIF
   NEXT
   cMacro:=SUBSTR(cMacro,1,LEN(cMacro)-6)+"CHR(13)+CHR(10)"
   nRow1:=nRow0:=nRow00:=nRow:=aName[1,2]

altd()
   GO TOP
   WHILE !EOF()
      Proces_Update(nProces)
      IF cTemplate!=NIL.AND.nRow>nRow00
         oAS:Rows(nRow-1):Insert(xlDown)
         oAS:Rows(nRow):Copy(oAS:Rows(nRow-1))
      ENDIF

      IF cTemplate==NIL
         cString:=&(cMacro)

         cBuffer+=cString

         IF LEN(cBuffer)>60000
            Wvt_SetClipBoard(cBuffer)
            oAs:Cells(nRow0,1):Select()
            oAS:Paste()
            cBuffer:=""
            nRow0:=nRow
         ENDIF
      ELSE
         FOR i:=1 TO ATAIL(aName)[3] //по колонкам идем
         j:=ASCAN(aName,{|x|x[3]==i})
         IF j>0
            oAS:Cells(nRow,i):Value:=XXTOC(&(aName[j,1]),.T.)
         ENDIF
         NEXT
      ENDIF
      nRow++
      SKIP

   ENDDO
   IF LEN(cBuffer)>0
       Wvt_SetClipBoard(cBuffer)
       oAs:Cells(nRow0,1):Select()
       oAS:Paste()
   ENDIF

   IF cTemplate!=NIL.OR.UseNameH()=="2"
      FOR i:=1 TO LEN(aName)
      oAS:Cells(nRow1,aName[i,3]):Name:=aName[i,4]
      IF cTemplate==NIL
         oAS:Cells(nRow-1,aName[i,3]):Name:=aName[i,4]+"_End"
      ENDIF
      NEXT
   ENDIF

ENDIF

IF cTemplate==NIL
   oAS:Cells:Font:Name := "Tahoma"
   oAS:Cells:Font:Size := 8
ENDIF

oAs:Range("A1"):Select()
oApp:screenUpdating:=.T.
oApp:calculation:=xlCalculationAutomatic


IF cFile==NIL

   oApp:displayAlerts:=.T.
   oApp:Visible := .T.

ELSE

   oWorkBook:SaveAs(cFile)
   oApp:quit()
ENDIF
#endif

RETURN NIL

/*******************************
FUNCTION MakerToExcel(cTemplate)
#ifndef __PLATFORM__Linux
LOCAL oWorkBook,i,j,nRow,nRow0,nRow1,nLen,nDec,cType
LOCAL oApp,oAS,oName,cName,aName:={}
LOCAL nProces,x,a,b,cb,lSpis,nSpis,cMacro,aSpis,cField
LOCAL cString,cBuffer:=""
STATIC aFields,aMacro
STATIC sTemplate:="!"


TRY
  oApp := CreateObject( "Excel.Application" )
CATCH
   Alert("Excel не доступен!")
   RETURN .F.
END

//nProces:=Proces_ini(LASTREC(),,, "Экспорт в Excel")
cListSep:=oApp:International(xlListSeparator)
cDecSep:=oApp:International(xlDecimalSeparator)
lIsRus:=(oApp:International(xlCountryCode)==7)



oApp:Visible := .F.
oApp:screenUpdating:=.F.
oApp:displayAlerts:=.F.


oWorkBook:=oApp:WorkBooks:Add(cTemplate)
IF sTemplate!=cTemplate //еще время создания проверить, если имя совпадает
   sTemplate:=cTemplate
   oWorkBook:Worksheets("Parameters"):select()
   oAS:=oApp:ActiveSheet()
   aFields:=NIL
   aFields:=TAssociativeArray()
   aMacro:={}
   i:=2
   WHILE !EMPTY(oAS:Cells(++i,1):Value)
      x:=AnsiToOem(oAS:Cells(i,3):Value)
      cb:=AnsiToOem(oAS:Cells(i,7):Value)
      IF "||"$cb
         b:=&cb
      ELSE
         b:={||""}
      ENDIF
      lSpis:=RIGHT(TRIM(oAS:Cells(i,2):Value),1)=="*"
      //когда ключ - один символ, то не работает, поэтому начинаем с "!"
      aFields["!"+UPPER(x)]:={b,lSpis,cb}
   ENDDO

   FOR i:=1 TO oApp:Names:count
   oName:=oApp:Names:item(i)
   cName:=oName:Name
   IF !EMPTY(a:=Look(cName,aFields)).AND.a[2] //списковаые
      //Массив списковых параметров
      AADD(aName,{cName,oName:referstorange:row,oName:referstorange:column,"EVAL("+a[3]+",n)"})
   ENDIF
   NEXT
   aName:=ASORT(aName,,,{|x,y|x[2] <= y[2] .AND. x[3] <= y[3]})
   //массив списков
   aSpis:={}
   j:=0

   FOR i:=1 TO LEN(aName)
   IF aName[i,2]>j
      j:=aName[i,2]
      AADD(aSpis,{})
   ENDIF
   AADD(ATAIL(aSpis),aName[i])
   NEXT
   //Макросы
   FOR nSpis:=1 TO LEN(aSpis)
   cMacro:=""
   aName:=aSpis[nSpis]
   cField:=aName[1][1]
   FOR i:=1 TO ATAIL(aName)[3] //по колонкам идем
   cMacro+=IF(i=1,"","+")
   j:=ASCAN(aName,{|x|x[3]==i})
   IF j>0
      cMacro+="XXTOC("+aName[j,4]+")+CHR(9)"
   ELSE
      cMacro+="CHR(9)"
   ENDIF
   NEXT
   cMacro:=SUBSTR(cMacro,1,LEN(cMacro)-6)+"CHR(13)+CHR(10)"
   AADD(aMacro,{cMacro,cField}) //cField - для определения координат
   NEXT
ENDIF

altd()
oWorkBook:Worksheets("Report"):select()
oAS:=oApp:ActiveSheet()
oApp:calculation:=xlCalculationManual




FOR i:=1 TO oApp:Names:count
oName:=oApp:Names:item(i)
cName:=oName:Name
IF !EMPTY(a:=Look(cName,aFields)).AND.!a[2] //не списковые
   IF VALTYPE(cString:=EVAL(a[1]))="C"
      cString:=OemToAnsi(cString)
   ENDIF
   oAS:Range(cName):Value:=cString
ENDIF
NEXT

PRIVATE n
//Пошли по спискам
FOR nSpis:=1 TO LEN(aMacro)
n:=0
oName:=oApp:Names:Item(aMacro[nSpis,2])
nRow1:=nRow0:=nRow:=oName:referstorange:row
WHILE n<10
   n++
   IF nRow>nRow0
    //altd()
      oAS:Rows(nRow-1):Insert(xlDown)
      oAS:Rows(nRow):Copy(oAS:Rows(nRow-1))
   ENDIF
   TRY
      cString:=&(aMacro[nSpis,1])
   CATCH
      EXIT
   END

   cBuffer+=cString
   nRow++
   IF LEN(cBuffer)>60000
      Wvt_SetClipBoard(cBuffer)
      oAs:Cells(nRow0,1):Select()
      oAS:Paste()
      cBuffer:=""
      nRow0:=nRow
  ENDIF
ENDDO
IF LEN(cBuffer)>0
    Wvt_SetClipBoard(cBuffer)
    oAs:Cells(nRow0,1):Select()
    oAS:Paste()
ENDIF
NEXT


oApp:screenUpdating:=.T.
oApp:calculation:=xlCalculationAutomatic
oApp:displayAlerts:=.T.
oApp:Visible := .T.


//Proces_End(nProces)
#endif

RETURN NIL

*******************************************/





FUNCTION CreateXLSTemplate(aFields,cTemplate)
//aFields {cAlias,cField,cAliasA,cFieldA} или
//aFields {cHead,cName,cBlock,cType,cUseFo,cPict,cPos,cText,cShrift,cTypeMes}
LOCAL oWorkBook,i,j,nRow:=1
LOCAL oApp,oAS,cName
LOCAL cTable,cFi,cTable0:="!!!",cAliFi
LOCAL lMaker:="{||"$aFields[1,3],lFr,lSpis,cType
altd()
TRY
  oApp := CreateObject( "Excel.Application" )
CATCH
   Alert("Excel не доступен!")
   RETURN .F.
END


oApp:Visible := .F.
altd()
IF !EMPTY(cTemplate)
   IF !"."$cTemplate
      cTemplate+=".xlt"
   ENDIF
   IF !FILE(cTemplate)
      oWorkBook:=oApp:WorkBooks:Add(Truepath(m->cProPath+"template.xlt"))
      oWorkBook:SaveAs(cTemplate)
   ELSE
      oWorkBook:=oApp:WorkBooks:Open(cTemplate)
   ENDIF
ELSE
   oWorkBook:=oApp:WorkBooks:Add(Truepath(m->cProPath+"template.xlt"))
ENDIF


TRY
   oAS:=oWorkBook:Worksheets("Parameters")
CATCH
   SayError("Выбранный шаблон не соответствует необходимой структуре!")
   oWorkBook:=oApp:WorkBooks:Add(Truepath(m->cProPath+"template.xlt"))
   oAS:=oWorkBook:Worksheets("Parameters")
END
oAS:Activate()
nRow++
oAS:Cells(nRow,1):Value:=1
oAS:Cells(nRow,2):Value:=OemToAnsi("Параметры")
IF lMaker
   altd()
   FOR i:=1 TO LEN(aFields)
   cType:=aFields[i,4]
//   lFr:=cType$'IFQT'
   lSpis:=!(cType="I".OR.cType=="F".OR.cType=="Q".OR.cType=="0".OR.cType=="T")
//   cName:=IF(lFr,'<',' ')+TRIM(aFields[i,1])+IF(lFr,'>','')+IF(lSpis,'*','')+' ')
   cName:=TRIM(aFields[i,1])+IF(lSpis,'*','')+' '
   nRow++
   oAS:Cells(nRow, 1):Value:=2
   oAS:Cells(nRow, 2):Value:=OemToAnsi(aFields[i,2]+" - "+cName)
   oAS:Cells(nRow, 3):Value:=OemToAnsi(aFields[i,2])
   oAS:Cells(nRow, 4):Value:="Para"+ALLTRIM(STR(nRow))
   oAS:Cells(nRow, 7):Value:=aFields[i, 3]

/************
   FOR j:=3 TO LEN(aFields[i])
   IF aFields[i,j]!=NIL
      oAS:Cells(nRow, j+4):Value:=aFields[i, j]
   ENDIF
   NEXT
***************/
   NEXT
ELSE
   FOR i:=1 TO LEN(aFields)
   IF UseName()="0"
      cTable:=aFields[i,1]
      cFi:=aFields[i,2]
   ELSE
      cTable:=aFields[i,3]
      cFi:=aFields[i,4]
   ENDIF

   IF !(UPPER(cTable)==UPPER(cTable0))
      cTable0:=cTable
      nRow++
      oAS:Cells(nRow,1):Value:=2
      oAS:Cells(nRow,2):Value:=OemToAnsi(IF(EMPTY(cTable),"",TRIM(cTable)+"-")+TRIM(SUBSTR(aRes0[i],101,60)))
   ENDIF
   nRow++
   oAS:Cells(nRow,1):Value:=3
   oAS:Cells(nRow,2):Value:=OemToAnsi(TRIM(MyAlias(aFields[i]))+"-"+TRIM(SUBSTR(aRes0[i],23,78)))
   oAS:Cells(nRow,3):Value:=MyAlias(aFields[i])
   oAS:Cells(nRow,4):Value:="Para"+ALLTRIM(STR(nRow))
   NEXT
ENDIF

oAS:=oWorkBook:Worksheets(1)
oAS:Activate()
oAs:Range("A1"):Select()

oApp:Visible := .T.


//altd()

RETURN .T.



STATIC FUNCTION SelectFields(lOnlyRes0,lKeyInsert,nNumFields,lXML,cSpecKey,lExport)
LOCAL aRes
LOCAL nWi:=WSELECT()
LOCAL nTop:=1,nLeft:=0,nBottom:=22,nRight:=79
LOCAL aResKey:={},cKey
LOCAL i:=0,j,n,aRelation:={},nRecno
LOCAL cPath:=LoadPath()
LOCAL bLastHandler
LOCAL cOldTrapShift := TRAPSHIFT("")
LOCAL nCursor:=SETCURSOR(0)
LOCAL aSetKey:=SaveSetKey()
LOCAL aSet:=SAVESET()
LOCAL nArea:=SELECT()
LOCAL lRet:=.F.
LOCAL aFields:={},cAliFi,cTable,cFi,aKeyFields:={},aKeyFields0:={}
LOCAL cRusAlias,cEnAlias,cNewTable,cNewFi,cHead,cTagName,lDoKeyFields
//LOCAL lExit:=.F.


LOCAL aZapField:={;
"CRC",;
"ID_ST",;
"ID_USER",;
"SHABLON";
}

altd()

SetSpec(cSpecKey)


aRes:={}

IF nArea>0
   nRecNo:=RECNO()
ENDIF

WSELECT(0)

IF EMPTY(SELECT("Tables"))
  NetUse("Tables",_PRO_PATH+"dic\b4tables",,,,.T.)
ENDIF
NetUse("Fields",_PRO_PATH+"dic\b4fields",,,,.T.)
SET RELATION TO UPPER(DirName+TableName) INTO Tables


//SETKEY(K_ALT_X,NIL)

SELECT(nArea)


WHILE (n:=DBRSELECT(++i))>0
   AADD(aRelation,{Alias(n),DbRelation(i)})
ENDDO

IF !TmpField(aRes,aZapField)

   FOR i:=1 TO FCOUNT()
   IF TYPE(FIELDNAME(i))!="A".AND.ASCAN(aZapField,FIELDNAME(i))=0.AND.SUBSTR(UPPER(LoadPath()),3)$UPPER(Bs_TableName())
      Fields->(DBSEEK(GetxKey(ALIAS(nArea),i)))
      cKey:=PADR(PADR(ULower(Alias())+"."+ULower(FIELDNAME(i)),22)+TRIM(Fields->Name)+;
      " ("+FIELDTYPE(i)+ALLTRIM(STR(FIELDLEN(i)))+IF(FIELDDEC(i)>0,"-"+ALLTRIM(STR(FIELDDEC(i))),"")+")";
      ,100)+TableInfo()
      AADD(aRes,cKey)
      IF lKeyInsert!=NIL.AND.EMPTY(aKeyFields)
         aKeyFields0:=GetKeyFields(TagName(cKey,0),.T.,aKeyFields)
      ENDIF
   ENDIF
   NEXT
ENDIF

FOR n:=1 TO LEN(aRelation)
lDoKeyFields:=.T.
FOR i:=1 TO (aRelation[n,1])->(FCOUNT())
IF (aRelation[n,1])->(TYPE(FIELDNAME(i))!="A".AND.ASCAN(aZapField,FIELDNAME(i))=0.AND.SUBST(UPPER(LoadPath()),3)$UPPER(Bs_TableName()))
   Fields->(DBSEEK(GetxKey(aRelation[n,1],i)))
   cKey:=PADR(PADR(ULower(aRelation[n,1])+"."+(aRelation[n,1])->(ULower(FIELDNAME(i))),22)+TRIM(Fields->Name)+;
   (aRelation[n,1])->(" ("+FIELDTYPE(i)+ALLTRIM(STR(FIELDLEN(i)))+IF(FIELDDEC(i)>0,"-"+ALLTRIM(STR(FIELDDEC(i))),"")+")");
   ,100)+TableInfo()
   AADD(aRes,cKey)
   IF lKeyInsert!=NIL.AND.lXml!=NIL.AND.lXml.AND.lDoKeyFields
      (aRelation[n,1])->(GetKeyFields(TagName(cKey,0),.T.,aKeyFields))
      lDoKeyFields:=.F.
   ENDIF
ENDIF
NEXT
NEXT
aRes0:=ACLONE(aRes)
IF LEN(aRes)>0
   IF lOnlyRes0!=NIL
      lRet:=.T.
   ELSE
      IF lKeyInsert!=NIL
         FOR i:=1 TO LEN(aKeyFields0)
         IF(j:=ASCAN(aRes,{|x|UPPER(TRIM(LEFT(x,22)))==aKeyFields0[i]}))>0.AND.;
            ASCAN(aResultCol,j)=0
            AADD(aResultCol,j)
         ENDIF
         NEXT
      ENDIF


      ShadowBox(" Укажите поля для экспорта ",nTop,nLeft,nBottom,nRight,COL_HEADR,,,"noShadow")
      SETLASTKEY(0)
      ScrTitul(23,"Ins:Отметить/Снять поле  +/-:Все поля  ENTER:Выполнить")

      AchMenu("",nTop+1,nLeft+1, @aRes,,,COL_HEADR,COL_HEADR,.T.,,nBottom-1,nRight-1,"noShadow",aKeyFields0)
      IF LASTKEY()=K_RETURN
         IF LEN(aRes)=0
            SayError("Не отмечено ни одного поля!")
            SETLASTKEY(K_ESC)
         ELSEIF nNumFields!=NIL.AND.LEN(aRes)>nNumFields
            SayError("Отмечено "+ALLTRIM(STR(LEN(aRes),3,0))+" полей, допустимо "+ALLTRIM(STR(nNumFields,3,0))+"!")
         ELSE
            lRet:=.T.
         ENDIF
      ENDIF
   ENDIF
ENDIF
//Tables->(DbCloseArea())
Fields->(DbCloseArea())

IF lRet
   IF lOnlyRes0==NIL
      aResultCol:={}
   ENDIF

   FOR i:=1 TO LEN(aRes)
   IF lOnlyRes0!=NIL.OR.(j:=ASCAN(aRes0,{|x|LEFT(x,22)==LEFT(aRes[i],22)}))>0
      IF lOnlyRes0==NIL
         AADD(aResultCol,j)
      ENDIF

      cAliFi:=TRIM(LEFT(aRes[i],22))
      cTable:=TRIM(LEFT(cAliFi,AT(".",cAliFi)-1))
      cFi:=TRIM(SUBSTR(cAliFi,AT(".",cAliFi)+1))
      cNewTable:=NewTable(aRes[i])
      cNewFi:=NewFi(aRes[i])

      IF UseNameH(lXml)=="0"
         cHead:=cTable+cFi
      ELSEIF UseNameH(lXml)=="1"
         cHead:=cNewTable+cNewFi
      ELSE
         cHead:=RusAlias(aRes[i],0)
      ENDIF
      cTagName:=TagName(aRes[i],0)


      AADD(aFields,{cTable,cFi,cNewTable,cNewFi,cHead,cTagName,cNewTable,cNewFi})


   ENDIF
   NEXT
   IF lKeyInsert!=NIL
      altd()
      FOR i:=1 TO LEN(aKeyFields)
      cAliFi:=UPPER(aKeyFields[i])
      cTable:=TRIM(LEFT(cAliFi,AT(".",cAliFi)-1))
      cFi:=TRIM(SUBSTR(cAliFi,AT(".",cAliFi)+1))
      IF (n:=ASCAN(aFields,{|x|UPPER(x[1])==cTable}))>0.AND.;
         ASCAN(aFields,{|x|UPPER(x[1]+"."+x[2])==cAliFi})==0
         IF lOnlyRes0!=NIL.OR.(j:=ASCAN(aRes0,{|x|UPPER(LEFT(x,22))==PADR(cAliFi,22)}))>0
            IF lOnlyRes0==NIL
               AADD(aResultCol,j)
            ENDIF
            cNewTable:=NewTable(aRes0[j])
            cNewFi:=NewFi(aRes0[j])

            IF UseNameH(lXml)=="0"
               cHead:=cTable+cFi
            ELSEIF UseNameH(lXml)=="1"
               cHead:=cNewTable+cNewFi
            ELSE
               cHead:=RusAlias(aRes0[j],0)
            ENDIF
            cTagName:=TagName(aRes0[j],0)
            ASIZE(aFields,LEN(aFields)+1)
            AINS(aFields,n)
            aFields[n]:={cTable,cFi,cNewTable,cNewFi,cHead,cTagName,cNewTable,cNewFi}
        ENDIF
      ENDIF
      NEXT
   ENDIF

ENDIF

SETCURSOR(nCursor)

RestSetKey(aSetKey)
IF nArea>0
   SELECT(nArea)
   IF !EMPTY(ALIAS())
      DBGOTO(nRecNo)
   ENDIF
ENDIF


RESTSET(aSet)


WSELECT(nWi)


CLEAR TYPEAHEAD
SETLASTKEY(0)
TRAPSHIFT(cOldTrapShift)

RETURN aFields





STATIC FUNCTION AchMenu(cTitle, nTop, nLeft, aDisp, nChoice, cFrame, cColor, cColor1, lIns, aTake,nBottom,nRight,noShadow,aKeyFields)
// Если задано lIns=.T., то можно для множественного выбора пометить галочками элементы массива
// aDisp. При этом на выходе (при передаче параметра по ссылке) этот массив укоротится
// до выбранных значений, так же как и параллельный массив aTake.

LOCAL Old := SetColor(), Old_Cursor := SetCursor(0)
LOCAL nLen := 0  , i := 1, aColor_
LOCAL nRight_T, aRetDisp := {}, aRetTake:={}
LOCAL _lIns:=.F.
If lIns==NIL
  lIns:=.F.
EndIf


If lIns
  PRIVATE aDisp1:=aDisp
//  AEVAL(aDisp, {|x,y| aDisp[y] := " "+" "+x})
  AEVAL(aDisp, {|x,y| aDisp[y] := IF(y$aResultCol,CHR(251)," ")+" "+x})

  If aTake==NIL
    aTake:=ARRAY(LEN(aDisp))
  EndIf
  If LEN(aTake)<LEN(aDisp)
    ASIZE(aTake, LEN(aDisp))
  EndIf
EndIf
cColor  := IF(Empty(cColor),COL_INPUT, cColor)
cColor1  := IF(Empty(cColor1),COL_INPUTF, cColor1)
cTitle  := IF(Empty(cTitle).or.cTitle == NIL, "", cTitle)
nChoice := IF(nChoice = 0.or.nChoice == NIL, nChoice = 1, nChoice)
cFrame  := IF( Empty(cFrame).or.cFrame == NIL, "", cFrame )
AEVAL( aDisp, {||nLen := IF(Len(aDisp[i]) > nLen, Len(aDisp[i]), nLen) , i++})
IF nRight==NIL
   nRight  := nLeft + nLen + 3
   nRight_T:= nLeft + Len(cTitle) + 3
   nRight  := If( nRight > nRight_T, nRight ,nRight_T)
ENDIF
IF nBottom==NIL
   nBottom := if(( nTop + Len( aDisp ) + 5 ) > 21, 21, nTop+Len(aDisp) + 5)
ENDIF
//ShadowBox("",nTop,nLeft,nBottom,nRight,cColor,cFrame,,,noShadow)
SetColor( cColor )
@ nTop+2, nLeft+1 TO nTop+2, nRight-1
@ nBottom-2, nLeft+1 TO nBottom-2, nRight-1
@ nBottom-1, nLeft+1 SAY "Краткое :"
@ nBottom  , nLeft+1 SAY "Идент...:"
SetColor( cColor1 )
Title( nTop+1, cTitle, nLeft+1, nRight-1)
SetColor( cColor )
CLEAR TYPEAHEAD
SETLASTKEY(255)
AchCurr(3,1,nTop,nTop,nLeft,nBottom,nRight)
nChoice := ACHOICE(nTop+3, nLeft+1, nBottom-3, nRight-1, aDisp,,If(lIns, {|nMode, nI, nRow| AchCurr(nMode, nI, nRow,nTop,nLeft,nBottom,nRight,aKeyFields)},))
If nChoice<>0 .AND. lIns
  // сформировать выборку
  AEVAL(aDisp, {|x,y| If(LEFT(x,1)==CHR(251), (AADD(aRetDisp, RIGHT(x,LEN(x)-2)), AADD(aRetTake, aTake[y])), NIL)})

  // Если не было помечено ни одного пункта
  AEVAL(aDisp, {|x| If(LEFT(x,1)==CHR(251), _lIns:=.T., NIL)})
  If !_lIns // тогда выборка - это единственный выбранный элемент
    AADD(aRetDisp, RIGHT(aDisp[nChoice], LEN(aDisp[nChoice])-2))
    AADD(aRetTake, aTake[nChoice])
  EndIf
  If !EMPTY(aRetDisp)
    aDisp := aRetDisp
    aTake := aRetTake
  EndIf
EndIf
SetColor( Old )
SetCursor( Old_Cursor )
RETURN nChoice

STATIC FUNCTION AchCurr(nRejim, nTekEl,Poz,nTop,nLeft,nBottom,nRight,aKeyFields)
LOCAL nKey   := LASTKEY(),i,z,block

IF nRejim==AC_EXCEPT

  DO CASE




    Case nKey==K_INS.OR.nKey==ASC("0")

      If LEFT(m->aDisp1[nTekEl],1)==CHR(251).AND.;
        (EMPTY(aKeyFields).OR.ASCAN(aKeyFields,{|x|UPPER(x)$UPPER(aDisp1[nTekEl])})=0.OR.;
           YesOrNo({;
           "Ключевое поле! Если убрать,то импорт будет не возможен!",;
           "Убрать?"},.F.))
           m->aDisp1[nTekEl] := "  "+RIGHT(m->aDisp1[nTekEl], LEN(m->aDisp1[nTekEl])-2)
      ELSE
      // поставить галочку
        m->aDisp1[nTekEl] := CHR(251)+" "+RIGHT(m->aDisp1[nTekEl], LEN(m->aDisp1[nTekEl])-2)
      EndIf
      SAYSCREEN(m->aDisp1[nTekEl][1],nTop+Poz+3,nLeft+1)
      KEYBOARD CHR(K_DOWN)
      RETURN 2
    Case nKey==ASC("+")
    AEVAL(m->aDisp1,{|x,i|m->aDisp1[i]:=CHR(251)+" "+RIGHT(x,LEN(x)-2),;
    IF(nTop+i+2<nBottom-2,SAYSCREEN(m->aDisp1[i][1],nTop+i+2,nLeft+1),)})


    Case nKey==ASC("-")

    AEVAL(m->aDisp1,{|x,i|m->aDisp1[i]:=" "+" "+RIGHT(x,LEN(x)-2),;
    IF(nTop+i+2<nBottom-2,SAYSCREEN(m->aDisp1[i][1],nTop+i+2,nLeft+1),)})





/************
    AEVAL(m->aDisp1,{|x,i|z:=x,;
    IF(EMPTY(aKeyFields).OR.ASCAN(aKeyFields,{|y|UPPER(y)$UPPER(z)})==0,;
    (m->aDisp1[i]:=" "+" "+RIGHT(x,LEN(x)-2)),)})
    AEVAL(m->aDisp1,{|x,i|;
    IF(nTop+i<nBottom-2,SAYSCREEN(m->aDisp1[i][1],nTop+i,nLeft+1),)})
**************/



//    IF(nTop+i+2<nBottom-2,SAYSCREEN(m->aDisp1[i][1],nTop+i+2,nLeft+1),)})



    Case nKey==K_ESC
      RETURN AC_ABORT
    Case nKey==K_ENTER .OR. nKey==K_TAB
      RETURN AC_SELECT
  EndCase
  CLEAR TYPEAHEAD
  SETLASTKEY(255)






EndIf

@ nTop,nLeft+1 SAY PADC(TRIM(SUBSTR(m->aDisp1[nTekEl],101,60)),nRight-nLeft-1) COLOR "W+/B*"
@ nTop+1,nLeft+1 SAY PADC(TRIM(SUBSTR(m->aDisp1[nTekEl],23,100-22)),nRight-nLeft-1) COLOR "W+/B*"
@ nBottom-1,nLeft+11 SAY PADR(RusAlias(m->aDisp1[nTekEl],2),79-nLeft-11) COLOR "W+/B*"
@ nBottom,nLeft+11 SAY PADR(EnAlias(m->aDisp1[nTekEl],2),79-nLeft-11) COLOR "W+/B*"

RETURN AC_CONT



FUNCTION XXTOC(uVal,lOemToAnsi)
LOCAL cType:=VALTYPE(uVal),cFstr
DO CASE
   CASE cType = "N"
   cFStr := IF(uVal=0,"",STRTRAN(STR(uVal),".",cDecSep))
   CASE cType = "D"
   cFStr := DTOC(uVal)
   CASE cType = "L"
   IF uVal
      cFStr := "True"
   Else
      cFStr := "False"
   EndIF
   CASE cType = "U"
   cFStr:=""
   OTHERWISE
   cFStr:=STRTRAN(TRIM(uVal),CHR(13)+CHR(10),"##") 
   IF !EMPTY(lOemToAnsi)
      cFstr:=OemToAnsi(cFStr)
   ENDIF
ENDCASE
RETURN cFstr



FUNCTION ULower(c)
RETURN UPPER(c[1])+LOWER(SUBSTR(c,2))


FUNCTION SelectAltX(bExport,bImport,bExcel)
LOCAL aSetkey:=SaveSetKey()
LOCAL nRet,nSelect
STATIC sSelect
LOCAL aSelect:={;
"  Экспорт строк         ",;
"  Импорт  строк         ",;
"  Общий экспорт в Excel ";
}

altd()





IF bExcel==NIL
   ASIZE(aSelect,2)
ENDIF

nSelect:=BoxMenu("",4,10,aSelect,,sSelect,,COL_BROWSE,COL_BROWSE)
IF nSelect>0
   sSelect:=nSelect
   IF nSelect=1
      nRet:=EVAL(bExport)
   ELSEIF nSelect=2
      nRet:=EVAL(bImport)
   ELSE
      nRet:=EVAL(bExcel)
   ENDIF
ENDIF
RestSetkey(aSetKey)
RETURN nRet

STATIC FUNCTION Look(cS,a)
LOCAL aRet
TRY
   aRet:=a["!"+UPPER(cS)]
CATCH
  aRet:={}
END
RETURN aRet


STATIC FUNCTION GetxKey(cAlias,nFi)
LOCAL cAli:=IF(EMPTY(cAlias),ALIAS(),cAlias)
LOCAL cTable:=(cAli)->(Bs_TableName())
LOCAL cPath:=LoadPath()
LOCAL i,cc1,cc2

cTable:=LEFT(cTable,LEN(cTable)-4)
IF cTable="\\".AND.SUBSTR(cPath,2,1)==":"
   cPath:=SUBSTR(cPath,3)
   cTable:=SUBSTR(cTable,AT(UPPER(cPath),cTable))
ENDIF

cTable:=STRTRAN(UPPER(cTable),UPPER(cPath),"")
i:=AT("\",cTable)
IF i>0
   cc1:=LEFT(cTable,i)
   cc2:=SUBSTR(cTable,i+1)
ELSE
   cc1:=""
   cc2:=cTable
ENDIF
IF nFi==NIL
   RETURN UPPER(PADR(cc1,9)+PADR(cc2,20))
ENDIF

RETURN UPPER(PADR(cc1,9)+PADR(cc2,20)+TRIM((cAli)->(FIELDNAME(nFi))))

STATIC FUNCTION TableInfo()
//60+4*32, начиная со 101
RETURN Tables->(PADR(TableAlias,60)+PADR(Alias_Ru,32)+PADR(Alias_En,32))+;
Fields->(PADR(Alias_Ru,32)+PADR(Alias_En,32))+PADR(Tables->TagName,20)

STATIC FUNCTION TableInfo1(a)
//60+4*32, начиная со 101
//1 - Table_Alias_Ru
//2 - Field_Alias_Ru
RETURN (PADR(a[1],60)+PADR(a[1],32)+PADR("",32))+;
PADR(a[2],32)+PADR("",32)+PADR(" ",20)




STATIC FUNCTION RusAlias(c,n1)
LOCAL n:=161+n1 //сдвинулось на 2 символа при передаче в AchCur
LOCAL c1:=CHARREPL(cc1,TRIM(SUBSTR(c,n,32)),cc2)
LOCAL c2:=CHARREPL(cc1,TRIM(SUBSTR(c,n+32+32,32)),cc2)
LOCAL cPunct:=IF(EMPTY(c1)," ",".")
//RETURN PADR(TRIM(c1)+TRIM(cPunct)+TRIM(c2),65)
RETURN PADR(TRIM(c2),65)

STATIC FUNCTION NewTable(c)
LOCAL n:=161
LOCAL c1:=CHARREPL(cc1,TRIM(SUBSTR(c,n+32,32)),cc2)
LOCAL c2:=CHARREPL(cc1,TRIM(SUBSTR(c,n+32+32+32,32)),cc2)
LOCAL cAliFi:=TRIM(LEFT(c,22))
LOCAL cTable:=TRIM(LEFT(cAliFi,AT(".",cAliFi)-1))
LOCAL cFi:=TRIM(SUBSTR(cAliFi,AT(".",cAliFi)+1))
IF EMPTY(c1)
   c1:=cTable
ENDIF
RETURN c1


STATIC FUNCTION NewFi(c)
LOCAL n:=161
LOCAL c1:=CHARREPL(cc1,TRIM(SUBSTR(c,n+32,32)),cc2)
LOCAL c2:=CHARREPL(cc1,TRIM(SUBSTR(c,n+32+32+32,32)),cc2)
LOCAL cAliFi:=TRIM(LEFT(c,22))
LOCAL cTable:=TRIM(LEFT(cAliFi,AT(".",cAliFi)-1))
LOCAL cFi:=TRIM(SUBSTR(cAliFi,AT(".",cAliFi)+1))
IF EMPTY(c2)
   c2:=cFi
ENDIF
RETURN c2


STATIC FUNCTION EnAlias(c,n1)
LOCAL n:=161+n1
LOCAL c1:=CHARREPL(cc1,TRIM(SUBSTR(c,n+32,32)),cc2)
LOCAL c2:=CHARREPL(cc1,TRIM(SUBSTR(c,n+32+32+32,32)),cc2)
LOCAL cPunct:="" //IF(EMPTY(c1)," ",".")
RETURN PADR(TRIM(c1)+TRIM(cPunct)+TRIM(c2),65)




STATIC FUNCTION TagName(c,n1)
LOCAL n:=161+n1
LOCAL c1:=TRIM(SUBSTR(c,n+32+32+32+32,20))
RETURN c1


FUNCTION UseName(lXml) //Not Static!!!
RETURN IF(lXml==NIL.OR.!lXml,_XML_SETUP[1],_XML_SETUP[4])

STATIC FUNCTION UseNameH(lXml)
RETURN IF(lXml==NIL.OR.!lXml,_XML_SETUP[2],"0")


FUNCTION UseVariant(lXml)
RETURN IF(lXml==NIL,_XML_SETUP[3],"0")



FUNCTION GetCPXML()
LOCAL c:=_XML_SETUP[5]
LOCAL cc:='"windows-1251"'
DO CASE
   CASE c=="0"
   cc:='"windows-1251"'
   CASE c=="1"
   cc:='"UTF-8"'
   CASE c=="2"
   cc:='"UTF-16"'
   CASE c=="3"
   cc:='"cp866"'
END CASE
RETURN cc


STATIC FUNCTION MyAlias(aFi,lXML)
LOCAL cRet

IF UseName(lXML)=="1" //английские алиасы - идентификаторы
   cRet:=aFi[3]+aFi[4]
ELSEIF !EMPTY(aFi[1])
   cRet:=aFi[1]+aFi[2]
ELSE
   cRet:=ALIAS()+aFi[2]
ENDIF
RETURN cRet


STATIC FUNCTION MyTable(aFi,lXML)
LOCAL cRet
IF UseName(lXML)=="1" //английские алиасы - идентификаторы
   cRet:=aFi[3]
ELSEIF EMPTY(cRet:=aFi[1])
   cRet:=Alias()
ENDIF
RETURN cRet


STATIC FUNCTION GetOrder(aFields,i,lArray)
LOCAL cOrder:=""
IF i>0.AND.LEN(aFields[i])>5
   cOrder:=aFields[i,6]
ENDIF
RETURN cOrder

STATIC FUNCTION MyAscan(aFields,cName,lArray,nProxod)
LOCAL n
IF EMPTY(cName).OR.VALTYPE(cName)!="C"
   RETURN 0
ENDIF

cName:=UPPER(cName)
IF lArray!=NIL.AND.lArray
   n:=ASCAN(aFields,{|x|;
       UPPER(x[3]+x[4])==cName.OR.;
       UPPER(x[1]+x[2])==cName.OR.;
       UPPER(x[7]+x[8])==cName.OR.;
       UPPER(x[2])==STRTRAN(cName,ALIAS(),"").OR.;
       UPPER(x[2])==STRTRAN(cName,"EXPORT","").OR.;
       UPPER(x[2])==STRTRAN(cName,"ORD_ITEM","").OR.;
       UPPER(x[2])==STRTRAN(cName,"PITEM","").OR.;
       UPPER(x[2])==STRTRAN(cName,"MLABEL","").OR.;
       UPPER(x[4])==STRTRAN(cName,ALIAS(),"").OR.;
       UPPER(x[4])==STRTRAN(cName,"EXPORT","").OR.;
       UPPER(x[4])==STRTRAN(cName,"ORD_ITEM","").OR.;
       UPPER(x[4])==STRTRAN(cName,"PITEM","").OR.;
       UPPER(x[4])==STRTRAN(cName,"MLABEL","");
       })
ELSE
   n:=ASCAN(aFields,{|x|;
      UPPER(x[3]+x[4])==cName.OR.;
      UPPER(x[1]+x[2])==cName.OR.;
      UPPER(x[7]+x[8])==cName.OR.;
      UPPER(x[2])==STRTRAN(cName,ALIAS(),"").OR.;
      UPPER(x[2])==STRTRAN(cName,"EXPORT","");
      })
ENDIF

IF n==0.AND.(nProxod==NIL.OR.nProxod==2)
    n:=ASCAN(aFields,{|x|;
    Sinonim(cName,UPPER(x[2]))})
ENDIF
RETURN n


STATIC FUNCTION Sinonim(cName,cFi)
LOCAL i,j,lName:=.F.,lFi:=.F.
LOCAL aSin:={;
{"GRUP","GROUP","ITEMGROUP"},;
{"NNUM","ITEMCODE"},;
{"CENA","CENA_I","PRICE","COST"},;
{"CODPART","PARTIA","LOTCODE"},;
{"KOL","QTY","KOL_I"},;
{"ED","ED_I","UNIT"};
}


FOR i:=1 TO LEN(aSin)
lName:=.F.;lFi:=.F.
FOR j:=1 TO LEN(aSin[i])
IF !lName
   lName:=MyEqu(aSin[i,j],cName)
ENDIF
IF !lFi
   lFi:=MyEqu(aSin[i,j],cFi)
ENDIF
NEXT
IF lFi.AND.lName
   EXIT
ENDIF
NEXT
RETURN lFi.AND.lName


STATIC FUNCTION MyEqu(c,cStri)
LOCAL i:=RAT(c,cStri)
RETURN i>0.AND.SUBSTR(cStri,i)==c



STATIC FUNCTION SetSpec(cKey)

IF cKey!=NIL
//   SETKEY(K_CTRL_F5,{||F_Eval(cKey,,.T.,,RIGHT(cKey,1))})
   SETKEY(K_CTRL_F5,{||F_Eval(cKey,,,.T.)})
   ScrTitul(24,"Ctrl-F5:Задание спецфункций")
ELSE
   ScrTitul(24,"")
ENDIF
RETURN .T.


FUNCTION CallExcel(cFile)
LOCAL oApp
IF FILE(cFile)
   TRY
     oApp := CreateObject( "Excel.Application" )
   CATCH
      Alert("Excel не доступен!")
      RETURN .F.
   END
   TRY
      oApp:WorkBooks:Open(cFile)
   CATCH
      oApp:Quit()
      SayError("Excel не может открыть файл "+cFile)
      RETURN .F.
   END
ELSE
   SayError("Не могу открыть "+cFile)
ENDIF
oApp:Visible := .T.
RETURN .T.


STATIC FUNCTION IsFeval(cKey)
LOCAL nArea:=SELECT(),lRet
IF (lRet:=!EMPTY(cKey).AND.NetUse("FEval","FEval").AND.FEval->(DBSEEK(UPPER(cKey))))
   FEval->(DbCloseArea())
ENDIF
SELECT(nArea)
RETURN lRet


STATIC FUNCTION GetSpecKey()
RETURN "ALTX"+ALLTRIM(STR(CheckSum(m->GlobalTask+PROCNAME(2)+PROCNAME(3)+PROCNAME(4)+PROCNAME(5)+PROCNAME(6)+PROCNAME(7)),20,0))




STATIC FUNCTION F_EvalAltX(cTReestr)
LOCAL cSel:=ALIAS(),cNameFile,cParam
LOCAL lExport
LOCAL cColHead:=;
'          Наименование                  Файл        '

LOCAL aBlockCols:= {{{||Left(FEval->Name,30)},1},{{||IF(LEN(ALLTRIM(FEval->NameFile))>20,'...'+RIGHT(ALLTRIM(FEval->NameFile),17),PADR(FEval->NameFile,20))},33}}
LOCAL nTop:=7
LOCAL nBottom:=16
LOCAL nLeftBrd:=6,cCurProc,cFindMacro,aSortSeek

IF !EMPTY(cTReestr).AND.NetUse("FEval","FEval").AND.FEval->(DBSEEK(UPPER(cTReestr)))
   lExport:=RIGHT(ALLTRIM(cTReestr),1)=="E"
   cTReestr:=PADR(cTReestr,20)
   SetScope( 'UPPER(TReestr)',UPPER(PADR(cTReestr,20)) )
   GO TOP
   SKIP
   IF !lExport.and.EOF()
      GO TOP
      SetLastkey(K_ENTER)
   ELSE
      GO TOP
      ShadowBox( ' Специальные функции ',nTop-1,nLeftBrd-1,nBottom+1,61,COL_REFER)
      InitList(nTop,nBottom,cColHead,aBlockCols,cCurProc,,,;
     ,,,,,,aSortSeek,,;
     ,,,,,nLeftBrd,,cFindMacro,COL_REFER)

   ENDIF
   IF LASTKEY()==K_ENTER.AND.!EMPTY(cNameFile:=FEval->NameFile)
      cParam:=FEval->Param
      FEval->(DbCloseArea())
      SELECT(cSel)
      BEGIN SEQUENCE
      FunEval(cNameFile,{},cParam,.T.,lExport)
      END SEQUENCE
   ENDIF
ENDIF
SELECT(cSel)
RETURN .T.


STATIC FUNCTION AllowImport()
LOCAL nArea:=SELECT()
STATIC sPath,sAllow:=.T.
IF SELECT("Tables")==0
   RETURN .T.
ENDIF
IF !EMPTY(sPath).AND.UPPER(DbInfo(10))==sPath
   RETURN sAllow
ENDIF
sPath:=UPPER(DbInfo(10))
sAllow:=Tables->(DbSeek(GetxKey(nArea))).AND.!EMPTY(Tables->Import)
RETURN sAllow


STATIC FUNCTION TmpField(aRes,aZapField)
LOCAL cc:=UPPER(PROCNAME(2)+PROCNAME(3)+PROCNAME(4)+PROCNAME(5)+PROCNAME(6)+PROCNAME(7))
LOCAL a,i,cKey
//1 - TableAlias
//2 - Table_Alias_Ru
//3 - Table_Alias_En
//4 - Field_Alias_Ru
//5 - Field_Alias_En
altd()
DO CASE
   CASE GlobalTask=="IP".AND.ALIAS()=="TMP".AND."CHECK_ORD"$cc
   a:={;
      {"Контроль заказов","Код группы товаров"},;
      {"Контроль заказов","Код артикула в номенклатурном справочнике"},;
      {"Контроль заказов","Количество в заказе"},;
      {"Контроль заказов","Количество в накладной"},;
      {"Контроль заказов","Отклонение по кол-ву"},;
      {"Контроль заказов","Номер накадной"},;
      {"Контроль заказов","Дата накадной"},;
      {"Контроль заказов","Номер заказа"},;
      {"Контроль заказов","Дата заказа"};
      }

END

IF !EMPTY(a)
   FOR i:=1 TO FCOUNT()
   IF TYPE(FIELDNAME(i))!="A".AND.ASCAN(aZapField,FIELDNAME(i))=0
      cKey:=PADR(PADR(ULower(Alias())+"."+ULower(FIELDNAME(i)),22)+TRIM(a[i,2])+;
      " ("+FIELDTYPE(i)+ALLTRIM(STR(FIELDLEN(i)))+IF(FIELDDEC(i)>0,"-"+ALLTRIM(STR(FIELDDEC(i))),"")+")";
      ,100)+TableInfo1(a[i])
      AADD(aRes,cKey)
   ENDIF
   NEXT
ENDIF
RETURN !EMPTY(a)



FUNCTION ExportToCalc(aFields,cKey)
#ifndef __PLATFORM__Linux
//aFields {cAlias,cField,cAliasA,cFieldA}
//cAlias-открытая область,cAliasA,cFieldA-альтернативное имя
LOCAL i,j,nRow,nRow0,nLen,nDec,cType
LOCAL oApp,aName:={},oName,cName
LOCAL cTable,cFi
LOCAL nRec:=RECNO(),cString
LOCAL nProces,nFields:=LEN(aFields)
LOCAL aWidth:=ARRAY(nFields),aPict:=ARRAY(nFields)
LOCAL aVal

F_EvalAltX(cKey)


nProces:=Proces_ini(LASTREC(),,, "Экспорт в Calc")
cListSep:=";"
cDecSep:="."
lIsRus:=.T.

altd()




aVal:=ARRAY(nFields)
FOR i:=1 TO nFields
   cTable:=IF(EMPTY(aFields[i,1]),ALIAS(),aFields[i,1])
   cFi:=aFields[i,2]
   j:=(cTable)->(FIELDNUM(cFi))
   cType:=(cTable)->(FIELDTYPE(j))
   nDec:=(cTable)->(FIELDDECI(j))
   nLen:=(cTable)->(FIELDSIZE(j))
   aWidth[i]:=nLen
   IF cType="N"
      IF nDec=0
         aPict[i]:=REPLICATE("9",nLen)
      ELSE
         aPict[i]:=REPLICATE("9",nLen-nDec-1)+cDecSep+REPLICATE("9",nDec)
      ENDIF
   ELSE
      aPict[i]:=REPLICATE("X",nLen)
   ENDIF
   IF LEN(aFields[i])>4
      aVal[i]:=aFields[i,5]
   ELSE
      aVal[i]:=aFields[i,3]+aFields[i,4]
   ENDIF
   AADD(aName,{cTable+"->"+cFi,2,i,MyAlias(aFields[i])})
NEXT

IF LEN(aName)>0
   oApp:=HOOCalc():New(TempFile(m->GlobalTmpPath,"oxd"),,aWidth,aPict,m->GlobalTmpPath,GetExcelFont(),8)
   oApp:AddRow(aVal)
   aName:=ASORT(aName,,,{|x,y| x[3] <= y[3]})
   
   GO TOP
   WHILE !EOF()
      Proces_Update(nProces)

      FOR i:=1 TO ATAIL(aName)[3] //по колонкам идем
      j:=ASCAN(aName,{|x|x[3]==i})
      IF j>0
         aVal[i]:=&(aName[j,1])
      ELSE
         aVal[i]:=""
      ENDIF
      NEXT
      oApp:AddRow(aVal)
      SKIP
   ENDDO

ENDIF

oApp:Save(.T.)

#endif

RETURN NIL

STATIC FUNCTION EquVal(xFiVal,xVal)
LOCAL cType1:=VALTYPE(xFiVal)
LOCAL cType2:=VALTYPE(xVal)
LOCAL lRez:=.T.
IF cType1$"CM".AND.cType2$"CM"
   lRez:=ALLTRIM(xFiVal)==ALLTRIM(xVal)
ELSEIF (cType1==cType2)
   lRez:=xFiVal==xVal
ENDIF
RETURN lRez
