Initial: flux text FoxBin2Prg (git urmareste .??2 in-arbore, binarele VFP git-ignored)
Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
422
Programe/Vechi/totv.prg
Normal file
422
Programe/Vechi/totv.prg
Normal file
@@ -0,0 +1,422 @@
|
||||
|
||||
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
|
||||
Reference in New Issue
Block a user