422 lines
10 KiB
Plaintext
422 lines
10 KiB
Plaintext
|
|
DIRFIRM=LOC+'\'+NFSCURT
|
|
If !Directory('&dirfirm\tempo')
|
|
Md &DIRFIRM\tempo
|
|
Endif
|
|
|
|
If !Directory('&CALEFIRMA')
|
|
Do MESAJrosu With 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
|
Quit
|
|
Retry
|
|
Endif
|
|
|
|
Date=CALEFIRMA+'\AN'+m.an+'\DATE'+M.nl
|
|
DATEAN=CALEFIRMA+'\DATEAN'
|
|
CALET=DIRFIRM+'\TEMPO'
|
|
m.ANTET='S.C. '+M.FLUNG
|
|
Wait ' ' Timeout 0.01
|
|
Close Database all
|
|
|
|
|
|
|
|
|
|
***------------------------------------------------------------------
|
|
DO DESCHIDPROG && DESCHID FISTOTV
|
|
|
|
***------------------------------------------------------------------
|
|
DO scanez_fistotv IN totv.prg
|
|
|
|
***------------------------------------------------------------------
|
|
|
|
Return
|
|
***---------------------------------------------------------------------------------------------------
|
|
PROCEDURE scanez_fistotv
|
|
|
|
LOCAL loFis
|
|
|
|
glVerificTabel=.T.
|
|
|
|
DO des WITH "OPTIUNIS"
|
|
SELECT OPTIUNIS
|
|
LOCATE FOR UPPER(OPTIUNE)="VERIFIC TABELE"
|
|
IF !FOUND()
|
|
IF FLOCK()
|
|
APPEND BLANK
|
|
REPLACE optiune WITH "VERIFIC TABELE"
|
|
REPLACE da WITH glVerificTabel
|
|
UNLOCK
|
|
ENDIF
|
|
ENDIF
|
|
|
|
glVerificTabel=da
|
|
|
|
IF USED('optiuniS')
|
|
USE IN optiuniS
|
|
ENDIF
|
|
|
|
******************************** verific daca exista nomenclatorul propriu de gestiuni
|
|
LOCAL lcsepar
|
|
STORE .f. to lcsepar
|
|
lcFisGest = ADDBS(datean) + 'numegestmf.dbf'
|
|
IF !FILE(lcfisgest)
|
|
lcsepar = .t.
|
|
ENDIF
|
|
********************************
|
|
|
|
SELE fistotv
|
|
MAXS=RECCOUNT()
|
|
OP=CREA('PROGRESBAR')
|
|
OP.titlu.CAPTION='Se pregatesc datele lunii '+m.nl+' '+m.an
|
|
OP.SHOW()
|
|
j=0
|
|
SCAN FOR !EMPTY(numeF)
|
|
SCAT NAME loFis
|
|
*** deschid tabelul si tratez erorile la deschidere
|
|
DO deschidf WITH loFis.calealfa,loFis.cale,loFis.numeF,loFis.ALIAS,loFis.ordine,loFis.exc
|
|
|
|
*** compar tabelul cu structura sa vida
|
|
IF glVerificTabel
|
|
DO verific_tabel WITH loFis.calealfa,loFis.cale,loFis.numeF,loFis.ALIAS IN totv.prg
|
|
ENDIF
|
|
|
|
DO PR WITH j
|
|
ENDSCAN
|
|
IF TYPE('op')='O'
|
|
OP.RELEASE
|
|
ENDIF
|
|
|
|
RELEASE loFis
|
|
|
|
IF lcsepar
|
|
lcFisVechi = ADDBS(datean)+ 'numegest.dbf'
|
|
SELECT numegest
|
|
APPEND FROM (lcFisVechi)
|
|
DELETE from numegest WHERE gest # -1 AND gest NOT in (sele distinct gest FROM mf)
|
|
ENDIF
|
|
|
|
ENDPROC && scanez_fistotv
|
|
|
|
|
|
***---------------------------------------------------------------------------------------------------
|
|
PROCEDURE deschidf
|
|
PARAM tcCalealfa,tcCale,tcNumeF,tcAlias,tcOrdine,tcExc
|
|
|
|
LOCAL lcCaleAlfa,lcCale,LCALIAS,lcNumef,lcDBFc,lcDBFs,lcCDXc,lcCDXs,lcTablec,lcTables
|
|
|
|
lcCaleAlfa=ALLTRIM(tcCalealfa) && calea catre structura vida a tabelului
|
|
lcCale=ALLTRIM(tcCale) && calea catre tabel
|
|
LCALIAS=UPPER(ALLTRIM(tcAlias)) && alias-ul din <FISTOTV>
|
|
lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din <FISTOTV>
|
|
lcOrdine=ALLTRIM(tcOrdine)
|
|
lcExc=ALLTRIM(tcExc)
|
|
|
|
lcDBFc=lcCale+'\'+lcNumef+'.dbf'
|
|
lcDBFs=lcCaleAlfa+'\'+lcNumef+'.dbf'
|
|
|
|
lcTablec=lcCale+'\'+lcNumef+'.*'
|
|
lcTables=lcCaleAlfa+'\'+lcNumef+'.*'
|
|
|
|
|
|
|
|
PRIVATE lcOldError
|
|
lcOldError=ON("error")
|
|
|
|
IF !FILE('&lcDBFc')
|
|
IF INLIST(lcNumef,'ACT','RULL')
|
|
DO danuquit WITH 'Nu exista fisierul "'+ALLT(lcDBFc)+'". Il inlocuim cu o structura vida?'
|
|
ENDIF
|
|
IF FILE('&lcDBFs')
|
|
COPY FILE ('&lcTables') TO ('&lcTablec')
|
|
ELSE
|
|
DO MESAJrosu WITH 'Nu exista structura vida a fisierului "'+lcNumef+'".','Sugeram iesirea din program.'
|
|
QUIT
|
|
RETRY
|
|
ENDIF
|
|
ENDIF
|
|
|
|
|
|
|
|
|
|
*!* *** AFLU DACA FISIERUL ARE REFERINTA CATRE UN CDX
|
|
llcdx=.F.
|
|
IF !EMPTY(lcOrdine)
|
|
llcdx=.T.
|
|
ENDIF
|
|
|
|
llUsed=.F.
|
|
IF USED(LCALIAS)
|
|
llUsed=.T.
|
|
USE IN (LCALIAS)
|
|
ENDIF
|
|
filehandle=FOPEN('&lcDBFc',10) && Open the file
|
|
IF filehandle > 0
|
|
*!* WAIT WINDOW 'Fopen '+LCALIAS NOWA
|
|
=FSEEK(filehandle, 28,0) && Move pointer before 29th byte
|
|
cdxbyte = ASC(FGETS(filehandle,1)) && read byte 29
|
|
IF cdxbyte % 2 = 1 && test if it has a cdx
|
|
llcdx=.T.
|
|
ENDIF
|
|
|
|
FCLOSE(filehandle)
|
|
IF llUsed
|
|
DO des WITH LCALIAS
|
|
ENDIF
|
|
ENDIF
|
|
*!* ***--------------------------------
|
|
|
|
SELECT 0
|
|
lccommand=[USE "]+lcDBFc+[" ]+ALLTRIM(lcExc)+[ AGAIN ALIAS ]+LCALIAS+IIF(llcdx," order 1","")
|
|
|
|
ON ERROR DO errdeschid WITH lcCaleAlfa,lcCale,lcNumef,LCALIAS,ERROR(),MESSAGE(),PROGRAM()
|
|
|
|
&lccommand
|
|
|
|
|
|
|
|
|
|
IF !EMPTY(lcOrdine)
|
|
IF USED(LCALIAS)
|
|
SELECT (LCALIAS)
|
|
SET ORDER TO TAG &lcOrdine && "VAL(NRCRT)"
|
|
ENDIF
|
|
ENDIF
|
|
|
|
ON ERROR &lcOldError
|
|
|
|
ENDPROC && deschidf
|
|
|
|
|
|
|
|
*______________________
|
|
PROC errdeschid
|
|
PARAM tcCalealfa,tcCale,tcNumeF,tcAlias,tnError,tcmessage,tcprogram
|
|
|
|
PRIVATE lcCaleAlfa,lcCale,LCALIAS,lcNumef,lcDBFc,lcDBFs,lcCDXc,lcCDXs,lcTablec,lcTables
|
|
|
|
lcCaleAlfa=ALLTRIM(tcCalealfa) && calea catre structura vida a tabelului
|
|
lcCale=ALLTRIM(tcCale) && calea catre tabel
|
|
LCALIAS=UPPER(ALLTRIM(tcAlias)) && alias-ul din <FISTOTV>
|
|
lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din <FISTOTV>
|
|
|
|
lcDBFc=lcCale+'\'+lcNumef+'.dbf'
|
|
lcCDXc=lcCale+'\'+lcNumef+'.cdx'
|
|
lcDBFs=lcCaleAlfa+'\'+lcNumef+'.dbf'
|
|
lcCDXs=lcCaleAlfa+'\'+lcNumef+'.cdx'
|
|
|
|
lcTablec=lcCale+'\'+lcNumef+'.*'
|
|
lcTables=lcCaleAlfa+'\'+lcNumef+'.*'
|
|
|
|
|
|
|
|
DO MESAJ WITH 'Fisier: '+ALLTRIM(lcNumef)+" Eroarea nr. "+ALLTRIM(STR(tnError)),tcmessage+" "+tcprogram
|
|
|
|
|
|
&& de aici nu mai procesez erorile
|
|
PRIVATE lcOldError
|
|
lcOldError=ON("error")
|
|
ON ERROR *
|
|
&&
|
|
|
|
DO CASE
|
|
|
|
CASE INLIST(tnError,5,19,26,114,1707,1683)&&Index file does not match table. sau Table has no index order set
|
|
DO mesajatent WITH 'Se reindexeaza fisierul "'+lcNumef+'"',''
|
|
|
|
IF FILE('&lcCDXs') AND lcCale#lcCaleAlfa
|
|
&& inchid tabelul
|
|
IF USED(LCALIAS) && fisierul trebuie sa fie inchis ca sa pot sa fac append din el in structura vida si sa-l redenumesc
|
|
USE IN (LCALIAS)
|
|
ENDIF
|
|
|
|
&& reindexez
|
|
DO REINDFCDX WITH lcCaleAlfa,lcCale,lcNumef IN reindexare.prg
|
|
|
|
&& deschid din nou tabelul reindexat
|
|
DO des WITH LCALIAS
|
|
|
|
|
|
ELSE && nu exista indexul (.cdx) in structurile vide sau e un fisier din alfa
|
|
DO MESAJrosu WITH 'Nu se poate reindexa fisierul "'+ALLT(lcNumef)+'".','Sugeram iesirea din program.'
|
|
QUIT
|
|
RETRY
|
|
ENDIF
|
|
|
|
CASE INLIST(tnError,15,41) &&Not a table, memo file missing or invalid
|
|
DO danuquit WITH 'Fisierul "'+lcNumef+'" este defect. Il inlocuim cu o structura vida/standard?'
|
|
|
|
&& inchid tabelul
|
|
llUsed=.F.
|
|
|
|
IF USED(LCALIAS) && fisierul trebuie sa fie inchis ca sa pot sa fac append din el in structura vida si sa-l redenumesc
|
|
llUsed=.T.
|
|
USE IN (LCALIAS)
|
|
ENDIF
|
|
|
|
&& fac backup
|
|
lcFisS=lcTablec
|
|
lcFisD=lcCale+'\'+"bk_"+STRTRAN(DTOC(DATE()),"/","")+"_%"+lcNumef+'.*'
|
|
COPY FILE ('&lcFisS') TO ('&lcFisD')
|
|
|
|
&& copiez structura vida
|
|
IF FILE('&lcDBFs')
|
|
COPY FILE ('&lcTables') TO ('&lcTablec')
|
|
RETRY
|
|
ELSE
|
|
DO MESAJrosu WITH 'Nu exista structura vida a fisierului <'+lcNumef+'>.','Sugeram iesirea din program.'
|
|
QUIT
|
|
RETRY
|
|
ENDIF
|
|
|
|
&& deschid fisierul
|
|
|
|
DO des WITH LCALIAS
|
|
|
|
|
|
CASE INLIST(tnError,3,1705) &&File is in use. or File access is denied.
|
|
|
|
DO MESAJrosu WITH 'Fisierul "'+lcNumef+'" este deschis de alt program.','Inchideti fisierul si apoi redeschideti programul.'
|
|
QUIT
|
|
RETRY
|
|
|
|
OTHERWISE
|
|
|
|
DO MESAJrosu WITH 'Eroare necunoscuta (Nr.'+ALLT(STR(tnError))+')', 'Sugeram iesirea din program.'
|
|
QUIT
|
|
RETRY
|
|
ENDCASE
|
|
|
|
ENDPROC && ErrDeschid
|
|
|
|
|
|
|
|
|
|
|
|
*____________________
|
|
PROCEDURE errgen
|
|
DO MESAJrosu WITH 'Eroare necunoscuta (Nr.'+ALLT(STR(ERROR()))+')', 'Sugeram iesirea din program.'
|
|
QUIT
|
|
RETRY
|
|
ENDPROC && errgen
|
|
|
|
|
|
|
|
*___ PROCEDURA DE DESCHIDERE DIN AFARA LUI TOTV_________________________________________________
|
|
PROCEDURE des
|
|
PARAM tcAlias
|
|
|
|
PRIVATE lcAlias
|
|
|
|
|
|
LCALIAS=UPPER(ALLTRIM(tcAlias))
|
|
|
|
IF !DIRECTORY('&CALEFIRMA')
|
|
DO MESAJrosu WITH 'Calea '+CALEFIRMA+' este incorecta!','Sugeram iesirea din program.'
|
|
QUIT
|
|
RETRY
|
|
ENDIF
|
|
*DATE=CALEFIRMA+'\AN'+M.an+'\DATE'+M.nl
|
|
|
|
IF !USED('FISTOTV')
|
|
DO DESCHIDPROG && DESCHID FISTOTV
|
|
ENDIF
|
|
|
|
|
|
|
|
SELE fistotv
|
|
LOCA FOR ALLT(UPPER(ALIAS))==LCALIAS
|
|
IF !FOUND()
|
|
DO MESAJrosu WITH 'Alias '+LCALIAS+' inexistent!','Sugeram iesirea din program.'
|
|
QUIT
|
|
RETRY
|
|
ELSE
|
|
SCAT NAME loFis
|
|
DO deschidf WITH loFis.calealfa,loFis.cale,loFis.numeF,loFis.ALIAS,loFis.ordine,loFis.exc
|
|
RELEASE loFis
|
|
|
|
ENDIF
|
|
|
|
ENDPROC && DES
|
|
|
|
|
|
|
|
*------------------------------------------------
|
|
PROCEDURE orori
|
|
DO MESAJ WITH "Contactati firma Romfast",""
|
|
QUIT
|
|
RETRY
|
|
ENDPROC && orori
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
***---------------------------------------------------------------------------------------------------
|
|
PROCEDURE verific_tabel
|
|
PARAMETERS tcCalealfa,tcCale,tcNumeF,tcAlias
|
|
|
|
PRIVATE lcCaleAlfa,lcCale,LCALIAS,lcNumef,lcFisierAlfa,lcFisierFirma
|
|
|
|
lcCaleAlfa=ALLTRIM(tcCalealfa) && calea catre structura vida a tabelului
|
|
lcCale=ALLTRIM(tcCale) && calea catre tabel
|
|
LCALIAS=UPPER(ALLTRIM(tcAlias)) && alias-ul din <FISTOTV>
|
|
lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din <FISTOTV>
|
|
|
|
lcFisierAlfa=ALLTRIM(tcCalealfa)+"\"+ALLTRIM(tcNumeF)+".dbf"
|
|
lcFisierFirma=DBF(LCALIAS)
|
|
|
|
|
|
IF UPPER(ALLTRIM(lcCale))=UPPER(ALLTRIM(lcCalealfa)) && nu verific tabelele care nu au structura vida
|
|
RETURN
|
|
ENDIF
|
|
* WAIT WINDOW "Se verifica "+lcAlias NOWAIT
|
|
lnCompar=compara_tabele(LCALIAS,lcFisierAlfa)
|
|
|
|
DO CASE
|
|
CASE lnCompar=0 && OK
|
|
*
|
|
CASE lnCompar = 1 && structura vida nu exista
|
|
*
|
|
CASE INLIST(lnCompar, 2, 3, 4) && coloane diferite, taguri diferite
|
|
|
|
llUsed=.F.
|
|
IF USED(LCALIAS)
|
|
llUsed=.T.
|
|
USE IN (LCALIAS)
|
|
ENDIF
|
|
|
|
x=FOPEN(lcFisierFirma,12)
|
|
|
|
IF x<0 && daca nu pot sa il deschid exclusiv
|
|
DO MESAJ WITH "Fisierul "+lcFisierFirma+" ("+ALLTRIM(STR(lnCompar))+")"," Trebuie reindexat."
|
|
ELSE
|
|
FCLOSE(x)
|
|
DO DASAUNU WITH "Se reindexeaza fisierul "+lcFisierFirma+" ("+ALLTRIM(STR(lnCompar))+")?"
|
|
IF buton=1
|
|
IF INLIST(lnCompar, 2, 4) && coloane diferite
|
|
DO REINDF WITH lcCalealfa,lcCale,lcNumeF,lcAlias IN reindexare.prg
|
|
ELSE && taguri diferite
|
|
DO REINDFCDX WITH lcCalealfa,lcCale,lcNumeF IN reindexare.prg
|
|
ENDIF
|
|
ENDIF
|
|
ENDIF
|
|
|
|
|
|
DO des WITH tcAlias
|
|
|
|
ENDCASE
|
|
|
|
ENDPROC && verific_tabel
|
|
|
|
***--------------------------------------------------------------------------
|
|
PROCEDURE DESCHIDPROG
|
|
|
|
local lcAlias, lcFis, lcDir
|
|
lcDir = ADDBS(gcAppPath)+[date\datean]
|
|
lcFis = [fistotvmf]
|
|
lcAlias = [fistotv]
|
|
|
|
Do deschidf With lcDir,lcDir,lcFis,lcAlias,'CALE',''
|
|
|
|
ENDPROC && deschidprog |