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 lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din 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 lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din 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 lcNumef=UPPER(ALLTRIM(tcNumeF)) && numele fisierului din 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