Noutati Contafin

+ + Noutati + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+ + + + +

+ + + + + + + + + + + + + +

+ + + + + +

+ + + + +

+ + + +

+ + +

+ + + + +

+ +

+ +

+ + + + + + + + +

+ <%= ALLTRIM(NVL(nume_program, '')) %> v <%= ALLTRIM(NVL(versiune,'')) %> - <%= ALLTRIM(DTOC(TTOD(NVL(datal, {//::})))) %> +
+

+<%= IIF(!ISNULL(titlu), ALLTRIM(titlu) + ' - ', '') + ALLTRIM(STRTRAN(explicatie_client, CHR(13) + CHR(10), '
')) %> +
+

+ +

+ + + + + + \ No newline at end of file diff --git a/noutati-template.html b/noutati-template.html new file mode 100644 index 0000000..3511331 --- /dev/null +++ b/noutati-template.html @@ -0,0 +1,211 @@ + + + Noutati + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +

+ + + + +

+ + + + + + + + + + + + + +

+ + + + + +

+ + + + +

+ + + +

+ + +

+ + + + +

+ +

+ + + + + + \ No newline at end of file diff --git a/programe/actualizare_roa.prg b/programe/actualizare_roa.prg new file mode 100644 index 0000000..f712f8d --- /dev/null +++ b/programe/actualizare_roa.prg @@ -0,0 +1,140 @@ +Local lcDir, lcSchema , lcsql , lcsql1 +lcSchema = "" +lcDir = "" +lcSql = "" +lcActualizare = "" +lcDir = ReadINI(goApp.cIniFile, "folder", "script_folder") +lcSchema = goApp.cUserName +If Empty(lcDir) Or !Directory(lcDir) + lcDir = Getdir("d:\contafin_oracle\comun\scripturi\","Alegeti directorul cu scripturile","Director scripturi") + If Empty(lcDir) + Return + Endif + WriteINI(goApp.cIniFile, "folder", "script_folder", lcDir) +Endif +lcDir = ADDBS(m.lcDir) +* 09.07.2020 +* Nu mai criptez scripturile, deci o sa iau scripturile din SCRIPTURI_CLAR, in loc de directorul SCRIPTURI +lcDir = STRTRAN(m.lcDir, '\SCRIPTURI\', '\SCRIPTURI_CLAR\',1,1,1) + +Cd (lcDir) + +*** cursor crsScripturiMasa cu scripturi pe care doresc sa le execut +CREATE CURSOR crsScripturiMasa (script c(250), Data D, tip c(100), seq N(5), dataseq c(20), ; + ales L, aplicat N(1), rec N(5), filename c(250), aplicat2 N(1), server c(100), schema c(100)) + +*** cursor crsScripturi cu scripturile fizice - pentru generarea xml cu scripturi de aplicat pe scheme +Create Cursor crsScripturi (script c(250), Data D, tip c(100), seq N(5), dataseq c(20), ; + ales L, aplicat N(1), rec N(5), filename c(250), aplicat2 N(1), server c(100), schema c(100)) + +Wait Window 'xdir' Nowait + + +loList = Newobject("fileslist","xrecurse.prg") +loList.FileExtensions = 'sql' +loList.Recurse(lcDir) + +If Reccount('dirlist')=0 + Use + Return +Endif + + +Wait Window 'insert into crsScripturi' Nowait +Select dirlist +Scan + lcFileName = Addbs(Alltrim(DIRNAME)) + Alltrim(filename) + lcScript = Upper(Alltrim(filename)) + lcScript = Strtran(lcScript, 'SCRIPT_', '') + + lnPos1 = At("_", lcScript, 1) + lnPos2 = At("_", lcScript, 2) + lnPos3 = At("_", lcScript, 3) + lnPos4 = At("_", lcScript, 4) + lnPos5 = At("_", lcScript, 5) + lnPos6 = At("_", lcScript, 5) + + lnPosp = At(".", lcScript, 1) + + lnOccurs = Occurs('_', lcScript) + + If lnOccurs = 4 + lcAn = Substr(lcScript,lnPos1 + 1, 4) + lcLuna = Substr(lcScript,lnPos2 + 1, 2) + lcZi = Substr(lcScript,lnPos3 + 1, lnPos4 - lnPos3 - 1) + lcSeq = Substr(lcScript,lnPos4 + 1, lnPosp - lnPos4 - 1) + + + lcTip = "" + Else + lcAn = Substr(lcScript,lnPos1 + 1, 4) + lcLuna = Substr(lcScript,lnPos2 + 1, 2) + lcZi = Substr(lcScript,lnPos3 + 1, lnPos4 - lnPos3 - 1) + lcSeq = Substr(lcScript,lnPos4 + 1, lnPos5 - lnPos4 - 1) + lcTip = Substr(lcScript,lnPos5 + 1, lnPosp - lnPos5 - 1) + + Endif + + lcScript = Lower(lcScript) + lnSeq = Round(Val(lcSeq),0) + lcDataSeq = Padl(lcAn,4,'0') + '_' + Padl(lcLuna,2,'0') + '_' + Padl(lcZi,2,'0') + '_' + Padl(lcSeq,2,'0') + + lnAn = Val(lcAn) + lnLuna = Val(lcLuna) + lnZi = Val(lcZi) + + + If lnAn < 2000 Or lnAn > 2099 + lnAn = Year(Date()) + Endif + If !Between(lnLuna,1,12) + lnLuna = Month(Date()) + Endif + If !Between(lnZi, 1, 31) + lnZi = 1 + Endif + + ldData = Date(lnAn, lnLuna, lnZi) + *** nu mai ma intereseaza scripturile mai vechi de 2011 + if year(m.ldData) < 2011 + loop + endif + + Insert Into crsScripturi (script, Data, seq, dataseq, tip, filename, server, schema ) ; + Values (Upper(lcScript), ldData, lnSeq, lcDataSeq, lcTip, lcFileName, server, schema) +ENDSCAN + + +lcSql = [select 0 as ales, id, customer_id, customer_name, dsn, server, schema, parola ] + ; + [from UPD_VSCHEME order by customer_name, server, schema] + +use in (select('crsScheme')) +lnSucces = goExecutor.oExecute(lcSql, 'crsScheme') +If lnSucces < 0 + Messagebox(goExecutor.cEroare,0+16, 'Eroare') +Endif + + +Use In (SELECT("dirlist")) + + +Select crsScripturi + +Index On LEFT(script,100) Tag scriptName +Set Order To scriptName Descending + +Select crsScripturi +Go Top + + +SELECT crsScheme +GO top +loFrmExecute = Createobject("frm_actualizare_roa") +*!* loFrmExecute.cDirScripturi = lcDir +*!* loFrmExecute.grdScripturi.SetAll("DynamicBackColor","iif(aplicat = 0, IIF(aplicat2=1,RGB(255,200,200),RGB(255,255,225)), RGB(255,255,255))", "Column") +loFrmExecute.Show(1) + +use in (select('crsScheme')) +Use In (select('dirlist')) +Use In (select('crsScripturi')) + diff --git a/programe/conectare.prg b/programe/conectare.prg new file mode 100644 index 0000000..8fba2fd --- /dev/null +++ b/programe/conectare.prg @@ -0,0 +1,22 @@ +* Test conectare +x=CREATE('conectare') +DEFINE CLASS Conectare AS Conectare +PROCEDURE INIT + DODEFAULT() +IF !FILE(lcIniFile) + SET TEXTMERGE ON TO MEMVAR lcTextIni + ENDIF +\[connection] +\host=ROA_ROMFAST2 +\username=test +\password=123 + SET TEXTMERGE TO + STRTOFILE(lcTextIni, lcIniFile) + + ENDPROC + +ENDDEFINE + + + + \ No newline at end of file diff --git a/programe/execute_script.prg b/programe/execute_script.prg new file mode 100644 index 0000000..90bfa08 --- /dev/null +++ b/programe/execute_script.prg @@ -0,0 +1,157 @@ +*!* EXECUTE_SCRIPT +LOCAL lcDir, lcSchema +lcSchema = "" +lcDir = "" + +lcDir = ReadINI(goApp.cIniFile, "folder", "script_folder") +lcSchema = goApp.cUserName +IF EMPTY(lcDir) OR !DIRECTORY(lcDir) + lcDir = GETDIR("d:\contafin_oracle\comun\scripturi\","Alegeti directorul cu scripturile","Director scripturi") + IF EMPTY(lcDir) + RETURN + ENDIF + WriteINI(goApp.cIniFile, "folder", "script_folder", lcDir) +ENDIF + +CD (lcDir) + +CREATE CURSOR crsScripturi (script c(100), DATA D, tip c(20), seq N(5), dataseq c(20), ales L, aplicat N(1), rec N(5), filename c(100), aplicat2 n(1)) +IF UPPER(ALLTRIM(lcSchema)) = "CONTAFIN_ORACLE" + lnFiles = ADIR(laScripts, 'co_*.sql') +ELSE + lnFiles = ADIR(laScripts, 'ff_*.sql') +ENDIF + +FOR i = 1 TO lnFiles + lcFileName = laScripts(i,1) + lcScript = UPPER(laScripts(i,1)) + lcScript = STRTRAN(lcScript, 'SCRIPT_', '') + + lnPos1 = AT("_", lcScript, 1) + lnPos2 = AT("_", lcScript, 2) + lnPos3 = AT("_", lcScript, 3) + lnPos4 = AT("_", lcScript, 4) + lnPos5 = AT("_", lcScript, 5) + lnPos6 = AT("_", lcScript, 5) + lnPosp = AT(".", lcScript, 1) + + *!* ff_2006_04_04_01_COMUN_CONTABILITATE.sql + *!* cf_2006_02_22_1.sql + lnOccurs = OCCURS('_', lcScript) + + IF lnOccurs = 4 + lcAn = SUBSTR(lcScript,lnPos1 + 1, 4) + lcLuna = SUBSTR(lcScript,lnPos2 + 1, 2) + lcZi = SUBSTR(lcScript,lnPos3 + 1, lnPos4 - lnPos3 - 1) + lcSeq = SUBSTR(lcScript,lnPos4 + 1, lnPosp - lnPos4 - 1) + lcTip = "" + ELSE + lcAn = SUBSTR(lcScript,lnPos1 + 1, 4) + lcLuna = SUBSTR(lcScript,lnPos2 + 1, 2) + lcZi = SUBSTR(lcScript,lnPos3 + 1, lnPos4 - lnPos3 - 1) + lcSeq = SUBSTR(lcScript,lnPos4 + 1, lnPos5 - lnPos4 - 1) + lcTip = SUBSTR(lcScript,lnPos5 + 1, lnPosp - lnPos5 - 1) + ENDIF + + lcScript = LOWER(lcScript) + lnSeq = ROUND(VAL(lcSeq),0) + lcDataSeq = PADL(lcAn,4,'0') + '_' + PADL(lcLuna,2,'0') + '_' + PADL(lcZi,2,'0') + '_' + PADL(lcSeq,2,'0') + + lnAn = VAL(lcAn) + lnLuna = VAL(lcLuna) + lnZi = VAL(lcZi) + + + IF lnAn < 2000 OR lnAn > 2099 + lnAn = YEAR(DATE()) + ENDIF + IF !BETWEEN(lnLuna,1,12) + lnLuna = MONTH(DATE()) + ENDIF + IF !BETWEEN(lnZi, 1, 31) + lnZi = 1 + ENDIF + + ldData = DATE(lnAn, lnLuna, lnZi) + + + INSERT INTO crsScripturi (script, DATA, seq, dataseq, tip, filename) VALUES (UPPER(lcScript), ldData, lnSeq, lcDataSeq, lcTip, ADDBS(lcDir) + lcFileName) +ENDFOR + +SELECT crsScripturi +*INDEX ON DTOS(DATA) + PADL(seq,5,'0') TAG dataseq +*SET ORDER TO dataseq DESCENDING +INDEX ON script TAG scriptName +SET ORDER TO scriptName DESCENDING + +*lcSql = [select script_final as script, data_script as data, tip_script as tip, seq_script as seq, 0 as aplicat, 00000 as rec from versiune order by data_script desc, seq_script desc] +lcSql=[select distinct (case when UPPER(TRIM(script_final)) not like '%.SQL' ]+; + [then UPPER(TRIM(script_final))||'.SQL' else UPPER(TRIM(script_final)) end) ]+; + [as script, data_script as data, tip_script as tip, seq_script as seq, 0 as aplicat, 00000 as rec ] +; + [from versiune order by 1 desc] + +lnSucces = goExecutor.oExecute(lcSql, 'crsScripturiVersiune1') +IF lnSucces < 0 + MESSAGEBOX(goExecutor.cEroare,0+16, 'Eroare') +ENDIF +IF lnSucces > 0 + + UPDATE crsScripturiVersiune1 SET script = SUBSTR(script,8) WHERE UPPER(LEFT(script,7)) = 'SCRIPT_' + SELECT * FROM crsScripturiVersiune1 WITH (BUFFERING = .T.) INTO CURSOR crsScripturiVersiune ORDER BY script DESC READWRITE + + + UPDATE crsScripturi SET aplicat = 1 ; + WHERE UPPER(ALLTRIM(script)) IN ; + (SELECT UPPER(ALLTRIM(script)) FROM crsScripturiVersiune) + UPDATE crsScripturi SET ales = .T. ; + WHERE aplicat = 0 + +*!* DESELECTEZ SCRIPTURILE NEAPLICATE CARE MAI AU CEL PUTIN UN SCRIPT DE ACELASI TIP APLICAT CU O DATA MAI MARE + + SELECT crsScripturi + SCAN FOR ales + lcScript = ALLTRIM(UPPER(script)) + lcTip = UPPER(ALLTRIM(GETWORDNUM(JUSTSTEM(script),6,'_'))) + SELECT COUNT(*) AS NR ; + FROM crsScripturi ; + WHERE aplicat = 1 AND ALLTRIM(UPPER(script)) > lcScript AND UPPER(ALLTRIM(GETWORDNUM(JUSTSTEM(script),6,'_'))) = lcTip ; + INTO CURSOR crsScripturiAplicate + IF _TALLY > 0 AND crsScripturiAplicate.nr > 0 + REPLACE aplicat2 WITH 1, ales WITH .F. IN crsScripturi + ENDIF + USE IN crsScripturiAplicate + SELECT crsScripturi + ENDSCAN + + SELECT crsScripturiVersiune + SCAN + lcScriptName = PADR(UPPER(ALLTRIM(script)),100," ") + IF SEEK(lcScriptName, 'crsScripturi', 'scriptName') + REPLACE rec WITH RECNO('crsScripturi') IN crsScripturiVersiune + REPLACE rec WITH RECNO('crsScripturiVersiune') IN crsScripturi + ENDIF + ENDSCAN + + SELECT crsScripturi + GO TOP + SELECT crsScripturiVersiune + GO TOP + + loFrmExecute = CREATEOBJECT("frm_exec_script") + loFrmExecute.cDirScripturi = lcDir + loFrmExecute.lbScripturiDirector.CAPTION = lcDir + loFrmExecute.grdScripturi.SETALL("DynamicBackColor","iif(aplicat = 0, IIF(aplicat2=1,RGB(255,200,200),RGB(255,255,225)), RGB(255,255,255))", "Column") + + *!* loFrmExecute.grdScripturiVersiune.SETALL("DynamicBackColor","iif(aplicat = 1, RGB(255,255,225), RGB(255,255,255))", "Column") + loFrmExecute.SHOW(1) + *!* DO FORM frm_exec_script NAME loFrmExecute LINKED +ENDIF + +USE IN crsScripturi +USE IN crsScripturiVersiune + +*!* PRIVATE poScripturi +*!* lcCursor = "crsScripturi" +*!* lcSelect = "" +*!* poScripturi = null +*!* gencursor('poScripturi',lccursor,tcselect,tcfiltru,tcschema,tcorder,.F.,'', llModParam ,lcFiltOriginal) diff --git a/programe/execute_script_xdir.prg b/programe/execute_script_xdir.prg new file mode 100644 index 0000000..d9ae53d --- /dev/null +++ b/programe/execute_script_xdir.prg @@ -0,0 +1,222 @@ +*!* EXECUTE_SCRIPT +Local lcDir, lcSchema +lcSchema = "" +lcDir = "" + +lcDir = ReadINI(goApp.cIniFile, "folder", "script_folder") +lcSchema = goApp.cUserName +If Empty(lcDir) Or !Directory(lcDir) + lcDir = Getdir("d:\contafin_oracle\comun\scripturi\","Alegeti directorul cu scripturile","Director scripturi") + If Empty(lcDir) + Return + Endif + WriteINI(goApp.cIniFile, "folder", "script_folder", lcDir) +Endif + +Cd (lcDir) +Create Cursor crsScripturi (script c(100), Data D, tip c(20), seq N(5), dataseq c(20), ales L, aplicat N(1), rec N(5), filename c(100), aplicat2 N(1)) + +Wait Window 'xdir' Nowait +*!* oFolder=CREATEOBJECT('files_list') && xdir.prg +*!* oFolder.prompt_completed=.F. &&Preview/Print without message +*!* oFolder.FileExtensions = 'sql' +*!* oFolder.IgnoreEmptyFolders= .T. +*!* oFolder.xScan(lcDir) + +loList = Newobject("fileslist","xrecurse.prg") +loList.FileExtensions = 'sql' +loList.Recurse(lcDir) + +If Reccount('dirlist')=0 + Use + Return +Endif + +lcPrefixScript = ReadINI(goApp.cIniFile, "script", Alltrim(lcSchema)) && CO_, RF_, SYS_, JCS_ +lcPrefixScript = Upper(Nvl(lcPrefixScript,'')) +If Empty(lcPrefixScript) + lcPrefixScript = ReadINI(goApp.cIniFile, "script", 'SCHEMAROA') && FF_ +Endif +lcPrefixScript = Upper(Nvl(lcPrefixScript,'')) +If !Empty(lcPrefixScript) + Select dirlist + Set Filter To Like(lcPrefixScript + '*', Upper(filename)) +Else + Do Case + Case Upper(Alltrim(lcSchema)) = "CONTAFIN_ORACLE" + Select dirlist + Set Filter To Like('CO_*', Upper(filename)) + Case Upper(Alltrim(lcSchema)) = "SYS" + Select dirlist + Set Filter To Like('SYS_*', Upper(filename)) + Otherwise + Select dirlist + Set Filter To !(Like('CO_*', Upper(filename)) Or Like('SYS_*', Upper(filename))) + + Endcase +Endif + +*!* IF UPPER(ALLTRIM(lcSchema)) = "CONTAFIN_ORACLE" +*!* lnFiles = ADIR(laScripts, 'co_*.sql') +*!* ELSE +*!* lnFiles = ADIR(laScripts, 'ff_*.sql') +*!* ENDIF + +Wait Window 'insert into crsScripturi' Nowait +Select dirlist +Scan + +*!* FOR i = 1 TO lnFiles +*!* lcFileName = laScripts(i,1) + lcFileName = Addbs(Alltrim(DIRNAME)) + Alltrim(filename) + lcScript = Upper(Alltrim(filename)) + lcScript = Strtran(lcScript, 'SCRIPT_', '') + + lnPos1 = At("_", lcScript, 1) + lnPos2 = At("_", lcScript, 2) + lnPos3 = At("_", lcScript, 3) + lnPos4 = At("_", lcScript, 4) + lnPos5 = At("_", lcScript, 5) + lnPos6 = At("_", lcScript, 5) + + lnPosp = At(".", lcScript, 1) + + + +*!* ff_2006_04_04_01_COMUN_CONTABILITATE.sql +*!* cf_2006_02_22_1.sql + lnOccurs = Occurs('_', lcScript) + + If lnOccurs = 4 + lcAn = Substr(lcScript,lnPos1 + 1, 4) + lcLuna = Substr(lcScript,lnPos2 + 1, 2) + lcZi = Substr(lcScript,lnPos3 + 1, lnPos4 - lnPos3 - 1) + lcSeq = Substr(lcScript,lnPos4 + 1, lnPosp - lnPos4 - 1) + + + lcTip = "" + Else + lcAn = Substr(lcScript,lnPos1 + 1, 4) + lcLuna = Substr(lcScript,lnPos2 + 1, 2) + lcZi = Substr(lcScript,lnPos3 + 1, lnPos4 - lnPos3 - 1) + lcSeq = Substr(lcScript,lnPos4 + 1, lnPos5 - lnPos4 - 1) + lcTip = Substr(lcScript,lnPos5 + 1, lnPosp - lnPos5 - 1) + + Endif + + lcScript = Lower(lcScript) + lnSeq = Round(Val(lcSeq),0) + lcDataSeq = Padl(lcAn,4,'0') + '_' + Padl(lcLuna,2,'0') + '_' + Padl(lcZi,2,'0') + '_' + Padl(lcSeq,2,'0') + + lnAn = Val(lcAn) + lnLuna = Val(lcLuna) + lnZi = Val(lcZi) + + + If lnAn < 2000 Or lnAn > 2099 + lnAn = Year(Date()) + Endif + If !Between(lnLuna,1,12) + lnLuna = Month(Date()) + Endif + If !Between(lnZi, 1, 31) + lnZi = 1 + Endif + + ldData = Date(lnAn, lnLuna, lnZi) + + + Insert Into crsScripturi (script, Data, seq, dataseq, tip, filename) Values (Upper(lcScript), ldData, lnSeq, lcDataSeq, lcTip, lcFileName) + +*!* ENDFOR +Endscan +Use In dirlist + + + +Select crsScripturi +*INDEX ON DTOS(DATA) + PADL(seq,5,'0') TAG dataseq +*SET ORDER TO dataseq DESCENDING +Index On script Tag scriptName +Set Order To scriptName Descending + +*!* WAIT WINDOW 'select from versiune' NOWAIT +*!* *lcSql = [select script_final as script, data_script as data, tip_script as tip, seq_script as seq, 0 as aplicat, 00000 as rec from versiune order by data_script desc, seq_script desc] +*!* lcSql=[select distinct (case when UPPER(TRIM(script_final)) not like '%.SQL' ]+; +*!* [then UPPER(TRIM(script_final))||'.SQL' else UPPER(TRIM(script_final)) end) ]+; +*!* [as script, data_script as data, tip_script as tip, seq_script as seq, 0 as aplicat, 00000 as rec ] +; +*!* [from versiune order by 1 desc] + +*!* lnSucces = goExecutor.oExecute(lcSql, 'crsScripturiVersiune1') +*!* IF lnSucces < 0 +*!* MESSAGEBOX(goExecutor.cEroare,0+16, 'Eroare') +*!* ENDIF + + +*!* IF lnSucces > 0 +*!* WAIT WINDOW 'update aplicat' NOWAIT +*!* UPDATE crsScripturiVersiune1 SET script = SUBSTR(script,8) WHERE UPPER(LEFT(script,7)) = 'SCRIPT_' +*!* SELECT * FROM crsScripturiVersiune1 WITH (BUFFERING = .T.) INTO CURSOR crsScripturiVersiune ORDER BY script DESC READWRITE + + +*!* UPDATE crsScripturi SET aplicat = 1 ; +*!* WHERE UPPER(ALLTRIM(script)) IN ; +*!* (SELECT UPPER(ALLTRIM(script)) FROM crsScripturiVersiune) +*!* UPDATE crsScripturi SET ales = .T. ; +*!* WHERE aplicat = 0 + +*!* *!* DESELECTEZ SCRIPTURILE NEAPLICATE CARE MAI AU CEL PUTIN UN SCRIPT DE ACELASI TIP APLICAT CU O DATA MAI MARE +*!* WAIT WINDOW 'update aplicat roz' NOWAIT +*!* SELECT crsScripturi +*!* SCAN FOR ales +*!* lcScript = ALLTRIM(UPPER(script)) +*!* lcTip = UPPER(ALLTRIM(GETWORDNUM(JUSTSTEM(script),6,'_'))) +*!* SELECT COUNT(*) AS NR ; +*!* FROM crsScripturi ; +*!* WHERE aplicat = 1 AND ALLTRIM(UPPER(script)) > lcScript AND UPPER(ALLTRIM(GETWORDNUM(JUSTSTEM(script),6,'_'))) = lcTip ; +*!* INTO CURSOR crsScripturiAplicate +*!* IF _TALLY > 0 AND crsScripturiAplicate.NR > 0 +*!* REPLACE aplicat2 WITH 1, ales WITH .F. IN crsScripturi +*!* ENDIF +*!* USE IN crsScripturiAplicate +*!* SELECT crsScripturi +*!* ENDSCAN + +*!* SELECT crsScripturiVersiune +*!* SCAN +*!* lcScriptName = PADR(UPPER(ALLTRIM(script)),100," ") +*!* IF SEEK(lcScriptName, 'crsScripturi', 'scriptName') +*!* REPLACE rec WITH RECNO('crsScripturi') IN crsScripturiVersiune +*!* REPLACE rec WITH RECNO('crsScripturiVersiune') IN crsScripturi +*!* ENDIF +*!* ENDSCAN + +*!* SELECT crsScripturi +*!* GO TOP +*!* SELECT crsScripturiVersiune +*!* GO TOP +Select crsScripturi +Go Top +loFrmExecute = Createobject("frm_exec_script") +loFrmExecute.cDirScripturi = lcDir +*!* loFrmExecute.lbScripturiDirector.CAPTION = lcDir +loFrmExecute.grdScripturi.SetAll("DynamicBackColor","iif(aplicat = 0, IIF(aplicat2=1,RGB(255,200,200),RGB(255,255,225)), RGB(255,255,255))", "Column") + +*!* loFrmExecute.grdScripturiVersiune.SETALL("DynamicBackColor","iif(aplicat = 1, RGB(255,255,225), RGB(255,255,255))", "Column") +loFrmExecute.Show(1) +*!* DO FORM frm_exec_script NAME loFrmExecute LINKED +*!* ENDIF +If Used('dirlist') + Use In dirlist +Endif +If Used('crsScripturi') + Use In crsScripturi +Endif + +*!* USE IN crsScripturiVersiune + +*!* PRIVATE poScripturi +*!* lcCursor = "crsScripturi" +*!* lcSelect = "" +*!* poScripturi = null +*!* gencursor('poScripturi',lccursor,tcselect,tcfiltru,tcschema,tcorder,.F.,'', llModParam ,lcFiltOriginal) diff --git a/programe/generare_script.prg b/programe/generare_script.prg new file mode 100644 index 0000000..9c50904 --- /dev/null +++ b/programe/generare_script.prg @@ -0,0 +1,2 @@ +loFrmGen = Createobject("frm_generare_script") +loFrmGen.Show(1) \ No newline at end of file diff --git a/programe/genereazaxml_original.txt b/programe/genereazaxml_original.txt new file mode 100644 index 0000000..ab28e7b --- /dev/null +++ b/programe/genereazaxml_original.txt @@ -0,0 +1,137 @@ +#Define crlf Chr(13) + Chr(10) + +Local lcSql, lcfile, cVersiune, lcClipText, lcSir, lcFisier, lcDir, lcFisVersDif, ; + lcfileVersiuniMax, lnsucces, lnCustomerId + +lnCustomerId = crs2xml.id + + +lcClipText = [] +lcSir = [] +lcFisier = [] +lcDir = [] +lcFisVersDif = [] +x = SQLConnect("JCSSERVER","SOFT_SERII","123") +If x < 0 + Return +Endif + +lcSql = [select DISTINCT customer_id, NUME, ID_PROGRAM, (CASE WHEN Upper(PROGRAM) ] + ; + [LIKE 'INDEX%' THEN 'MANUAL' ELSE PROGRAM END) AS PROGRAM from vgen_programe ] + ; + [where customer_id = ] + Alltrim(Str(crs2xml.id)) +lnsucces = SQLExec(x, lcSql, "crsProgsTemp1") +If lnsucces < 0 + Return +Endif +SQLDisconnect(x) +*!* selectie combobox - un client, programele cu licenta pentru client +executaSql([select 0 as ales, v.customer, v.program, v.versiune, v.versiune_maxima, ]+ ; + [v.id, v.customer_id from vsc_versiune_max_inst_dv v ] + ; + [where v.customer_id = ] + Alltrim(Str(crs2xml.id)), "crsprogstemp2", .T.) +*!* selectie combobox - un client, programele cu licenta pentru client ^ +executasql([select * from programs], "crsPrograms", .t.) +executasql([select * from sc_versiune_programe], "crsVersProg", .t.) + +Select a.nume As customer, a.Program, b.versiune, b.versiune_maxima, a.customer_id, a.id_program ; + From crsprogstemp2 b ; + INNER Join crsProgsTemp1 a On a.customer_id = b.customer_id And b.Id = a.id_program ; + ORDER By 2 ; + INTO Cursor crsXmlOut + +*SELECT c.customer, c.program, c.versiune, c.customer_id FROM crsprogstemp2 c ; + JOIN crsprograms p ON p.id = c.id ORDER BY 2 ; + WHERE !EMPTY(NVL(c.versiune,[])) ; + INTO CURSOR crsProgLic + +lcClipText = lcClipText + Alltrim(customer) + crlf + "VERSIUNI EXISTENTE: " +lcVersiune = "" +Set Textmerge On To Memvar lcVersiune Noshow +Set Textmerge Delimiters To '{{', '}}' + \ + +Select crsXmlOut +*SELECT crsProgLic +Scan For customer_id = lnCustomerId + \<{{Alltrim(PROGRAM)}}> + \ + \{{Alltrim(VERSIUNE)}} + \{{'\_ARHIVE\' + Alltrim(PROGRAM) + '\' + Alltrim(PROGRAM) + '-' + Alltrim(VERSIUNE) + '.EXE'}} + \S-a gasit {{Alltrim(PROGRAM)}} versiunea {{Alltrim(VERSIUNE)}}. Programul va incepe procedurile de actualizare ! + \ + \ + + lcClipText = lcClipText + Alltrim(Program) + '-' + Alltrim(versiune) + ', ' +Endscan +Set Textmerge To +lcfile = Putfile("Alegeti calea",Upper(Alltrim(crs2xml.Name)) + '.xml',"xml") +Strtofile(lcVersiune,lcfile) +If Messagebox("Doriti sa generati XML Aplicatii diferenta",4) = 6 + + Select Distinct c.Program, c.versiune, c.versiune_maxima, c.id_program, c.customer_id , ; + '\_ARHIVE\' + Alltrim(c.Program) + '\' + Alltrim(c.Program) + '-' + ; + Alltrim(c.versiune_maxima) + '.EXE' As fisier ; + FROM crsXmlOut c INNER Join porec p On p.customer_id = c.customer_id ; + WHERE NVL(c.versiune,[]) <> NVL(c.versiune_maxima,[]) ; + INTO Cursor crsVersiuniDiferiteTemp + SELECT program , versiune_maxima as versiune, id_program, customer_id, fisier ; + FROM crsVersiuniDiferiteTemp INTO CURSOR crsVersiuniDiferite + + *!* Cursor cu ultimele Versiuni + + lcFisier = Addbs(Upper(Alltrim(crs2xml.Name))) + lcDir = Addbs(Justpath(lcfile)) + "ACTUALIZARIAPLICATII\" + lcFisier + If Not Directory(lcDir) + Md(lcDir) + Endif + lcFisVersDif = lcDir + "Aplicatii_" + Alltrim(crs2xml.Name) + ".XML" + Cursortoxml("crsVersiunidiferite",lcFisVersDif,1,512,0,"1") + + *!* Cursor cu Versiuni diferite ^ + lcClipText = lcClipText + crlf + 'VERSIUNI DIFERITE: ' + + Select crsVersiuniDiferite + Scan + lcClipText = lcClipText + Alltrim(Program) + '-' + Alltrim(versiune) + ', ' + Endscan + + + *!* versiunea maxima a programelor instalate la client + executaSql([select * from sc_versiune_programe], [crsVmax],.T.) + Select c1.Program, c1.nume, cv.versiune_curenta As versiune From crsProgsTemp1 c1 ; + JOIN crsvmax cv On c1.id_program = cv.id_program ; + WHERE c1.customer_id = crs2xml.id ; &&porec.cust_id + order By 1; + into Cursor crsVersiuniMax + Set Textmerge On To Memvar lcVersiune Noshow + Select crsVersiuniMax + Scan + \<{{Alltrim(PROGRAM)}}> + \ + \{{Alltrim(VERSIUNE)}} + \{{'\_ARHIVE\' + Alltrim(PROGRAM) + '\' + Alltrim(PROGRAM) + '-' + Alltrim(VERSIUNE) + '.EXE'}} + \S-a gasit {{Alltrim(PROGRAM)}} versiunea {{Alltrim(VERSIUNE)}}. Programul va incepe procedurile de actualizare ! + \ + \ + Endscan + + Set Textmerge To + lcfileVersiuniMax = Addbs(Justpath(lcFisVersDif)) + Upper(Alltrim(crs2xml.Name)) + '.xml' + Strtofile(lcVersiune,lcfileVersiuniMax ) + * Cursor cu ultimele Versiuni ^ + + Use In (Select("crsProgLic")) + Use In (Select("crsprograms")) + Use In (Select("crsVersiuniDiferite")) + Use In (Select("crsVersiuniDiferiteTemp")) + Use In (Select("crsProgsTemp1")) + Use In (Select("crsProgsTemp2")) + Use In (Select("crsVmax")) + Use In (Select("crsVersiuniMax")) + Use In (Select("crsxmlout")) + Use In (Select("crsVersProg")) + + _Cliptext = Nvl(lcClipText,[]) + +Endif + +thisform.release() \ No newline at end of file diff --git a/programe/htmlmerge.prg b/programe/htmlmerge.prg new file mode 100644 index 0000000..3199fa4 --- /dev/null +++ b/programe/htmlmerge.prg @@ -0,0 +1,287 @@ +* Program....: HtmlMerge.prg +* Version....: 1.1 +* Author.....: Maurice de Beijer +* Date.......: September 1, 1999 +* Notice.....: Copyright (c) 1999-2000 ABL, All Rights Reserved. +* Compiler...: Visual FoxPro 06.00.8492.00 for Windows +* Abstract...: Merge a HTML template with the current cursor +* Changes....: +* Useage.....: +* +* SELECT *, ; +* '' + eng_name + '' AS Link ; +* FROM (ADDBS(_SAMPLES) + 'Data\Products') ; +* WHERE !Discontinu ; +* ORDER BY Eng_Name ; +* INTO CURSOR cProd NOFILTER +* * Create the HTML merge object +* loHTML = NewObject('HTMLMerge', 'HTMLMerge.prg') +* * Read the first template +* lcText = FILETOSTR('Template_1.htm') +* * Merge it with the cursor of products +* loHTML.ScanMerge(lcText) +* * Save the result as Demo_1.htm +* STRTOFILE(loHTML.cHTML, 'demo_1.htm') +* +* Note.......: +* +* May 17, 2000 +* Add the check for NoScan atributes. +* If a table or list containes a NoScan attribute this will be ignored when determining the table/list to scan. +* This is usefull when you use a table to format a page header and use a second table below this which +* you want to scan. To use it just add a NoScan attribute to any table/list above the table/list you want to +* use in the scan loop. + + +******************************** +DEFINE CLASS HTMLMerge AS Custom +******************************** + +* The final HTML Text +cHTML = '' + + +******************************* +PROCEDURE ScanMerge(tcTemplate) +******************************* +* Look for the first table or list in the template +* The first item is merged with every line in the current cursor +LOCAL lnTable, lnList, lnFirst + +lnTable = THIS.GetScanTagPos(' 0 + * Table found, first do the header + lcText = LEFT(lcTemplate, lnAtPos - 1) + lcTemplate = SUBSTR(lcTemplate, lnAtPos) + THIS.Merge(lcText) + + * Extract the whole table part stopping just + * before the end table marker + lnAtPos = ATCC('', lcTemplate) + lcTable = LEFT(lcTemplate, lnAtPos - 1) + lcTemplate = SUBSTR(lcTemplate, lnAtPos) + + lnAtPos = ATCC(' 0 + * Take care of the starting tag + lcText = LEFT(lcTable, lnAtPos - 1) + lcTable = SUBSTR(lcTable, lnAtPos) + THIS.Merge(lcText) + ENDIF + + DO WHILE ATCC(' 0 + * Extract the headers and merger them + lnAtPos = ATCC('', lcTable) + lcText = LEFT(lcTable, lnAtPos + 5) + lcTable = SUBSTR(lcTable, lnAtPos + 5) + THIS.Merge(lcText) + ENDDO + + SCAN + * Merge the remainig body of the table for each record + THIS.Merge(lcTable) + ENDSCAN +ENDIF + +* Expand the remainder of the template +THIS.Merge(lcTemplate) + +RETURN THIS.cHTML + + +******************************************* +PROCEDURE MergeList(tcTemplate, tnStartPos) +******************************************* +LOCAL lcTemplate, lnAtPos, lcTable, lcText +lcTemplate = tcTemplate +IF VARTYPE(tcStartPos) = 'N' + * Start position laready known + lnAtPos = tnStartPos +ELSE + * Start position not known yet, find it + lnAtPos = THIS.GetScanTagPos(' 0 + * Table found, first do the header + lcText = LEFT(lcTemplate, lnAtPos - 1) + lcTemplate = SUBSTR(lcTemplate, lnAtPos) + THIS.Merge(lcText) + + * Extract the whole table part + lnAtPos = ATCC('', lcTemplate) + IF lnAtPos = 0 + lnAtPos = ATCC('', lcTemplate) + ENDIF + lcTable = LEFT(lcTemplate, lnAtPos - 1) + lcTemplate = SUBSTR(lcTemplate, lnAtPos) + + lnAtPos = ATCC(' 0 + * Take care of the

tag + lcText = LEFT(lcTable, lnAtPos - 1) + lcTable = SUBSTR(lcTable, lnAtPos) + THIS.Merge(lcText) + ENDIF + + SCAN + * Merge the body for each record + THIS.Merge(lcTable) + ENDSCAN +ENDIF + +* Expand the remainder of the template +THIS.Merge(lcTemplate) + +RETURN THIS.cHTML + + +************************* +PROCEDURE Write(tcString) +************************* +* Add a string to the output + +THIS.cHTML = THIS.cHTML + TRANSFORM(tcString) + +RETURN + +************************* +PROCEDURE WriteLine(tcString) +************************* +* Add a string and new line to the output + +* Write the line +THIS.Write(tcString) +* Write the cariage return +THIS.Write(CHR(13)+CHR(10)) + +RETURN + + +***************** +PROCEDURE Clear() +***************** +* Clear all output + +THIS.cHTML = '' + +RETURN + + +*********************** +PROCEDURE Merge(tcText) +*********************** +* Merge a template with the embedded Visual FoxPro expressions +LOCAL lcText, lnAtPos1, lnAtPos2, lcEval, lcValue +lcText = tcText +lcText = STRTRAN(lcText, '<%', '<%') +lcText = STRTRAN(lcText, '%>', '%>') + +* Loop while another expression is found +DO WHILE ATCC('<%=', lcText) > 0 + * Get the start and end position of the next expression + lnAtPos1 = ATCC('<%=', lcText) + lnAtPos2 = ATCC('%>', lcText) + + * Extract the next expression + lcEval = SUBSTR(lcText, lnAtPos1 + 3, lnAtPos2 - lnAtPos1 - 3) + * Remove any cariage returns from the expression as they could be inserted by an HTML editor + lcEval = CHRTRAN(lcEval, CHR(13) + CHR(10), '') + + * Evaluate it + lcValue = TRANSFORM(EVALUATE(lcEval)) + * Stuff the result back instead of the original expression + lcText = STUFFC(lcText, lnAtPos1, lnAtPos2 - lnAtPos1 + 2, lcValue) +ENDDO + +* Add it to the current HTML +THIS.Write(lcText) + +* Return the result +RETURN lcText + + +****************************************** +PROCEDURE GetScanTagPos(tcTag, tcTemplate) +****************************************** +* Find the required scan tag, ignore all tags containing a NoScan attribute +LOCAL lnResult, lnPos, lnAtPos1, lnAtPos2, lcTemp +lnResult = 0 +lnPos = 1 + +DO WHILE .T. + * Find the next position + lnAtPos1 = ATCC(tcTag, tcTemplate, lnPos) + IF lnAtPos1 > 0 + * Found another tag to test, extract the rest of the string + lcTemp = SUBSTR(tcTemplate, lnAtPos1) + * Find the end of the tag + lnAtPos2 = ATCC('>', lcTemp) + * And determine the complete tag + lcTemp = LEFT(lcTemp, lnAtPos2) + + * Check if we are to ignore this tag during the scan operation + IF ATCC('NoScan', lcTemp) = 0 + * No NoScan attribute on this tag, use it + lnResult = lnAtPos1 + EXIT + ELSE + * Try to find a next tag + lnPos = lnPos + 1 + ENDIF + ELSE + * Didn't find the required tag, stop + EXIT + ENDIF +ENDDO + + +RETURN lnResult + +ENDDEFINE diff --git a/programe/ini.prg b/programe/ini.prg new file mode 100644 index 0000000..c712cc1 --- /dev/null +++ b/programe/ini.prg @@ -0,0 +1,29 @@ +* WriteINI - Writes an item to an INI file, pretty straight forward * + +PROCEDURE WriteINI &&(cINIFile AS String, cTopic AS String, cItem AS String, cValue AS STRING) + LPARAMETERS cINIFile, cTopic, cItem, cValue + DECLARE INTEGER WritePrivateProfileString IN Win32API ; + STRING cTopic, ; + STRING cItem, ; + STRING cValue, ; + STRING cINIFile + WritePrivateProfileString(m.cTopic, m.cItem, m.cValue, m.cINIFile) +ENDPROC + +* ReadINI - Reads values from an INI file, pretty straight forward * + +FUNCTION ReadINI &&(cINIFile As String, cTopic AS String, cItem AS String) AS STRING + LPARAMETERS cINIFile, cTopic, cItem + DECLARE INTEGER GetPrivateProfileString IN Win32API ; + STRING cTopic, ; + STRING cItem, ; + STRING cDefault, ; + STRING cValueBuf, ; + INTEGER nValueBufSize, ; + STRING cINIFile + + PRIVATE cValue, nBuf + m.cValue = REPLICATE(CHR(0), 255) + m.nBuf = GetPrivateProfileString(m.cTopic, m.cItem, '', @cValue, 255, m.cINIFile) + RETURN LEFT(m.cValue, m.nBuf) +ENDFUNC diff --git a/programe/log_mesaje.prg b/programe/log_mesaje.prg new file mode 100644 index 0000000..7bdd7bc --- /dev/null +++ b/programe/log_mesaje.prg @@ -0,0 +1,84 @@ +Define Class log_mesaje As Relation + + cLogFile = "c:\log.txt" + lLogging = .F. + + && ------------------------------INCEPUT: Init ------------------------------ + *!* Procedura: Init + *!* Parametri: + *!* Data/Ora generarii: 20/02/2004 12:41:53 + *!* Autor: MARIUS.MUTU + Procedure Init + Lparameters tcLogFile, tlAdditive + + Local lLog, llAdditive, cLogFile + lLog = Iif(File(Addbs(Justpath(Sys(16, 0))) + "LOG.txt"), .T., .F.) && daca exista fisierul log + This.lLogging = lLog Or This.lLogging && creez log daca exista in directorul aplicatiei fisierul sau daca proprietatea lLogging = .T. + + If !This.lLogging + Return + Endif + + Set Console Off + Set Talk Off + + cLogFile = Iif(Empty(tcLogFile), Addbs(Justpath(Sys(16, 0))) + "LOG.txt", m.tcLogFile) + This.cLogFile = cLogFile + + If Parameters() < 2 + llAdditive = Iif(File(cLogFile), .T., .F.) + Else + llAdditive = tlAdditive + Endif + + If llAdditive + Set Textmerge On To (cLogFile) Additive + Else + Set Textmerge On To (cLogFile) + Endif + + + \<> <> <> + + Set Textmerge To + + + + Endproc + && ------------------------------SFARSIT: Init ------------------------------ + + && ------------------------------INCEPUT: Log ------------------------------ + *!* Procedura: Log + *!* Parametri: tcText + *!* Data/Ora generarii: 20/02/2004 12:48:57 + *!* Autor: MARIUS.MUTU + Procedure Log + Lparameters tcText, tcProgram + + If !This.lLogging + Return + Endif + + Local lcText, lcLogFile + + Set Console Off + Set Talk Off + + lcText = Iif(Empty(tcText), "", Alltrim(tcText)) + lcProgram = Iif(Empty(tcProgram), "", Alltrim(tcProgram)) + lcSpatiu = Space(10) + + lcLogFile = This.cLogFile + lcAddText = Ttoc(Datetime()) + " " + Sys(0) + Iif(Type('GCS') = 'C', " " + GCS, "") + Chr(13) + Chr(10) + ; + Iif(!Empty(lcProgram), lcSpatiu + lcProgram, "") + Iif(!Empty(lcText), lcSpatiu + lcText, "") + + Set Textmerge On To (lcLogFile) Additive + +\ <> + + Set Textmerge To + + Endproc + && ------------------------------SFARSIT: Log ------------------------------ + +Enddefine && log_mesaje \ No newline at end of file diff --git a/programe/main.prg b/programe/main.prg new file mode 100644 index 0000000..d9b88e3 --- /dev/null +++ b/programe/main.prg @@ -0,0 +1,545 @@ +Lparameters tcSilent, tcCommand +* tcSilent (optional): s (silentios) pentru rularea unei comenzi fara afisarea formularului +* tcCommand (optional): xml_roa_auto pentru generarea automata a xml-urilor ROA cu programe + +*!* 25.01.2011 +*!* marius.mutu +*!* settings.ini - hostserii, usernameserii, passwordserii +Local lcHost, lcHostSerii, lcPassword, lcPasswordSerii, lcText, lcUserName, lcUserNameSerii +Local lnSucces +Store "" To lcHost, lcHostSerii, lcPassword, lcPasswordSerii, lcText, lcUserName, lcUserNameSerii +lnSucces = 0 + +LOCAL llSilent, lcCommand +llSilent = IIF(PCOUNT() > 0, LOWER(tcSilent) = 's', .F.) +lcCommand = IIF(PCOUNT() > 1, LOWER(m.tcCommand), '') && xml_roa_auto + +*:Global gcProgrameChangeLogsFile +*!* IF TooManyInstances(1) &&Too many instance already running? +*!* QUIT +*!* ENDIF + +Set Talk Off +Set Deleted On +Set Century On +Set Date Dmy SHORT +Set Safety Off +Set Console Off +Set Seconds Off +Set Exclusive Off +Set Status Off +Set Status Bar Off +Set Hours To 24 +Set Exact On +Set Ansi On +_Screen.Caption = 'TASKS' +_Screen.WindowState= 2 +Set NullDisplay To "" +*!* ================================================================= +Public gnIdProgram, gnIdUtilizator, ; + gnIdClient, gbSpecial, gdData, gcAppName, gcAppPath, gcDataPath, gcTempPath, gnhandle, gcIcon +Local lcPath, liat + +gnhandle = -1 +gnIdUtilizator = 0 +gnIdProgram = 0 +gnIdClient = 0 +gbSpecial = .F. +gdData = Date() +gcAppPath = Addbs(Justpath(Sys(16,0))) +gcAppPath = Strtran(Upper(gcAppPath),"PROGRAME\","") +gcAppName = Juststem(Sys(16,0)) +Set Default To (gcAppPath) + +gcDataPath = Addbs(gcAppPath) + [clase\test.vcx] +Set Classlib To (gcDataPath) + +gcTempPath = Addbs(Sys(2023)) + +On Shutdown Shutdown() +On Error ErrorHandler(Error(),Program(),Lineno()) +Push Menu _Msysmenu + +*!* PROGRAME_CHANGELOGS +gcProgrameChangeLogsFile = gcAppPath + 'programe_changelogs.xml' +If !File(gcProgrameChangeLogsFile) + Create Cursor programe_changelogs (id_program i, Program v(100), changelog v(200)) +Else + Xmltocursor(gcProgrameChangeLogsFile,"programe_changelogs",512) +Endif +*!* PROGRAME_CHANGELOGS ^ + +Set Default To (gcAppPath) && generare script +lcPath = gcAppPath + ";" + ; + gcAppPath + "ferestre;" + ; + gcAppPath + "ferestre;" + ; + gcAppPath + "clase;" + ; + gcAppPath + "programe;" + ; + gcAppPath + "meniuri;" + ; + gcAppPath + "rapoarte;" + ; + gcAppPath + "grafice;" + ; + gcAppPath + "clase\GridExtras;" + +Set Path To (lcPath) Additive + +Set Procedure To proceduri.prg Additive && tasks, soft clienti +Set Procedure To proceduri_sql.prg Additive +Set Procedure To utile.prg Additive +Set Procedure To rapoarte.prg Additive +Set Procedure To htmlmerge.prg Additive + +Set Classlib To appwiz Additive && generare script +Set Classlib To comun Additive +Set Classlib To Start Additive +Set Classlib To execute_script Additive +Set Classlib To systray Additive + +Set Classlib To generare_script Additive +Set Classlib To gridextras Additive + +Set Procedure To oproceduri_comune.prg Additive +Set Procedure To ini.prg Additive + +Set Procedure To "rbInputBox.prg" Additive +Set Procedure To regex.prg Additive + +Set Library To gcAppPath + 'biblioteci\vfpcompression.fll' && v 1.0.39 +*!* 30.08.2010 +Private gcReportPreviewer, gcReportPreviewerPath +gcReportPreviewer = "FoxyPreview" && rapoarte.prg +gcReportPreviewerPath = gcAppPath + 'utile\' +*!* 30.08.2010 ^ + +Private lcIniFile +Local lcidutilizator + +gcIcon = [news1.ico] +If File(Addbs(gcAppPath) + [grafice\] + gcIcon) + Private goSystray + goSystray = Createobject("osystray") + *!* Bindevent(_Screen,[Resize],goSystray,[minimizeaza],1) + Bindevent(_Screen,[rightclick],goSystray,[clickdreapta],1) + +Else + Messagebox([Nu s-a gasit icoana cu adresa:] + Chr(13) + Chr(10) +; + ADDBS(gcAppPath) + [grafice\] + gcIcon,0 + 48) +Endif + +lcIniFile = gcAppPath + 'settings.ini' + +*goExecutor = Createobject("oExecutor") +*Do (gcAppPath + "meniu.mpr") +If !File(lcIniFile) + Set Textmerge On To Memvar lcTextIni + \[connection] + \host=ROA_ROMFAST + \username=SOFT + \password=SOFT + \host_serii=ROA_CENTRAL + \username_serii=SOFT_SERII + \password_serii=123 + \host_database=ROA_CENTRAL + \username_database=CONTAFIN_ORACLE + \password_database=ROMFASTSOFT + \idutilizator= + Set Textmerge To + Strtofile(lcTextIni, lcIniFile) +Endif + + + +lcHost = ReadINI(lcIniFile, "connection", "host") +lcUserName = ReadINI(lcIniFile, "connection", "username") +lcPassword = ReadINI(lcIniFile, "connection", "password") +lcidutilizator = ReadINI(lcIniFile, "connection", "idutilizator") + +*!* 25.01.2011 +lcHostSerii = ReadINI(lcIniFile, "connection", "host_serii") +lcUserNameSerii = ReadINI(lcIniFile, "connection", "username_serii") +lcPasswordSerii = ReadINI(lcIniFile, "connection", "password_serii") +*!* 25.01.2011 ^ + +*!* 27.05.2013 +lcHostDatabase = ReadINI(lcIniFile, "connection", "host_database") +lcUserNameDatabase = ReadINI(lcIniFile, "connection", "username_database") +lcPasswordDatabase = ReadINI(lcIniFile, "connection", "password_database") +*!* 27.05.2013 ^ + +If Empty(lcHost) Or Empty(lcUserName) Or Empty(lcPassword) Or ; + EMPTY(lcHostSerii) Or Empty(lcUserNameSerii) Or Empty(lcPasswordSerii) Or ; + EMPTY(lcHostDatabase) Or Empty(lcHostDatabase) Or Empty(lcHostDatabase) + Messagebox('Completati detaliile de login pentru SOFT@ROA_ROMFAST, SOFT_SERII@ROA_CENTRAL, CONTAFIN_ORACLE@ROA_CENTRAL' + lcIniFile, 0+48, _Screen.Caption) +Else + + + + Private poLog,goLog && obiect pt logarea mesajelor sistemului + goLog = Newobject("Log_Mesaje","Log_Mesaje.prg") + + Private goExecutor, goConn + goExecutor = Createobject("oExecutor") + goConn = Createobject("oConn") + + Local lcMenu + lcMenu = "meniu.mpr" + + Release goApp + Public goApp + goApp = Createobject("cApplication") + goApp.AddProperty("cIniFile", lcIniFile) + goApp.AddProperty("cHost", lcHost) + goApp.AddProperty("cUserName", lcUserName) + goApp.AddProperty("cPassword", lcPassword) + goApp.AddProperty("cIdUtilizator", Alltrim(lcidutilizator)) + goApp.AddProperty("IdUtilizator", Val(Alltrim(lcidutilizator))) + goApp.AddProperty("cUtilizator", '') + + goApp.AddProperty("cHostSerii", lcHostSerii) + goApp.AddProperty("cUserNameSerii", lcUserNameSerii) + goApp.AddProperty("cPasswordSerii", lcPasswordSerii) + + + goApp.AddProperty("cHostDatabase", lcHostDatabase) + goApp.AddProperty("cUserNameDatabase", lcUserNameDatabase) + goApp.AddProperty("cPasswordDatabase", lcPasswordDatabase) + + + goApp.AddProperty("cMenu",lcMenu) + goApp.AddProperty("nhandle", 0) + + *!* completez inifile cu prefixele scripturilor pe scheme + lcText = Filetostr(goApp.cIniFile) + + If Atc("[script]",lcText) = 0 + lcText = '' + TEXT TO m.lcText NOSHOW + +[script] +CONTAFIN_ORACLE=CO_ +SCHEMAROA=FF_ +SOFT_SERII=RF_ +SYS=SYS_ +CONTABILITATE=JCS_ + + ENDTEXT + Strtofile(Chr(13) + Chr(10) + m.lcText,goApp.cIniFile,1) + Endif + + Create Cursor dual (Info c(10)) + Insert Into dual (Info) Values ("dummy") + + Set Step On + *!* completez inifile cu prefixele scripturilor pe scheme ^ + *!* conectare + conectare(lcHost, lcUserName, lcPassword, lcidutilizator) + *!* conectare ^ + + If gnhandle > 0 + Local llReturn + llReturn = .F. + + lnSucces = goExecutor.oexecute([select users.login, users.id from users ] + ; + [inner join roles_users on user_id=users.id inner join roles on role_id=roles.id ] + ; + [where roles.id=2 order by 1],"crsUtilizatori") + + + goLog.Log('silent: ' + TRANSFORM(m.llSilent) + ' command: ' + m.lcCommand, PROGRAM()) + IF m.llSilent AND !EMPTY(m.lcCommand) + IF m.lcCommand = "xml_roa_auto" + goLog.Log('genereaza_xml_roa_tot', PROGRAM()) + DO genereaza_xml_roa_tot IN proceduri.prg + ENDIF + ELSE + Do Form ("frm_connect.scx") To llReturn + If llReturn + WriteINI(goApp.cIniFile, "connection", "idutilizator", Alltrim(Transform(goApp.idutilizator))) + goApp.cUtilizator = Alltrim(crsUtilizatori.login) + + Private goConfig + goConfig = Createobject("Config") + + Do (lcMenu) + *goApp.cStartupMenu = gcAppPath + "meniu.mpx" + + *!* 29.08.2011 + *** TEST MENUHIT + If File(gcAppPath + "FOXCODE.DBF") + * _FOXCODE = gcAppPath + "foxcode.dbf" + Endif + *!* 29.08.2011 ^ + editLucrare() + Read Events + + On Error + On Shutdown + Do deconectare + + cleanup() + + Endif && llReturn + ENDIF && m.llSilent + Endif && gnHandle +Endif +cleanup() + + +*!* ================================================================= +*!* ================================================================= +Function ErrorHandler(nError, cMethod, nLine) + Local lcErrorMsg,lcCodeLineMsg + + Wait Clear + lcErrorMsg = Message() + Chr(13) + Chr(13) + lcErrorMsg = lcErrorMsg + "Method: " + cMethod + lcCodeLineMsg = Message(1) + If Between(nLine, 1, 10000) And Not lcCodeLineMsg = "..." + lcErrorMsg = lcErrorMsg + Chr(13) + "Line:" + Space(5) + Alltrim(Str(nLine)) + If Not Empty(lcCodeLineMsg) + lcErrorMsg = lcErrorMsg + Chr(13) + Chr(13) + lcCodeLineMsg + Endif + Endif + If Messagebox(lcErrorMsg, 17, _Screen.Caption) # 1 + On Error + On Shutdown + Quit + Endif +Endfunc + + +**============================================= +Function Shutdown + *!* If Type("goAppTask")=="O" And Not Isnull(goApp) + *!* Return goAppTask.OnShutDown() + *!* Endif + Do salveazaSetari + If Type('goApp') = 'O' + Return goApp.onShutDown() + Endif + + Do deconectare + *!* cleanup() + + + *!* If _vfp.StartMode !=0 + *!* Quit + *!* Endif +Endfunc +**============================================= + +Function cleanup + + *!* If Cntbar("_msysmenu") = 7 + *!* Return + *!* ENDIF + + On Error + On Shutdown + Set Classlib To + Set Path To + Clear All + *Close All + _Screen.MaxButton=.T. + _Screen.BorderStyle= 3 + _Screen.WindowState= 2 + + Pop Menu _Msysmenu + Clear Events + + Return +Endfunc + +***************************** inceput conectare +Procedure conectare + Lparameters tcHost, tcUserName, tcPassword, tcIdUtilizator + + Local lnHandle, lcHost, lcUserName, lcPassword, lcCaption, lcidutilizator + + If Pcount() = 3 + goApp.cHost = tcHost + goApp.cUserName = tcUserName + goApp.cPassword = tcPassword + * goapp.cidutilizator = goapptask.idutilizator + goApp.cidutilizator = tcIdUtilizator + Endif + + lcHost = Upper(tcHost) + lcUserName = Upper(tcUserName) + lcPassword = tcPassword + lcidutilizator = tcIdUtilizator + + If Type('goApp') = 'O' And goApp.nhandle > 0 + Do deconectare + Endif + + lnHandle = goConn.Connect(lcHost, lcUserName, lcPassword, lcidutilizator) + + goApp.nhandle = lnHandle + *!* goExecutor.nhandle = lnHandle + + If lnHandle > 0 + lcCaption = "Conectat " + lcHost + " " + lcUserName + Else + lcCaption = "Neconectat" + Endif + If Type('goApp') = 'O' + goApp.SetCaption(lcCaption) + Endif + + Return lnHandle + +Endproc && conectare +**************************************** + +Procedure deconectare + Local lcCaption, lnSucces + + lnSucces = goConn.Disconnect() + goApp.nhandle = -1 + goExecutor.nhandle = -1 + lcCaption = "Neconectat" + goApp.SetCaption(lcCaption) + +Endproc && deconectare + +************************* inceput salveazaSetari ******************** +Procedure salveazaSetari + Try + If Used('settings') + Replace settings.idutilizator With goApp.idutilizator In settings + Cursortoxml("SETTINGS",gcSettingsFile,1,512,0,"1") + Endif + If Used('programe_changelogs') + Cursortoxml("programe_changelogs", gcProgrameChangeLogsFile,1,512,0,"1") + Endif + Catch + Endtry +Endproc + +**====================================== +** actualizeaza programe_changelogs cu calea catre fisierul ; +changelog pentru un id_program +Procedure UpdateProgrameChangeLogs + Lparameters tnIdProgram, tcProgram, tcChangeLog + + Local lcSelect + lcSelect = Select() + + If Used('programe_changelogs') And !Empty(tcChangeLog) + Select programe_changelogs + Locate For id_program = tnIdProgram + If Found() + Replace changelog With Alltrim(tcChangeLog) + Else + Insert Into programe_changelogs(id_program, Program, changelog) Values (tnIdProgram, Alltrim(tcProgram), Alltrim(tcChangeLog)) + Endif + Endif + Select (lcSelect) +Endproc && UpdateProgrameChangeLogs ^ + +**====================================== +** intoarce calea catre fisierul changelog in functie de id_program +Function GetChangeLogByIdProgram + Lparameters tnIdProgram + Local lcSelect, lcChangelog + lcSelect = Select() + lcChangelog = "" + + If Used('programe_changelogs') + Select programe_changelogs + Locate For id_program = tnIdProgram + If Found() + lcChangelog = Alltrim(changelog) + Endif + Endif + + Select (lcSelect) + Return lcChangelog +Endfunc +**====================================== + +********************** inceput TooManyInstances ************************* +Function TooManyInstances(lnInstancesAllowed) + *************************** + #Define GW_CHILD 5 && 0x00000005 + #Define GW_HWNDNEXT 2 && 0x00000002 + #Define SW_MAXIMIZE 3 && 0x00000003 + #Define SW_NORMAL 1 && 0x00000001 + #Define WAIT_OBJECT_0 0 && 0x00000000 + #Define RF_MESAJ 0xA123 + + Local lcUniqueProperty, lcUniqueSemaphore, lnhSemaphore, lnHwnd, llReturn + If Pcount() = 0 + lnInstancesAllowed = 1 && default + Else + lnInstancesAllowed = Max(lnInstancesAllowed,1) &&At least one + Endif + Do DeclareAPIs + lcUniqueSemaphore = Strtran(Justpath(Sys(16,0)),"\","") + *!* lcUniqueSemaphore = "968360BF-C7AD-4B62-A045-0A06D597EF18" + lcUniqueProperty = "E2429959-D873-4733-8182-7A3F14780A27" + &&& + *!* oTypeLib = CreateObject("scriptlet.typelib") + *!* lcUniqueSemaphore = substr(oTypeLib.GUID, 2, 36) + *!* oTypeLib1 = CreateObject("scriptlet.typelib") + *!* lcUniqueProperty = substr(oTypeLib1.GUID, 2, 36) + &&& + lnhSemaphore = CreateSemaphore(0,lnInstancesAllowed,lnInstancesAllowed,lcUniqueSemaphore) + If lnhSemaphore != 0 And WaitForSingleObject(lnhSemaphore, 0) != WAIT_OBJECT_0 + Do DeclareMoreAPIs + llReturn = .T. + lnHwnd = GetWindow(GetDesktopWindow(), GW_CHILD) + Do While lnHwnd != 0 && loop through all windows + If GetProp(lnHwnd, lcUniqueProperty) = 1 && does window have our unique property? + BringWindowToTop(lnHwnd) + *!* modificare v 2.0.23 + If IsIconic(lnHwnd) <> 0 + SendMessage(lnHwnd, RF_MESAJ, 0, 0) + Else + *!* modificare v 2.0.23 ^ + ShowWindow(lnHwnd,SW_NORMAL) + *!* modificare v 2.0.23 + Endif + *!* modificare v 2.0.23 ^ + llReturn = .T. + Exit + Endif + lnHwnd = GetWindow(lnHwnd, GW_HWNDNEXT) + Enddo + CloseHandle(lnHwnd) + CloseHandle(lnhSemaphore) + Clear Dlls "BringWindowToTop", "GetDesktopWindow", ; + "GetProp", "GetWindow", "ShowWindow", ; + "CloseHandle", "SendMessage", "IsIconic" + Else + =SetProp(_vfp.HWnd, lcUniqueProperty, 1) + _Screen.AddProperty("SemaphoreHandle",lnhSemaphore) + llReturn = .F. + Endif + Clear Dlls "CreateSemaphore", "GetLastError", ; + "SetProp" + Return (llReturn) +Endfunc &&&&&&&&&&&&&&&&&&&&&& TooManyInstances ^^ &&&&&&&&&&&&&&&&&&&&&&&&&& +************************************************************************************************************************* +*************************** +Procedure DeclareAPIs() + *************************** + Declare Integer CloseHandle In Kernel32 Integer hObject + Declare Integer CreateSemaphore In Kernel32 Integer lpSemaphoreAttributes, Integer lInitialCount, Integer lMaximumCount, String lpName + Declare Integer SetProp In User32 Integer HWnd, String lpString, Integer hData + Declare Integer WaitForSingleObject In kernel32 Integer hHandle, Integer dwMilliseconds +Endproc +************************************************************************************************************************* +*************************** +Procedure DeclareMoreAPIs() + *************************** + Declare Integer BringWindowToTop In Win32API Integer HWnd + Declare Integer GetDesktopWindow In User32 + Declare Integer GetProp In User32 Integer HWnd, String lpString + Declare Integer GetWindow In User32 Integer HWnd, Integer uCmd + Declare Integer ShowWindow In Win32API Integer HWnd, Integer nCmdShow + *!* modificare v 2.0.23 + Declare Integer SendMessage In user32 Integer HWnd,Integer Msg,Integer wParam, Integer Lparam + Declare Integer IsIconic In user32 Integer HWnd + *!* modificare v 2.0.23 ^ +Endproc + diff --git a/programe/oproceduri_comune.prg b/programe/oproceduri_comune.prg new file mode 100644 index 0000000..7ab6fbc --- /dev/null +++ b/programe/oproceduri_comune.prg @@ -0,0 +1,1367 @@ +Define Class oexecutor As Custom + nHandle = 0 + cSql = '' + cCursor = '' + nSucces = 0 + cEroare = '' + cTime = '' + lReconnect = .T. && cred ca trebuie setat pe .F. inainte de o serie de proceduri executate cu tranzactie manuala + lShowError = .F. + lQuitOnError = .F. + + cEroare = [] && de la tasks + + Declare aEroare[1] + + + * PROCEDURE INIT( tnHandle, tcSql, tcCursor ) + * Date : 06/10/2004, 12:18:21 + * author : marius.mutu + * description: + + ****** PARAMETER BLOCK ************** + * Parameters : 3 + * Parameter 1: + * Parameter 2: + * Parameter 3: + * + ******************************************* INCEPUT:INIT ******************************************* + Procedure Init + Lparameters tnHandle, tcSql, tcCursor + + + If Empty(tnHandle) + This.nHandle = gnHandle + Else + This.nHandle = tnHandle + Endif + + Endproc + ******************************************* SFARSIT: INIT ******************************************* + + + * PROCEDURE oExecute( tcSql, tcCursor,tlProgress, tnHandle ) + * Date : 06/10/2004, 12:16:11 + * author : marius.mutu + * description: + + ****** PARAMETER BLOCK ************** + * Parameters : 3 + * Parameter 1: + * Parameter 2: + * Parameter 3: + * + ******************************************* INCEPUT:oExecute ******************************************* + Procedure oExecute( tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect ) + Local lnHandle, lcSql, lcCursor, llProgress, lnSucces, laEroare, lcEroare, llShowError, llQuitOnError, llReconnect + + + && tlQuitOnError : Daca face QUIT la eroare (daca vreau QUIT dau .T.) (default .F.) + && tlShowError : Daca arata mesajul de eroare (daca vreau sa il tratez in oexecute dau .T.) (default .F.) + && tlReconnect : Daca incearca sa se reconecteze (default .T.) + If .F. + Local This As oexecutor + Endif + This.Oreset() + + If Type('goLog')='O' + goLog.Log(tcSql,Program()) + Endif + + Local lnTip + lnTip = 0 + + If Empty(tcSql) + lcSql = Upper(This.cSql) + Else + lcSql = Upper(tcSql) + Endif + + If Empty(tcCursor) + lcCursor = This.cCursor + Else + lcCursor = tcCursor + Endif + + If Empty(tnHandle) + lnHandle = This.nHandle + Else + lnHandle = tnHandle + Endif + + && DACA AM TRANZACTIE MANUALA NU FAC RECONNECT + If SQLGetprop(lnHandle,"Transactions") = 2 && TRANZACTIE MANUALA + This.lReconnect = .F. + Else + This.lReconnect = .T. + Endif + + Do Case + Case Pcount() < 6 + llQuitOnError = This.lQuitOnError + llReconnect = This.lReconnect + llShowError = This.lShowError + Case Pcount() < 7 + llQuitOnError = This.lQuitOnError + llReconnect = This.lReconnect + Otherwise + llShowError = tlShowError + llReconnect = tlReconnect + llQuitOnError = tlQuitOnError + Endcase + + lnSucces = This.nSucces + + llProgress = tlProgress && IIF(tlProgress or 'SELECT'$lcSql,.T.,.F.) + lcTitluProgress = Iif(Empty(tcTitluProgress),"",Alltrim(tcTitluProgress)) + + Declare laEroare[1] + lcEroare = '' + + + lnTip = Iif('ROLLBACK'$lcSql Or 'COMMIT'$lcSql,1,0) && daca ROLLBACK SAU COMMIT TIP = 1, ALTFEL 0 + + Do Case + Case lnTip = 0 + + If llProgress + Local loTherm, lcTask, lnPercent, lnSeconds + If !Empty(lcTitluProgress) + lcTask = lcTitluProgress + Else + lcTask = "Se executa ... " + Endif + loTherm = Newobject("_thermometer","_therm","",lcTask) + + lnPercent = 15 + + + loTherm.Show() + Endif + + lnSucces = -1 + Do While .T. + Do While .T. + + If llProgress + lnPercent = lnPercent + 5 + If lnPercent > 90 + lnPercent = 15 + Endif + + loTherm.Update(lnPercent, lcTask+" "+Trans(lnPercent)) + Endif + + + lnSucces = SQLExec(lnHandle,lcSql,lcCursor) + If lnSucces = 0 + * + Else + Exit + Endif + Enddo + + If lnSucces > 0 + If Used(lcCursor) + lcTempCursor = Sys(2015) + Use Dbf(lcCursor) In 0 Again Shared Alias (lcTempCursor) + Use In (lcCursor) + Use Dbf(lcTempCursor) In 0 Again Alias (lcCursor) + Use In (lcTempCursor) + Endif + Exit + Endif + + If lnSucces < 0 + Release laEroare + Declare laEroare(1) + lnEroare1 = 0 + lnEroare2 = 0 + lcTextEroare = [] + lnHandle = 0 + llEroare = .F. + + Aerror(laEroare) + If Alen(laEroare) > 1 + lnEroare1 = laEroare[1] + lnEroare2 = laEroare[5] + lcTextEroare = laEroare[3] + lnHandle = laEroare[6] + llEroare = .T. + Endif + Do Case + Case lnEroare1 <>1526 && eroare <> ODBC + lcTextEroare = Program() + Chr(13) + Alltrim(Str(lnEroare1)) + ' ' + laEroare[2] + If Type('goLog')='O' + goLog.Log(lcTextEroare,Program()) + Endif + If llShowError + Messagebox(lcTextEroare,0,"Eroare") + Endif + If llQuitOnError + Quit + Retry + Else + Exit + Endif + + Case lnEroare1 = 1526 && eroare ODBC + Do Case + Case llReconnect And Inlist(lnEroare2,12152,3114,12560) && 12512 = TNS: UNABLE TO SEND BREAK MESSAGE; 3114 = NOT CONNECTED TO ORACLE; 12560 = PROTOCOL ADAPTER ERROR + If Type('goLog')='O' + lcLog = laEroare(3) + Chr(13) + goLog.Log(lcLog,Program()) + Endif + + Do While .T. + lnRaspuns = Messagebox('Eroare de conectare.' + Chr(13) + lcTextEroare + Chr(13) + 'Doriti reconectare?',4+32,'Eroare') && retry = 4; cancel = 2 + If lnRaspuns = 6 + + lnHandle = goConn.Connect(goConn.cHost, goConn.cUser, goConn.cPassword, llReconnect) + + *!* gnHandle = SQLConnect(gcHost,gcUserName,gcPassword) + + If lnHandle < 0 + Declare laEroare2(1) + Aerror(laEroare2) + lcTextEroare = laEroare2(3) + If Type('goLog')='O' + goLog.Log(lcTextEroare,Program()) + Endif + + Release laEroare2 + Loop + Else + *!* goExecutor.nHandle = gnHandle + Exit + Endif + Else + Quit + Retry + Endif && lnRaspuns = 6 + Enddo && .T. + Loop && daca am iesit cu un handle valid intru din nou in loop si fac cursorfill + Otherwise + lcTextEroare = Program() + Chr(13) + Alltrim(Str(lnEroare1)) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3]) + Chr(13) + lcSql + If llShowError + lnRaspuns = Messagebox('Eroare necunoscuta' + Chr(13) + lcTextEroare,0,'Eroare') && ok = 0 + Endif + If Type('goLog')='O' + goLog.Log(lcTextEroare,Program()) + Endif + If llQuitOnError + Quit + Retry + Else + Exit + Endif + Endcase && INLIST(lnEroare2,12152,3114) + Endcase + Endif && lnSucces < 0 + + Enddo && .T. + + If llProgress + loTherm.Complete() + Release loTherm + Endif + + Case lnTip = 1 + If 'ROLLBACK'$lcSql + lnSucces = Sqlrollback(lnHandle) + Else + lnSucces = Sqlcommit(lnHandle) + Endif + Endcase + + If lnSucces < 0 + Aerror(laEroare) + + If laEroare[1] <> 1526 + lcEroare = laEroare[2] + Else + lcEroare = Alltrim(Str(lnEroare1)) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3]) + Chr(13) + lcSql + Endif + + If llShowError + Messagebox(lcEroare,0,"Eroare") + Endif + If llQuitOnError + Quit + Retry + Endif + + Endif + + + + This.aEroare = laEroare + This.nSucces = lnSucces + This.cEroare = lcEroare + + Return lnSucces + + Endproc + ******************************************* SFARSIT: oExecute ******************************************* + + + + * PROCEDURE oReset( ) + * Date : 06/10/2004, 12:21:06 + * author : marius.mutu + * description: + + ****** PARAMETER BLOCK ************** + * Parameters : 0 + * + ******************************************* INCEPUT:oReset ******************************************* + Procedure Oreset( ) + With This + .aEroare = .F. + .nSucces = 0 + .cSql = '' + .cCursor = '' + Endwith + Endproc + ******************************************* SFARSIT: oReset ******************************************* +Enddefine && oExecutor + + + + +*** oConn =========================================================================================== +Define Class oConn As Custom + + cHost = '' + cUser = '' + cPassword = '' + cIdUtilizator = '' + nHandle = 0 + cEroare = '' + Declare aEroare[7] + lShowError = .F. + lReconnect = .F. && Daca llReconnect = .T. se apeleaza InitSesiune din oInit_Optiuni.prg + + + *** Connect =========================================================================================== + Procedure Connect + Lparameters tcHost, tcUser, tcPassword, tcIdUtilizator, tlReconnect + + *!* tlReconnect = .T. daca se apeleaza connect la reconectare (atunci se apeleaza si InitSesiune()) + Local lnSucces, laEroare, lcString, lcHost, lcUser, lcPassword, lcSql + + If Pcount() < 4 Or Type('tcHost') # 'C' Or Type('tcUser') # 'C' ; + OR Type('tcPassword') # 'C' Or Type('tcIdUtilizator') # 'C' + * + Else + This.cHost = tcHost + This.cUser = tcUser + This.cPassword = tcPassword + This.cIdUtilizator = tcIdUtilizator + Endif + + lcHost = This.cHost + lcUser = This.cUser + lcPassword = This.cPassword + + If Pcount() < 5 Or Type('tlReconnect') # 'L' + llReconnect = This.lReconnect + Else + llReconnect = tlReconnect + Endif + + SQLSetprop(0,"DispLogin",3) + lcString = "dsn=" + Alltrim(lcHost) + ";Uid=" + Alltrim(lcUser) + ";Pwd=" + Alltrim(lcPassword) + ";" + + This.nHandle = Sqlstringconnect(lcString) + + If Type('gnHandle') = 'N' + gnHandle = This.nHandle + Endif + + If Type('goExecutor') = 'O' + goExecutor.nHandle = This.nHandle + Endif + + If This.nHandle > 0 + lnSucces = 1 + + *** SETARI SESIUNE DUPA CONECTARE + This.postConn() + + If llReconnect + lnSucces = InitSesiune() && IN oInit_Optiuni.prg + Endif + Else + lnSucces = -1 + This.ProcessError() + Endif + + Return This.nHandle + + Endproc && Connect + *** END Connect =========================================================================================== + + *** Disconnect =========================================================================================== + Procedure Disconnect + Lparameters tnHandle + + Local lnSucces, lnHandle + + lnHandle = Iif(Empty(tnHandle) Or Type('tnHandle') # 'N', 0 , tnHandle) + + lnSucces = SQLDisconnect(lnHandle) + + If lnSucces < 0 + This.ProcessError() + Endif + + Return lnSucces + + Endproc && + *** END Disconnect =========================================================================================== + + *** ProcessError =========================================================================================== + Procedure ProcessError + + Local laEroare, lnEroare1, lnEroare2, lcTextEroare, lcEroareConectare + lcTextEroare = '' + lcEroareConectare = '' + Dimension laEroare[1] + + Aerror(laEroare) + If Alen(laEroare) > 1 + lnEroare1 = laEroare[1] + lnEroare2 = laEroare[5] + lcTextEroare = laEroare[3] + lnHandle = laEroare[6] + llEroare = .T. + + lcTextEroare = 'Conectarea nu a reusit ' + Chr(13) + Chr(10) + Alltrim(Transform(laEroare[1])) + ; + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3]) + This.cEroare = lcTextEroare + This.aEroare = laEroare + + goLog.Log(lcTextEroare,Program()) + + If laEroare[1] = 1526 And Like('*ORA-20???:*',laEroare[2]) + lnPozi = At("ORA-20",laEroare[2])+11 + lnPozf = At("ORA",laEroare[2],3) + lcEroareConectare = Substr(laEroare[2],lnPozi,lnPozf-lnPozi) + Else + lcEroareConectare = lcTextEroare + Endif + If Empty(lcEroareConectare) + lcEroareConectare = "Conectarea nu a reusit!" + Endif + + Messagebox(lcEroareConectare, 0 + 48,"Atentie") + Endif + + Return lcTextEroare + + Endproc && ProcessError + *** END ProcessError =========================================================================================== + + *** postConn =========================================================================================== + Procedure postConn + *** PUNCT ZECIMAL + lcSql=[ALTER SESSION SET NLS_NUMERIC_CHARACTERS = ".,"] + lnSucces = goExecutor.oExecute(lcSql) + If lnSucces < 0 + Messagebox(goExecutor.cEroare, 0 + 16,'Eroare') + Endif + + Endproc && postConn + *** END postConn =========================================================================================== + + +Enddefine && oConn +*** END oConn =========================================================================================== + + + +* PROCEDURE Get_Ora( tnTip ) +* Date : 16/11/2004, 08:58:45 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 1 +* Parameter 1: +* +******************************************* INCEPUT:Get_Ora ******************************************* +Procedure Get_Ora( tnTip ) + * tnTip: 1 sau nimic = DATETIME ; 2 = CHARACTER + + Local lcRetVal + + If Pcount() = 0 Or Type('tnTip') <> 'N' + lnTip = 1 + Else + lnTip = tnTip + Endif + + &&preluare ora de pe oracle server: + Store 0 To pnsucces + pcexec = [select to_char(SYSdate,'dd/mm/yyyy hh:mi:ss AM') as dataora from dual] + pcCursor = [dataora_cursor] + pnsucces = goExecutor.oExecute(pcexec,pcCursor) + If (pnsucces != 0) + Select dataora_cursor + lcRetVal = dataora_cursor.dataora + Use In dataora_cursor + Endif + + If lnTip = 1 + lcRetVal = Ctot(lcRetVal) + Endif + Return lcRetVal +Endproc +******************************************* SFARSIT: Get_Ora ******************************************* + +Function Lista_Campuri + Lparameters tcAlias + + Local lcSelect, i, lcAlias, lcLista + lcLista = [] + lcSelect = Select() + lcAlias = tcAlias + + Select (lcAlias) + lnFields = Fcount() + For i = 1 To lnFields + lcField = Field(i) + lcLista = lcLista + [,] + lcField + Endfor + If !Empty(lcLista) + lcLista = Substr(lcLista,2) + Endif + + Select (lcSelect) + Return lcLista + +Endfunc && Lista_Campuri + + +***--------------------------------------------------------------------- +Procedure OPEN_DEFAULT_APP + Parameters tcfilename + + Declare Integer ShellExecute In shell32.Dll ; + INTEGER hndWin, ; + STRING cAction, ; + STRING cFileName, ; + STRING cParams, ; + STRING cDir, ; + INTEGER nShowWin + cFileName = tcfilename + cAction = "open" + ShellExecute(0,cAction,cFileName,"","",1) + +Endproc && OPEN_DEFAULT_APP + + +***--------------------------------------------------------------------- +Procedure GET_SCHEMA_GRID + Lparameters toGrid, tcColumnList, tcHeaderList, tcSchema, tlSelect, tnType, tcFrom, tcWhere, tcOrder, tcOutputName + + Local lcSelect, llSelect, lcAlias, lcWhere, lcOrder, lcColumn, lcHeader + Local lnType, lcInto + && tnType : 0 CURSOR, 1 TABLE, 2 ARRAY + + If Type('tnType') # 'N' + lnType = 0 + Else + If !Between(tnType,0,2) + lnType = 0 + Else + lnType = tnType + Endif + Endif + Do Case + Case lnType = 0 + lcInto = ' INTO CURSOR ' + Case lnType = 1 + lcInto = ' INTO TABLE ' + Other lnType = 1 + lcInto = ' INTO ARRAY ' + Endcase + + + tcColumnList = '' + tcHeaderList = '' + tcSchema = '' + + lnNrCol = toGrid.ColumnCount + Dimension myArray[lnNrCol,3] + + With toGrid + For lnCol = 1 To .ColumnCount + lnColumn = .Columns(lnCol).ColumnOrder + lcColumn = .Columns(lnCol).ControlSource + llVisible = .Columns(lnCol).Visible + lnWidth = .Columns(lnCol).Width + If !llVisible Or lnWidth = 0 + Adel(myArray,lnCol) + Loop + Endif + lnPos = At('.',lcColumn) + If lnPos > 0 + lcColumn = Substr(lcColumn, lnPos + 1) + Endif + *tcColumnList = tcColumnList + lcColumn + ',' + myArray[lnCol,1] = lnColumn + + For lnobjcol = 1 To .Columns(lnCol).Objects.Count + If Upper(.Columns(lnCol).Objects(lnobjcol).BaseClass)='HEADER' + lcHeader = .Columns(lnCol).Objects(lnobjcol).Caption + lcHeader = Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(lcHeader,Chr(32),'_'),'.','_'),'/','_'),'\','_'),"&","_"),"%",""),"(","_"),")","_"),"-","_") + *tcHeaderList = tcHeaderList + lcHeader + ',' + *tcSchema = tcSchema + lcColumn + [ as ] + lcHeader + [,] + myArray[lnCol,2] = lcColumn + myArray[lnCol,3] = lcHeader + Exit + Endif + Endfor + Endfor + *!* tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList)-1) + *!* tcHeaderList = Substr(tcHeaderList , 1, Len(tcHeaderList)-1) + *!* tcSchema = Substr(tcSchema , 1, Len(tcSchema)-1) + Endwith + For i = 1 To Alen(myArray,1) + l1 = myArray[i,1] + If Type('l1') # 'N' + myArray[i,1] = -1 + Endif + Endfor + + Asort(myArray) + For i = 1 To Alen(myArray,1) + If myArray[i,1] <> -1 + tcColumnList = tcColumnList + Alltrim(myArray[i,2]) + [,] + tcHeaderList = tcHeaderList + Alltrim(myArray[i,3]) + [,] + tcSchema = tcSchema + Alltrim(myArray[i,2]) + [ as ] + Alltrim(myArray[i,3]) + [,] + Endif + Endfor + + tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList)-1) + tcHeaderList = Substr(tcHeaderList , 1, Len(tcHeaderList)-1) + tcSchema = Substr(tcSchema , 1, Len(tcSchema)-1) + + + If tlSelect + tcSchema = 'SELECT ' + tcSchema + Endif + If !Empty(tcFrom) + tcSchema = tcSchema + ' FROM ' + Alltrim(tcFrom) + Endif + If !Empty(tcWhere) + tcSchema = tcSchema + ' WHERE ' + Alltrim(tcWhere) + Endif + + If !Empty(tcOrder) + tcSchema = tcSchema + ' ORDER BY ' + Alltrim(tcOrder) + Endif + + If !Empty(tcOutputName) + tcSchema = tcSchema + lcInto + tcOutputName + Endif + +Endproc && GET_SCHEMA_GRID + +***--------------------------------- +Procedure amessage + Lparameters tcMessage, tnDialogBoxType, tcTitleBarText, tnTimeOut + Local lnResponse + lnResponse = 0 + lcMessage = Iif(Empty(tcMessage),[],tcMessage) + lnDialogBoxType = Iif(Empty(tnDialogBoxType),0,tnDialogBoxType) + lcTitleBarText = Iif(Empty(tcTitleBarText),[],tcTitleBarText) + lnTimeOut = Iif(Empty(tnTimeOut),0,tnTimeOut) + If lnTimeOut # 0 + lnResponse = Messagebox(lcMessage,lnDialogBoxType,lcTitleBarText,lnTimeOut) + Else + lnResponse = Messagebox(lcMessage,lnDialogBoxType,lcTitleBarText) + Endif + + Return lnResponse + +Endproc && amessage +***--------------------------------- + +***--------------------------------- +Function amessagebox + Lparameters tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut ,tnTimeoutValue + + Local loMessage, lnReturn + loMessage = Newobject("messagebox_form", "MessageBox.vcx", "", tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut ,tnTimeoutValue) + loMessage.Show(1) + lnReturn = loMessage.IDOpcion + Return lnReturn + +Endfunc && amessagebox +***--------------------------------- + +Procedure export_xls + Lparameters tcAlias + + If Used(tcAlias) + lcDir = Addbs(gcTempPath) + + lcFile = Putfile('Nume fisier:', 'Foaie_Excel', 'XLS') + If Empty(lcFile) && Esc pressed + Return + Endif + + + Select (tcAlias) + Export To (lcFile) Type Xl5 + + OPEN_DEFAULT_APP(lcFile) + + Endif +Endproc && export_xls + +* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie +Procedure SAVE_GRID_COMMENT + Param toGrid + *wait wind 'save_grid' + Private pogrid + If Param()=0 Or Type('togrid')!="O" + Return .F. + Endif + + pogrid=toGrid + + * remember control sources in the column's comment field + With pogrid + Local nColumnIndex + For m.nColumnIndex = 1 To .ColumnCount + .Columns(m.nColumnIndex).Comment = .Columns(m.nColumnIndex).ControlSource + Endfor + .ToolTipText=.RecordSource + .RecordSource="" + Endwith + + Return .T. +Endproc && SAVE_GRID_COMMENT +***-------------------------------------------------------------- +Procedure RESTORE_GRID_COMMENT + Param toGrid + + *wait wind 'restore_grid' + Private pogrid + If Param()=0 Or Type('togrid')!="O" + Return .F. + Endif + + pogrid=toGrid + + + With pogrid + * restore record source + .RecordSource = .ToolTipText + * restore control sources + For m.nColumnIndex = 1 To .ColumnCount + .Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Comment + Endfor + .ToolTipText="" + Endwith + Return .T. +Endproc && RESTORE_GRID_COMMENT + + +* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie +Procedure SAVE_GRID_TAG + Param toGrid + *wait wind 'save_grid' + Private pogrid + If Param()=0 Or Type('togrid')!="O" + Return .F. + Endif + + pogrid=toGrid + + * remember control sources in the column's comment field + With pogrid + Local nColumnIndex + For m.nColumnIndex = 1 To .ColumnCount + .Columns(m.nColumnIndex).Tag = .Columns(m.nColumnIndex).ControlSource + Endfor + .ToolTipText=.RecordSource + .RecordSource="" + Endwith + + Return .T. +Endproc && SAVE_GRID_TAG +***-------------------------------------------------------------- +Procedure RESTORE_GRID_TAG + Param toGrid + + *wait wind 'restore_grid' + Private pogrid + If Param()=0 Or Type('togrid')!="O" + Return .F. + Endif + + pogrid=toGrid + + + With pogrid + * restore record source + .RecordSource = .ToolTipText + * restore control sources + For m.nColumnIndex = 1 To .ColumnCount + .Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Tag + Endfor + .ToolTipText="" + Endwith + Return .T. +Endproc && RESTORE_GRID_TAG + + +*------------------------------------------- +* Function...: Xmenu +* Author.....: MARTIN +* Date.......: 04/06/1997 +* Notes......: Based on an idea from Steve Zimmelman for FoxPro 2.x +* Parameters.: tcItems = Semicolon-separated String with the various options +* ...........: tnBar = Initially selected item (default=1) +* Returns....: Selected item number +* See Also...: PROMPT() [FoxPro Native] +* +Procedure XMENU + Lparameters TCITEMS, TNBAR + + Local NITEMCOUNT, AITEMS, X, NROW, NCOL, CTITLE, NLASTPOS, CCOLOR, AITEMS + + Private CPOPMENU, NSELECT && They flow into the GetChoice internal procedure + + If Pcount() < 2 + TNBAR = 1 + Endif + + Activate Screen + + * Parse every item + * + m.NITEMCOUNT = Occurs( ';', TCITEMS ) + 1 + Dimen AITEMS[ m.nItemCount ] + m.NLASTPOS = 1 + + For m.X = 1 To m.NITEMCOUNT + + If m.X < m.NITEMCOUNT + + AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ; + ( At( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 ) + Else + AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ; + ( Len( m.TCITEMS ) - m.NLASTPOS ) + 1 ) + Endif + + If AITEMS[ m.x ] # "\-" + + AITEMS[ m.x ] = Allt( AITEMS[ m.x ] ) + Endif + + m.NLASTPOS=At( ';', m.TCITEMS, m.X ) + 1 + Next + + * Calculates the mouse pointer position + * + m.NROW = Iif( Mrow() + m.NITEMCOUNT < Srow(), Mrow() - 1, Srow() - m.NITEMCOUNT ) + m.NCOL = Iif( Mcol() + 10 < Scol(), Mcol() - 3, Mcol() - 13 ) + + * Gets an unique name for the pop-up + * + m.CPOPMENU = 'M' + Sys(3) + "_" + + Define Popup ( m.CPOPMENU ) SHORTCUT Relative From NROW, NCOL + + For m.X = 1 To m.NITEMCOUNT + + Define Bar m.X Of ( m.CPOPMENU ) Prompt AITEMS[ m.x ] + Next + + m.CANS = "" + m.NSELECT = 0 + Clear Type + + On Selection Popup ( m.CPOPMENU ) Do GETCHOICE + + Activate Popup ( m.CPOPMENU ) Bar TNBAR + + Pop Key + Release Popup ( m.CPOPMENU ) + + Return Iif( Lastkey()=27, 0, m.NSELECT ) + +Endproc && XMENU + +*-------------------- +Procedure GETCHOICE + + m.NSELECT = Bar() + + Deactivate Popup ( m.CPOPMENU ) + + Return + &&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& + +Procedure lista2array + Parameters tcLISTA,taArray,tcSeparator + && tcLista este un sir de caractere care contine elementele separate prin <;> default + && tarray este vectorul care se completeaza - trebuie dat prin referinta + && tcSeparator separatorul de elemente din tcLista - default este ";" - este optional + && intoarce numarul de elemente gasite + + && ex: lnNr = lista2array("ana;are;mere",@alista,";") + External Array taArray + Local lcLista,lcSeparator,lnNRF,lcF1,i + + lnNRF = 0 + + lcLista=Upper(Allt(tcLISTA)) + If Parameters()<3 Or Empty(tcSeparator) + lcSeparator=";" + Else + lcSeparator=Alltrim(tcSeparator) + Endif + + If Right(lcLista,1)!=lcSeparator + lcLista=lcLista+lcSeparator + Endif + + lnNRF=Occurs(lcSeparator,lcLista) + + If lnNRF>0 + Dimension taArray[lnNrf,1] + + For i=1 To lnNRF + lcF1=Left(lcLista,At(lcSeparator,lcLista)-1) + + If i!=lnNRF + lcLista=Substr(lcLista,At(lcSeparator,lcLista)+1) + Endif + + taArray[i]=lcF1 + Endfor + Else + lnNRF = 0 + Endif + + Return lnNRF + +Endproc && lista2array + + +***------------------------------------------------------------------------------------------- +Procedure get_mask + Parameters tnint, tndec + + Local lnint, lndec + lnint = tnint + lndec = tndec + lnrest = Mod(lnint,3) + + lcString = Replicate("9",lnrest) + lnint_ramas = lnint - lnrest + Do While lnint_ramas > 0 + lcString = lcString + " "+ Replicate("9",3) + lnint_ramas = lnint_ramas - 3 + Enddo + If lndec > 0 + lcString = lcString +"."+Replicate("9",tndec) + Endif + + Return lcString + +Endproc && get_mask +***----------------------------------------------------------- + + +******************************************************************* +* PROCEDURE Get_Version( ) +* Date : 17/11/2004, 16:34:20 +* author : marius.mutu +* description: + +****** PARAMETER BLOCK ************** +* Parameters : 0 +* +******************************************* INCEPUT:Get_Version ******************************************* +Procedure Get_Version(tlNoRevision,tlInfo,tcfilename) + Local laVersion,lcVersion,lcFileName + + *-- Get Version Information + *-- Added 4-1-98 BDC + Local lcVersionText, lcFileName,llNoRevision,llInfo + + Dimension aVersion(12) + + If Empty(tcfilename) + lcFileName = Sys(16,0) + Else + lcFileName = tcfilename + Endif + llNoRevision = tlNoRevision + llInfo = tlInfo + + + + *** EGL: 2002.1.2 17:06 - switched to AGETFILEVERSION(). + If Val(Substr(Version(), 15)) >= 6 + * The AGETFILEVERSION() function was introduced in VFP 6 + + *!* DECLARE STRING GetCommandLine IN Kernel32 + *!* lcFileName = GetCommandLine() + lcVersionText = "" + + *!* IF GetFileVersion(&lcFileName,@aVersion) = 0 + If Agetfileversion(aVersion, lcFileName) > 0 + If !llInfo + * daca vreau doar numarul versiunii + lcVersion = Allt(aVersion(4)) + If llNoRevision + * daca nu vreau si revizia + lnPos = Rat('.',lcVersion,1) + Else + lnPos = Len(lcVersion) + Endif + lcVersionText = Left(lcVersion,lnPos) + Else + * vreau toata informatia despre fisier + If Not Empty(aVersion(1)) + lcVersionText = Allt(aVersion(1)) + Endif + + If Not Empty(aVersion(2)) + lcVersionText = lcVersionText+Chr(10)+"Produs de: "+ Allt(aVersion(2)) + Endif + + If Not Empty(aVersion(3)) + lcVersionText = lcVersionText+Chr(10)+"Descriere: "+ Allt(aVersion(3)) + Endif + + If Not Empty(aVersion(4)) + lcVersionText = lcVersionText+Chr(10)+"Versiune fisier: "+ Allt(aVersion(4)) + Endif + + If Not Empty(aVersion(5)) + lcVersionText = lcVersionText+Chr(10)+"Nume intern: "+ Allt(aVersion(5)) + Endif + + If Not Empty(aVersion(6)) + lcVersionText = lcVersionText+Chr(10)+"Copyright: "+ Allt(aVersion(6)) + Endif + + If Not Empty(aVersion(7)) + lcVersionText = lcVersionText+Chr(10)+"Marca inregistrata: "+ Allt(aVersion(7)) + Endif + + If Not Empty(aVersion(8)) + lcVersionText = lcVersionText+Chr(10)+"Nume fisier: "+ Allt(aVersion(8)) + Endif + + If Not Empty(aVersion(9)) + lcVersionText = lcVersionText+Chr(10)+"Private Build: "+ Allt(aVersion(9)) + Endif + + If Not Empty(aVersion(10)) + lcVersionText = lcVersionText+Chr(10)+"Nume produs: "+ Allt(aVersion(10)) + Endif + + If Not Empty(aVersion(11)) + lcVersionText = lcVersionText+Chr(10)+"Versiune produs: "+ Allt(aVersion(11)) + Endif + + If Not Empty(aVersion(12)) + lcVersionText = lcVersionText+Chr(10)+"Special Build: "+ Allt(aVersion(12)) + Endif + + If Empty(lcVersionText) + lcVersionText = "Versiune necunoscuta." + Endif + Endif + Else + + lcVersionText = "Versiune necunoscuta." + + Endif + + Else + lcVersionText = "Versiune necunoscuta." + Endif + Return lcVersionText + +Endproc +******************************************* SFARSIT: Get_Version ******************************************* + + +* PROCEDURE Get_Hexa( tnDeca ) +* Date : 18/11/2004, 17:56:48 +* author : marius.mutu +* description: transforma un Deca in Hexa + +****** PARAMETER BLOCK ************** +* Parameters : 1 +* Parameter 1: Numarul in Deca +* +******************************************* INCEPUT:Get_Hexa ******************************************* +Procedure Get_Hexa( tnDeca ) + Local laHexa,lnHexa,lnDeca + + + If Empty(tnDeca) + lnDeca = 0 + Else + lnDeca = tnDeca + Endif + + Dimension laHexa[16] + laHexa[1] = '0' + laHexa[2] = '1' + laHexa[3] = '2' + laHexa[4] = '3' + laHexa[5] = '4' + laHexa[6] = '5' + laHexa[7] = '6' + laHexa[8] = '7' + laHexa[9] = '8' + laHexa[10] = '9' + laHexa[11] = 'A' + laHexa[12] = 'B' + laHexa[13] = 'C' + laHexa[14] = 'D' + laHexa[15] = 'E' + laHexa[16] = 'F' + + lnHexa = '' + + Do While lnDeca > 0 + lnrest = Mod(lnDeca,16) + lcHexa = laHexa[lnRest+1] + lnDeca = Int(lnDeca/16) + + lnHexa = lcHexa + lnHexa + lnrest = Mod(lnDeca,16) + + Enddo + + Return lnHexa + +Endproc +******************************************* SFARSIT: Get_Hexa ******************************************* +&& completeaza cu spatii si CRLF un mesaj a.i. pe fiecare linie sa fie lnLength caractere +Function format_msg + Parameters tcErrMsg,tnLength + Local lnLength,lcLinie,lcMesaj,lnPoz,lnCate,i,j + lcMesaj="" + If Empty(tnLength) + lnLength=50 && numarul de caractere pe linie + Else + lnLength=tnLength + Endif + i=1 + If At(Chr(13)+Chr(10),tcErrMsg,i)>0 + lnCate=At(Chr(13)+Chr(10),tcErrMsg,i)+1 + i=i+1 + Else + lnCate=Min(lnLength,Rat(' ',Substr(tcErrMsg,1,lnLength))-1) + Endif + lnPoz=1 + *!* lcLinie=Substr(tcErrMsg,1,lnCate) + + Do While lnPoz0 + lnCate=At(Chr(13)+Chr(10),tcErrMsg,i)+2-lnPoz + i=i+1 + Else + lcNextChar=Substr(tcErrMsg,lnPoz+lnLength,1) + lcLinieNoua=Substr(tcErrMsg,lnPoz,lnLength) + If lcNextChar!=' ' And Len(lcLinieNoua)>=lnLength + lnCate=Min(lnLength,Rat(' ',lcLinieNoua)-1) + Else + lnCate=lnLength + Endif + Endif + Enddo + Return lcMesaj +Endfunc && format_msg +***-------------------------------------------------------------------------------------- +Function Lista_Campuri + Lparameters tcAlias + + Local lcSelect, i, lcAlias, lcLista + lcLista = [] + lcSelect = Select() + lcAlias = tcAlias + + Select (lcAlias) + lnFields = Fcount() + For i = 1 To lnFields + lcField = Field(i) + lcLista = lcLista + [,] + lcField + Endfor + If !Empty(lcLista) + lcLista = Substr(lcLista,2) + Endif + + Select (lcSelect) + Return lcLista + +Endfunc && Lista_Campuri +***------------------------- CLASS oSysTray ------------------------- + + +Define Class oSysTray As Custom + oobjsystray = Null + + Procedure minimizeaza + + Local lcIcon + lcIcon = [news1.ico] + + If _Screen.WindowState = 1 + This.oobjsystray= Newobject('systray') + With This.oobjsystray + .iconFile = lcIcon + .TipText = [Tasks] + IF WEXIST("frm_luc") + frm_lucrare_noua.release() + endif + .AddIconToSystray() + .icondblclickevent() + Endwith + _Screen.Hide() + Endif + Endproc + + Procedure clickDreapta + + Local lcIcon + lcIcon = [news1.ico] + + If _Screen.WindowState = 1 + This.oobjsystray= Newobject('systray') + With This.oobjsystray + .iconFile = lcIcon + .TipText = [Tasks] + .iconrightclickevent() + Endwith + * _Screen.Hide() + Endif + ENDPROC + + + Procedure iconrightclickevent + + Local lcIcon + lcIcon = [news1.ico] + + If _Screen.WindowState = 1 + This.oobjsystray= Newobject('systray') + With This.oobjsystray + .iconFile = lcIcon + .TipText = [Tasks] + .AddIconToSystray() + Endwith + Do meniu.mpr + * _Screen.Hide() + Endif + ENDPROC + +Enddefine +**----------------------- CLASS oSysTray --------------------------------- + + + +FUNCTION HTMLFix(tcString) + * This code ASSUMES the incoming string is ANSI, + * CHR(32) to (127) and has not already had the + * characters converted - it will make a mess of a + * string that already has strings like — in it. + LOCAL lcString as string + lcString = STRTRAN(tcString,"&","&") + lcString = STRTRAN(lcString,"<","<") + lcString = STRTRAN(lcString,">",">") + RETURN ALLTRIM(lcString) +ENDFUNC && HTMLFix + + +FUNCTION RFC822Date(tDateTime AS DATETIME) AS STRING + * Returns "Thu, 27 Feb 2003 14:11:12 GMT" + LOCAL lcReturn AS STRING, lcTime AS STRING + lcReturn = LEFT(PROPER(CDOW(tDateTime)),3) +", " + lcReturn = lcReturn + PADL(DAY(tDateTime),2,'0') + SPACE(1) + lcReturn = lcReturn + LEFT(PROPER(CMONTH(tDateTime)),3) + SPACE(1) + lcReturn = lcReturn + STR(YEAR(tDateTime),4)+SPACE(1) + + lcTime = TTOC(tDateTime,2) && HH:MM:SS PM + * Compensate for PM + IF RIGHT(lcTime,2) = "PM" AND LEFT(lcTime,2) # "12" + lcTime = STR(12+VAL(lcTime),2)+SUBSTR(lcTime, 3, 6) + ELSE + lcTime = LEFT(lcTime, 8) + ENDIF + * Fake the time zone + lcTime = lcTime + " EST" + + lcReturn = lcReturn + lcTime + + RETURN lcReturn +ENDFUNC && RFC822Date + + +*=============================================== +Procedure COPYFILEAPI + Lparameters tcSourceFile, tcDestinationFile + + && WIN API + && Copy file + && NOTE: the file name case will not be changed for the existing destination file. + Declare Long CopyFile In WIN32API ; + String SourceFileName, String DestFileName, Long bFailIfExists + Local llSucces + llSucces = .T. + If COPYFILE(tcSourceFile, tcDestinationFile, 0) = 0 + llSucces = .F. + ENDIF + + CLEAR DLLS "WIN32API" + + Return llSucces +Endproc && COPYFILE + +*=============================================== +Procedure MOVERENAMEFILEAPI + Lparameters tcSourceFile, tcDestinationFile + Local llSucces + llSucces = .T. + && Move/Rename file + Declare Long MoveFile In WIN32API ; + String SourceFileName, String DestFileName + If MOVEFILE(tcSourceFile, tcDestinationFile) = 0 + llSucces = .F. + Endif + + CLEAR DLLS "WIN32API" + + Return llSucces +Endproc && MOVEFILE diff --git a/programe/proceduri.prg b/programe/proceduri.prg new file mode 100644 index 0000000..3852002 --- /dev/null +++ b/programe/proceduri.prg @@ -0,0 +1,390 @@ +*!* 04.03.2013 +*!* marius.mutu +*!* genereaza_xml_roa +*!* se retin numele xml-urilor pentru clientii roa in settings.ini in sectiunea [folder] + +#Define crlf Chr(13) + Chr(10) + +Procedure EditTask + Parameters tnId + + Private poRec + lcSql = [select * from tasks where ] + Iif(!Empty(tnId), [ id = ?tnId], [1=2]) + lcCursor = Sys(2015) + lnSucces = goExecutor.oexecute(lcSql, lcCursor) + If lnSucces > 0 + Select (lcCursor) + Scatter Name poRec Memo + Do Form frm_adaugare_task + Endif + + + Return lnSucces +Endproc + +*****============================================================== +Procedure EditLucrare + Parameters tnIdLucrare + + Local lnSucces, lcCursor, lcSql + + Private poRec + *!* IF EMPTY(tnid) + + *!* endif + lcSql = [select * from luc_vlucrari_tot where ] + ; + Iif(!Empty(tnIdLucrare), [ id = ?tnIdLucrare ], [1=2]) + lcCursor = Sys(2015) + lnSucces = goExecutor.oexecute(lcSql, lcCursor) + If lnSucces > 0 + Select (lcCursor) + Scatter Name poRec Memo + poRec.datal = Ttod(poRec.datal) + Do Form frm_lucrare_noua + Endif + Return lnSucces +Endproc +************************** + +************************** +* se apeleaza tasks.exe cu parametru din Windows Task Scheduller +* se genereaza xml pentru toti clientii ROA +************************** +Procedure genereaza_xml_roa_tot + + Local lcSql, llAuto, llSilent + Text To lcSql + SELECT DISTINCT CUSTOMER_ID, CUSTOMER + FROM (select CUSTOMER_ID, CUSTOMER, DATA_PLEC + from VSC_PROGRAME_CLIENTI t + WHERE PROGRAM = 'ROACONT' + AND DATA_PLEC BETWEEN TRUNC(SYSDATE) - 60 AND SYSDATE) + order by CUSTOMER + Endtext + executaSql(lcSql, [cCustomersTemp], .T.) + + llSilent = .T. + llAuto = .T. + Select cCustomersTemp + Scan + Wait Window Transform(Recno()) + Transform(Reccount()) + ' ' + cCustomersTemp.customer Nowait + Select cCustomersTemp + Do genereaza_xml_roa With customer_id, customer, m.llSilent, m.llAuto In proceduri.prg + Endscan + Use In (Select('cCustomersTemp')) +Endproc && genereaza_xml_roa_tot +*** +Procedure genereaza_xml_roa + Lparameters tnCustomerId, tcName, tlSilent, tlAuto + * tlSilent: .T. = nu arata dialogul SaveAs pentru xml, decat daca nu are configurat numele fisierului + * tlAuto: .T. = genereaza automat numele fisierului xml, daca nu este configurat in settings.ini + + *!* 09.08.2010 + *!* marius.mutu + *!* nu se mai creeaza vechiul fisier xml cu aplicatiile, ci doar noul fisier + *!* 28.06.2012 + *!* arhivele nu mai au extensia .exe, ci .zip ( am adaugat lcExtensieArhive ) + *!* 20.07.2012 + *!* am adaugat tcName + + Local lcSql, lcfile, cVersiune, lcClipText, lcSir, lcFisier, lcDir, lcFisVersDif + Local lcfileVersiuniMax, lnSucces, lnCustomerId, liat, lcFileAfis, lcExtensieArhive + Local laEroare[1], lcVersiune, x, lcXMLFolder + Local llSilent, llAuto + llSilent = m.tlSilent + llAuto = m.tlAuto + + lcExtensieArhive = [.ZIP] + liat = 0 + lnCustomerId = m.tnCustomerId + *!* 20.07.2012 : am adaugat m.lcCustomerName + lcCustomerName = m.tcName + + lcClipText = [] + lcSir = [] + lcFisier = [] + lcDir = [] + lcFisVersDif = [] + *!* 25.01.2011 + *!* x = SQLConnect("JCSSERVER","SOFT_SERII","123") + x = SQLConnect(goApp.cHostSerii, goApp.cUsernameSerii, goApp.cPasswordSerii) + If x < 0 + Aerror(laEroare) + Messagebox(laEroare(3)) + Return + Endif + *!* 25.01.2011 ^ + + *!* 17.06.2011 : am adaugat id_grup_clienti = 1 ( clienti ROA ) + lcSql = [select DISTINCT customer_id, NUME, ID_PROGRAM, (CASE WHEN Upper(PROGRAM) ] + ; + [LIKE 'INDEX%' THEN 'MANUAL' ELSE PROGRAM END) AS PROGRAM from vgen_programe ] + ; + [where customer_id = ] + Alltrim(Str(m.lnCustomerId)) + [ and id_grup_clienti = 1] + lnSucces = SQLExec(x, lcSql, "crsProgsTemp1") + If lnSucces < 0 + Return + Endif + SQLDisconnect(x) + *!* selectie combobox - un client, programele cu licenta pentru client + *!* 17.06.2011 : am adaugat comun ca sa pot face ROASTART.xml si .XML + *!* 20.07.2012 : am inlocuit crs2xml.id cu m.lnCustomerId + executaSql([select 0 as ales, v.customer, v.program, v.versiune, v.versiune_maxima, ] + ; + [v.id, v.customer_id, v.comun from vsc_versiune_max_inst_dv v ] + ; + [where v.customer_id = ] + Alltrim(Str(m.lnCustomerId)), "crsprogstemp2", .T.) + *!* selectie combobox - un client, programele cu licenta pentru client ^ + executaSql([select * from programs], "crsPrograms", .T.) + executaSql([select * from sc_versiune_programe], "crsVersProg", .T.) + + *** directorul xml_aplicatii + lcXMLFolder = Nvl(readINI(goApp.cinifile, "folder", "xml_aplicatii"), "") + If Empty(m.lcXMLFolder) + llSilent = .F. + ENDIF + + *** 04.03.2013 + *** citesc numele fisierului xml pentru client din clientului din settings.ini + lcCustomerNameSaved = Nvl(readINI(goApp.cinifile, "folder", "xml_aplicatii_" + Alltrim(Str(m.lnCustomerId))), "") + If !Empty(Nvl(m.lcCustomerNameSaved, '')) + lcCustomerName = Juststem(m.lcCustomerNameSaved) + ELSE + IF m.llAuto + lcCustomerName = 'customer_' + ALLTRIM(STR(m.lnCustomerId)) + WriteINI(goApp.cinifile, "folder", "xml_aplicatii_" + Alltrim(Str(m.lnCustomerId)), m.lcCustomerName) + ELSE + llSilent = .F. + ENDIF + Endif + + + + If !m.llSilent + *!* 20.07.2012 : am inlocuit crs2xml.Name cu m.lcCustomerName + lcfile = Putfile("Alegeti calea", Iif(Empty(m.lcXMLFolder), "", Addbs(m.lcXMLFolder)) + Upper(Alltrim(Strtran(m.lcCustomerName, ' ', ''))) + '.xml', 'xml') + If !Empty(m.lcfile) + writeINI(goApp.cinifile, 'folder', "xml_aplicatii_" + Alltrim(Str(m.lnCustomerId)), Juststem(m.lcfile)) + Endif + Else + lcfile = Addbs(m.lcXMLFolder) + Upper(Alltrim(Strtran(m.lcCustomerName, ' ', ''))) + '.xml' + Endif + + *!* 17.06.2011 : am adaugat comun ca sa pot face ROASTART.xml si .XML + Select a.nume As customer, a.Program, b.versiune, b.versiune_maxima, a.customer_id, a.id_program, b.comun ; + From crsprogstemp2 b ; + INNER Join crsProgsTemp1 a On a.customer_id = b.customer_id And b.Id = a.id_program ; + Order By 7 Desc, 2 ; + Into Cursor crsXmlOut + + Select Program As Item, versiune As Version, ; + '\_ARHIVE\' + Alltrim(Program) + '\' + Alltrim(Program) + '-' + Alltrim(versiune) + lcExtensieArhive As fileURL, ; + '' As usermsg ; + From crsXmlOut Where comun = 0 ; + Into Cursor crsXmlOutNew + + *!* 17.06.2011 : am adaugat comun pentru ROASTART.xml ( trebuie redenumit manual in ROASTART.xml ) + *!* 20.07.2012 : am modificat coloanele item ( program as item ) si fileURL ( '\_ARHIVE\' + Alltrim(Program) + '\' + Alltrim(Program) + '-' + Alltrim(versiune) + lcExtensieArhive ) + Select Iif(At([USERREPORTS], Alltrim(Program)) <> 0 And At([-], Program, 1) <> 0, Substr(Alltrim(Program), 1, At([-], Alltrim(Program), 1) - 1), Alltrim(Program)) As Item, versiune As Version, ; + '\_ARHIVE\' + Iif(At([USERREPORTS], Alltrim(Program)) <> 0, [USERREPORTS], Alltrim(Program)) + '\' + Alltrim(Program) + '-' + Alltrim(versiune) + lcExtensieArhive As fileURL, ; + '' As usermsg ; + From crsXmlOut Where comun = 1 ; + Into Cursor crsXmlOutNewS + + *SELECT c.customer, c.program, c.versiune, c.customer_id FROM crsprogstemp2 c ; + JOIN crsprograms p ON p.id = c.id ORDER BY 2 ; + WHERE !EMPTY(NVL(c.versiune,[])) ; + INTO CURSOR crsProgLic + + Select crsXmlOut + lcClipText = lcClipText + Alltrim(customer) + crlf + "VERSIUNI EXISTENTE: " + lcVersiune = "" + Set Textmerge On To Memvar lcVersiune Noshow + Set Textmerge Delimiters To '{{', '}}' + \ + + Select crsXmlOut + *SELECT crsProgLic + Scan For customer_id = lnCustomerId + \<{{Alltrim(Program)}}> + \ + \{{Alltrim(versiune)}} + \{{'\_ARHIVE\' + Alltrim(Program) + '\' + Alltrim(Program) + '-' + Alltrim(versiune) + lcExtensieArhive}} + \S-a gasit {{Alltrim(Program)}} versiunea {{Alltrim(versiune)}}. Programul va incepe procedurile de actualizare ! + \ + \ + + lcClipText = lcClipText + Alltrim(Program) + '-' + Alltrim(versiune) + ', ' + Endscan + Set Textmerge To + + + + *!* 09.02.2010 + *!* Cursortoxml("crsXmlOutNew", Addbs(Justpath(m.lcfile)) + Juststem(m.lcfile) + '.new.xml', 1, 0+512, 0, "1") + Cursortoxml("crsXmlOutNew", Addbs(Justpath(m.lcfile)) + Juststem(m.lcfile) + '.xml', 1, 0 + 512, 0, "1") + *!* 17.06.2011 + Cursortoxml("crsXmlOutNewS", Addbs(Justpath(m.lcfile)) + 'ROASTART_' + Juststem(m.lcfile) + '.xml', 1, 0 + 512, 0, "1") + * Creez si un ROASTART.xml pentru firmele de pe ROA_ROMFAST, pentru ca ele descarca ROASTART.xml direct de pe ROA_CENTRAL, nu de pe ROA_ROMFAST + If Upper(Juststem(m.lcfile)) = 'ROMFAST' + Cursortoxml("crsXmlOutNewS", Addbs(Justpath(m.lcfile)) + 'ROASTART' + '.xml', 1, 0 + 512, 0, "1") + Endif + *!* 17.06.2011 ^ + *!* Strtofile(lcVersiune, m.lcfile) + *!* 09.02.2010 ^ + + *** salvez director xml aplicatii + writeINI(goApp.cinifile, 'folder', 'xml_aplicatii', Justpath(m.lcfile)) + + + *Use In (Select("crsProgLic")) + Use In (Select("crsprograms")) + Use In (Select("crsProgsTemp1")) + Use In (Select("crsProgsTemp2")) + Use In (Select("crsxmlout")) + Use In (Select("crsxmloutnew")) + Use In (Select("crsxmloutnewS")) && 17.06.2011 + Use In (Select("crsVersProg")) + + + _Cliptext = Nvl(lcClipText, []) + + +Endproc && genereaza_xml_roa + +******************************************* +Procedure genereaza_xml_contafin + + Local lcAppPath, lcCheckSum, lcCustomerId, lcFileExe, lcFileZip, lcFisiere, lcSql, lcText, lcWhere + Local lcXML, lcXML2, lcfile, lnHandle, lnSucces, lcAppPath + + lcXMLPath = readINI(goApp.cinifile, "folder", "contafin_arhive") + lcXMLPath = Addbs(m.lcXMLPath) + + *!* lnHandle = SQLConnect('roa_romfast','soft','soft') + *!* If lnHandle < 0 + *!* ProcessError() + *!* Return + *!* Endif + + Text To lcSql Noshow Textmerge +SELECT vp.name as program, vc.versiune_curenta as versiune, vc.customer_id + From vprograme vp Left Join sc_versiune_programe vc On vc.id_program = vp.Id + Left Join programs_groups pg On pg.id_program = vp.Id + Where vc.appupdate = 1 + Endtext + + *!* lnSucces = SQLExec(lnHandle, lcSql, "cProgrameTemp") + *!* If lnSucces < 0 + *!* ProcessError() + *!* Return + *!* Endif + + executaSql(lcSql, "cProgrameTemp", .T.) + + *!* 28.10.2010 + Create Cursor crsCheckSum (fisier c(250), checksum c(100)) + *!* 28.10.2010 ^ + + *!* APPUPDATE + *!* http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/appupdate-1.0.3.exe + *!* http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/changelog_appupdate.txt + *!* 1.0.3 + lcFisiere = '' + Select Distinct customer_id From cProgrameTemp Into Cursor cCustomers Order By customer_id + Select cCustomers + Scan + If !Empty(Nvl(customer_id, 0)) + lcWhere = "inlist(nvl(customer_id,0), 0, " + Alltrim(Str(customer_id)) + ")" + lcCustomerId = Alltrim(Str(customer_id)) + Else + lcWhere = "NVL(customer_id,0) = 0" + lcCustomerId = "" + Endif + + Select Program, versiune, ; + [http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/] + Alltrim(Program) + [-] + Alltrim(versiune) + [.exe] As fisier, ; + [http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/changelog_] + Alltrim(Program) + [.txt] As Log, ; + Space(100) As checksum ; + From cProgrameTemp ; + Where &lcWhere ; + Order By Program ; + Into Cursor crsXML Readwrite + + + + Select crsXML + Scan + lcFileExe = lcXMLPath + Alltrim(Program) + [-] + Alltrim(versiune) + [.exe] + lcFileZip = lcXMLPath + Alltrim(Program) + [-] + Alltrim(versiune) + [.zip] + lcfile = lcFileExe + If !File(lcFileExe) + If File(lcFileZip) + lcfile = lcFileZip + Endif + Endif + Wait Window 'CUSTOMER_ID ' + lcCustomerId + ' ' + Transform(Recno()) + '/' + Transform(Reccount()) + ' ' + lcfile Nowait + + If File(lcfile) + Select crsCheckSum + Locate For Upper(Alltrim(fisier)) = Upper(Alltrim(lcfile)) + If Found() + lcCheckSum = checksum + Else + lcText = Filetostr(lcfile) + lcCheckSum = Sys(2007, lcText, 0, 1) + lcText = "" + Insert Into crsCheckSum (fisier, checksum) Values (lcfile, lcCheckSum) + Endif + *** completez checksum-ul si schimb extensia fisierului din exe in zip, daca este cazul + Replace checksum With lcCheckSum, fisier With Forceext(Alltrim(fisier), Justext(m.lcfile)) In crsXML + Else + Messagebox('Nu exista fisierul ' + lcfile, 0 + 48, _Screen.Caption) + Endif + Endscan + + lcXML = lcXMLPath + 'contafin' + Iif(!Empty(lcCustomerId), '_' + lcCustomerId, '') + '.xml' && CONTAFIN.XML, CONTAFIN_26.XML + lcXML2 = lcXMLPath + 'contafin_local' + Iif(!Empty(lcCustomerId), '_' + lcCustomerId, '') + '.xml' && CONTAFIN.XML, CONTAFIN_26.XML + Cursortoxml('crsXML', lcXML, 1, 512, 0, "1") + + Select crsXML + Replace All fisier With Strtran(fisier, '83.103.197.79:3002', '10.0.20.122:81'), Log With Strtran(Log, '83.103.197.79:3002', '10.0.20.122:81') + Cursortoxml('crsXML', lcXML2, 1, 512, 0, "1") + Use In crsXML + lcFisiere = lcFisiere + lcXML + crlf + Endscan + Use In (Select('cCustomers')) + Use In (Select('cProgrameTemp')) + + Use In (Select('crsCheckSum')) + + Messagebox('S-au creat fisierele ' + lcFisiere) + +Endproc && genereaza_xml_contafin + +************************************************************* +*** converteste un nume de script in elementele componente +************************************************************* +Procedure ParseScriptName + Lparameters tcScript, tcScriptPrefix, tdScriptDate, tnScriptSeq, tcScriptType + + Local lcScript, lnAn, lnLuna, lnPos, lnZi + lcScript = Juststem(m.tcScript) + tcScriptPrefix = "" + tdScriptDate = {} + tnScriptSeq = 0 + tcScriptType = "" + + If !Empty(m.lcScript) + tcScriptPrefix = Getwordnum(m.lcScript, 1, '_') + + lnAn = Val(Getwordnum(m.lcScript, 2, '_')) + lnLuna = Val(Getwordnum(m.lcScript, 3, '_')) + lnZi = Val(Getwordnum(m.lcScript, 4, '_')) + tdScriptDate = Date(m.lnAn, m.lnLuna, m.lnZi) + + tnScriptSeq = Int(Val(Juststem(Getwordnum(m.lcScript, 5, '_')))) + + lnPos = At('_', m.lcScript, 5) + If m.lnPos > 0 + tcScriptType = Juststem(Substr(m.lcScript, m.lnPos + 1)) + Endif + Endif + +Endproc && ParseScriptName \ No newline at end of file diff --git a/programe/proceduri_sql.prg b/programe/proceduri_sql.prg new file mode 100644 index 0000000..940c66c --- /dev/null +++ b/programe/proceduri_sql.prg @@ -0,0 +1,144 @@ +#DEFINE crlf CHR(13) + CHR(10) +************************ inceput conecteaza *************************** +*** foloseste gnHandle +*************************************************************************** +PROCEDURE conecteaza + LPARAMETERS tcHost, tcUser, tcPassword + + LOCAL laEroare[1] + *:Global gnHandle + + gnHandle = SQLCONNECT(tcHost, tcUser, tcPassword) + IF gnHandle < 1 + AERROR(laEroare) + eroaresql(@laEroare, "Conectare " + tcUser + '@' + tcHost) + ENDIF + + RETURN m.gnHandle +ENDPROC + +************************ inceput conecteazaH *************************** +*** foloseste gnHandle +*************************************************************************** +PROCEDURE conecteazaH + LPARAMETERS tcHost, tcUser, tcPassword + + LOCAL laEroare[1], lnHandle + lnHandle = SQLCONNECT(tcHost, tcUser, tcPassword) + IF lnHandle < 1 + AERROR(laEroare) + eroaresql(@laEroare, "Conectare " + tcUser + '@' + tcHost) + ENDIF + + RETURN m.lnHandle +ENDPROC + + +**************************** inceput executaSql *************************** +*** foloseste gnHandle +*************************************************************************** +FUNCTION executaSql + LPARAMETERS tcSql, tcCursor, tlShowErr + + LOCAL laEroare[1], lcCursor, lcSql, llShowErr, lnHandle, lnSucces + lnSucces = -1 + + lcCursor = iif(!empty(m.tcCursor), m.tcCursor, "") + lnHandle = m.gnHandle + lcSql = m.tcSql + llShowErr = m.tlShowErr + + IF m.lnHandle > 0 + lnSucces = SQLEXEC(m.lnHandle, m.lcSql, m.lcCursor) + + IF m.lnSucces < 0 AND m.llShowErr + AERROR(laEroare) + eroaresql(@laEroare, m.lcSql) + ENDIF + ENDIF + + RETURN m.lnSucces +ENDFUNC + +**************************** inceput executaSqlH *************************** +*** foloseste tnHandle +*************************************************************************** +FUNCTION executaSqlH + LPARAMETERS tnHandle, tcSql, tcCursor, tlShowErr, taEroare + + EXTERNAL ARRAY taEroare + LOCAL laEroare[1], lcCursor, lcSql, llShowErr, lnHandle, lnSucces + lnSucces = -1 + + lcCursor = iif(!empty(m.tcCursor), m.tcCursor, "") + lnHandle = m.tnHandle + lcSql = m.tcSql + llShowErr = m.tlShowErr + + IF m.lnHandle > 0 + lnSucces = SQLEXEC(m.lnHandle, m.lcSql, m.lcCursor) + + IF m.lnSucces < 0 + AERROR(taEroare) + IF m.llShowErr + eroaresql(@taEroare, m.lcSql) + ENDIF + ENDIF + ENDIF + + RETURN m.lnSucces +endfunc + +************************* inceput deconecteaza ************************ +*** foloseste gnHandle +*************************************************************************** +FUNCTION deconecteaza + + LOCAL lnHandle, lnSucces + lnHandle = m.gnHandle + lnSucces = -1 + IF m.lnHandle > 0 + lnSucces = SQLDISCONNECT(m.lnHandle) + else + AERROR(laEroare) + eroaresql(@laEroare, "Deconectare Handle = " + alltrim(str(m.lnHandle))) + ENDIF + + RETURN m.lnSucces +ENDFUNC + +************************* inceput deconecteaza ************************ +*** foloseste gnHandle +*************************************************************************** +FUNCTION deconecteazaH + LPARAMETERS tnHandle + + LOCAL lnHandle, lnSucces + + lnHandle = m.tnHandle + lnSucces = -1 + IF m.lnHandle > 0 + lnSucces = SQLDISCONNECT(m.lnHandle) + else + AERROR(laEroare) + eroaresql(@laEroare, "Deconectare Handle = " + alltrim(str(m.lnHandle))) + ENDIF + + RETURN m.lnSucces +ENDFUNC +******************************* inceput eroareSql ********************************** +PROCEDURE eroaresql + LPARAMETERS laErr, lcsql + + LOCAL lcMesaj + EXTERNAL ARRAY laErr + + lcMesaj = [Eroare # : ] + ALLTRIM(STR(laErr(1))) + crlf + ; + [Mesajul : ] + laErr(2) + ; + IIF(!EMPTY(laErr(3)), [Eroare OLE : ] + laErr(3) ,[]) + ; + [Aplicatie : ] + laErr(4) + ; + IIF(PCOUNT() = 2, crlf + lcsql, []) + MESSAGEBOX(lcMesaj,0+16) + +ENDPROC + \ No newline at end of file diff --git a/programe/rapoarte.prg b/programe/rapoarte.prg new file mode 100644 index 0000000..720ce52 --- /dev/null +++ b/programe/rapoarte.prg @@ -0,0 +1,976 @@ +*** RAPOARTE +*!* Listare raport "LISTAREUSERREPORT(lcAlias, "FRX/XLS", lcRaport)" +*!* Generare raport "do UserReport2File" +*!* Modificare raport "DO MODIFICA_RAPORT_UTILIZATOR" +*!* Printer Setup "sys(1037)" + +*!* 26.10.2009 +*!* marius.mutu +*!* listareuserreport - cautare raport in getuserreppath si in reg_report_path +*!* listareuserreport - cautare logo.jpg in getuserreppath si in reg_report_path daca nu e dat ca parametru +*!* get_report_path - cautare si creare raport usr in CONTAFIN\USERREPORTS\CONGEST\FIRMA + +*!* 04.11.2009 +*!* marius.mutu +*!* + GetReportPath - intoarce directorul CONTAFIN\USERREPORTS +*!* Get_Report_Path - tratare variabila glFacturiPersonalizate +*!* listareuserreport - nu am mai folosit get_report_path pentru logo si raport ci GetReportPath(era folosit in ACNPRO si nu era definita variabila glFacturiPersonalizate) + +*!* 07.04.2010 +*!* marius.mutu +*!* getUserRepPath - lcAppPath = gcAppPath +*!* + getUserRepFile + +*!* 30.08.2010 +*!* marius.mutu +*!* rapoarte_ultime_modificari +*!* se cere data initiala, data finala, titlu pentru ultimele modificari +*!* ultima versiune instalata sau data initiala <-> versiunea maxima sau data finala + +#DEFINE CRLF CHR(13) + CHR(10) + +Procedure rapoarte_speciale_cl + + Local lcConnect, lnSucces,lAeroare + *!* PRIVATE pdDatainc,pdDataSf + *!* STORE {} to pdDatainc,pdDataSf + *!* pdDatainc = DATE(2007,7,1) + *!* pdDatasf = DATE(2007,7,31) + + lcConnect = SQLConnect('ROA_CENTRAL','soft','soft') + lnSucces = SQLExec(lcConnect,[select sters, validat, id_utilizator, id_client, nume_client, id, titlu, localizare, explicatie_client, ] + ; + [ tip_lucrare, special, datal, id_program, nume_program, prenume_utilizator, nume_utilizator, ROUND(ore_lucrate,2) as ore_lucrate ] + ; + [ from luc_vlucrari_clienti_special where special = 1 and DATAL between ]+; + [ to_date(] + Dtos(pdData1) + [,'YYYYMMDD') and to_date(] + Dtos(pdData2) + [,'YYYYMMDD') ] + ; + [order by nume_client, nume_program, datal desc],'crslucCli') + If lnSucces < 0 + Aerror(lAeroare) + Messagebox(lAeroare(3)) + Else + Select crslucCli + If Reccount() = 0 + Messagebox('Nu exista inregistrari pentru selectia facuta',0+16) + ELSE + DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti_special' +*!* Report Form rap_clienti_special To Printer Prompt Preview + Endif + Endif + SQLDisconnect(lcConnect) + Use In (Select("crslucCli")) + +Endproc + +********************* inceput rapoarte_cl_CONTAFIN ****************** +Procedure rapoarte_cl_CONTAFIN + + Local lcConnect, lnSucces,lAeroare + lcConnect = SQLConnect('ROA_CENTRAL','soft','soft') + lnSucces= SQLExec(lcConnect,[select * from luc_vlucrari l where ]+; + [ l.tip_lucrare in (2,3) AND l.VALIDAT=1 and l.id_grup = 1 and l.special = 0 ]+; + [ and DATAL between ]+; + [ to_date(']+Dtos(pdData1)+[','YYYYMMDD') and to_date(']+Dtos(pdData2)+[','YYYYMMDD') ]+ ; + [order by nume_program, DATAL desc ],'crslucCli') + If lnSucces < 0 + Aerror(lAeroare) + Messagebox(lAeroare(3)) + Else + Select crslucCli + If Reccount() = 0 + Messagebox('Nu exista inregistrari pentru selectia facuta',0+16) + ELSE + DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti' +*!* Report Form rap_clienti To Printer Prompt Preview + Endif + Endif + SQLDisconnect(lcConnect) + Use In (Select("crslucCli")) + +Endproc + +********************* inceput rapoarte_cl_ROA *************************** +Procedure rapoarte_cl_ROA + + Local lcConnect, lnSucces,lAeroare + Set Date Dmy + Set Century On + *!* pddata1 = DATE(2007,7,1) + *!* pddata2 = DATE(2007,7,31) + lcConnect = SQLConnect('ROA_CENTRAL','soft','soft') + lnSucces = SQLExec(lcConnect,[select * from luc_vlucrari l where ]+; + [ l.tip_lucrare in (2,3) AND l.VALIDAT=1 and l.id_grup = 11 and l.special = 0 ]+; + [ and DATAL between ]+; + [ to_date(] + Dtos(pdData1) + [,'YYYYMMDD') and to_date(] + Dtos(pdData2)+[,'YYYYMMDD') ]+ ; + [order by nume_program, DATAL desc ],'crslucCli') + + If lnSucces < 0 + Aerror(lAeroare) + Messagebox(lAeroare(3)) + Else + Select crslucCli + If Reccount() = 0 + Messagebox('Nu exista inregistrari pentru selectia facuta',0+16) + ELSE + DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti' +*!* Report Form rap_clienti To Printer Prompt Preview + Endif + Endif + SQLDisconnect(lcConnect) + Use In (Select("crslucCli")) + +Endproc + +***************************** soft_trimis_clienti ************************** +Procedure soft_trimis_cl + + * Select crs_prg_clie + * Report Form rap_inform To Printer Prompt Preview + +Endproc + +PROCEDURE soft_trimis_cl_manual + LOCAL loFrm + loFrm = CREATEOBJECT("frm_raport_versiuni") + loFrm.Show(1) + RELEASE loFrm +ENDPROC +*************************** rapoarte_ultime_modificari +Procedure rapoarte_ultime_modificari + Lparameters tnCustId, tcListaPrograme + + PRIVATE pdDataInitiala, pdDataFinala, pcTitlu + Local lcConnect, lnSucces, lAeroare, lcVersiune, lcSql, x, i, lcLista, lcWhere, lnCustId + * lcVersiune = versiune(crsProgs.versiune) + * lclist = [(] + lnCustId = tnCustId + *!* 30.08.2010 + pcTitlu = PADR('BULETIN INFORMATIV', 100, ' ') + pcTitlu = rbInputBox( "Titlu raport", "Titlu", m.pcTitlu) + + pdDataInitiala = {} + pdDataInitiala = rbInputBox( "Data initiala", "Data", m.pdDataInitiala) + + pdDataFinala = {} + pdDataFinala = rbInputBox( "Data finala", "Data", m.pdDataFinala) + + + lcSql = [select vsc.program,l.versiune,vsc.versiune_maxima,l.explicatie_client, ] + ; + [ vsc.customer_id,vsc.data_plec, vsc.id as id_program ,l.datal, l.titlu, l.localizare ] + ; + [ from vsc_versiune_max_inst_dv vsc ] + ; + [ join luc_lucrari l on l.id_program = vsc.id ] + ; + [ and ] + IIF(EMPTY(m.pdDataInitiala), [trunc(vsc.data_plec)], [?m.pdDataInitiala]) + [ <= trunc(l.datal) ] + ; + IIF(EMPTY(m.pdDataFinala), [], [ and ?m.pdDataFinala >= trunc(l.datal) ]) + ; + [ where vsc.customer_id = ] + ALLTRIM(STR(lncustid)) + ; + IIF(EMPTY(m.pdDataInitiala), [ and vsc.versiune <> vsc.versiune_maxima ], []) + ; + [ and l.explicatie_client is not null ] + ; + [ and l.versiune <> vsc.versiune ] + ; && v 1.0.38 + [ and (L.SPECIAL = 0 OR (L.SPECIAL = 1 AND l.id_client = ] + ALLTRIM(STR(lncustid)) + [)) ] + ; + [ order by 1] + *!* 30.08.2010 ^ + + goExecutor.oexecute(lcSql,"crsTest") + + *!* 25.01.2011 + *!* x = SQLConnect("JCSSERVER","SOFT_SERII","123") + x = SQLConnect(goApp.cHostSerii, goApp.cUsernameSerii, goApp.cPasswordSerii) + If x < 0 + AERROR(laEroare) + MESSAGEBOX(laEroare(3)) + Return + Endif + *!* 25.01.2011 ^ + + + lcSql = [select DISTINCT customer_id, NUME, ID_PROGRAM, (CASE WHEN Upper(PROGRAM) ] + ; + [LIKE 'INDEX%' THEN 'MANUAL' ELSE PROGRAM END) AS PROGRAM from vgen_programe ] + lnSucces = SQLExec(x, lcSql, "crsProgsTemp1") && crsprogstemp1 + * [WHERE ID_CLIENT =]+Transform(lnIdClient)+[ ORDER BY 2, 4] + SQLDisconnect(x) + + * lcwhere =[ WHERE ] + IIF(ALLTRIM(tcListaPrograme)!=[()],[ct.id_program in &tcListaPrograme ],[1=2 ] ) + If Alltrim(tcListaPrograme)!=[()] + lcWhere = [ where cp.id_program in ] + tcListaPrograme + Else + lcWhere = [ where 1=2 ] + Endif + + Select ct.Program As nume_program, ct.explicatie_client, ct.datal, ct.titlu, ; + ct.localizare, ct.versiune, ct.versiune_maxima ; + From crsTest ct; + JOIN crsprogstemp1 cp On cp.customer_id = ct.customer_id And cp.id_program = ct.id_program ; + &lcWhere ; + ORDER By ct.Program, ct.datal Into Cursor crslucCli + + Select Min(datal) As data1, Max(datal) As Data2 From crslucCli Into Cursor crsData + Select crsData + pdData1 = data1 + pdData2 = data2 + Select crslucCli + If Reccount() = 0 + Messagebox('Nu exista inregistrari pentru selectia facuta',0+16) + Else +*!* Report Form rap_clienti To Printer Prompt Preview + DO LISTAREUSERREPORT WITH 'crslucCli', 'FRX', 'rap_clienti' + && tcAlias, tcTipExport, tcRaport, tcLogoPath, tcReportPreviewer, toPreviewerConfig && tcDestinationFile, tlDontOpenFile + Endif + + Release paAles + Use In (Select("crstest")) + Use In (Select("crsprogstemp1")) + Use In (Select("crslucCli")) + +Endproc && rapoarte_ultime_modificari^ + + + + +********************* INCEPUT GetReportPath ********************** +* PROCEDURE GetReportPath ( tcReportName ) +* Date : 04.11.2009 +* author : marius.mutu +* description: intoarce calea CONTAFIN\USERREPORTS +****************************************** +PROCEDURE GetReportPath + Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserRepPath,lcAlias + lcAppPath=Addbs(Justpath(Sys(16,0))) + lcAppName=Allt(Uppe(Juststem(Sys(16,0)))) + liAt=Rat("\",lcAppPath,2) + lcDirgen=Addbs(Left(lcAppPath,liAt-1)) + lcUserRepPath = lcDirgen + 'USERREPORTS\' + If !Directory(lcUserRepPath) + Md (lcUserRepPath) + ENDIF + RETURN lcUserRepPath +ENDPROC + +********************* INCEPUT Get_report_path ********************** +* PROCEDURE Get_report_path( tcReportName ) +* Date : 26.04.2005, 16:22:03 +* author : marius.mutu +* description: intoarce calea raportului (EXE SAU USERREPORTPATH\PROGRAM\FIRMA\USR_RAPORT.FRX daca glFacturiPersonalizate) +****************************************** +Procedure Get_report_path + Lparameters tcReportName + Local lcReportName, llFacturiPersonalizate + + lcReportName = Alltrim(tcReportName) + ".FRX" + + *!* 04.11.2009 + llFacturiPersonalizate = .F. + + IF TYPE('glFacturiPersonalizate') <> 'U' + llFacturiPersonalizate = glFacturiPersonalizate + ENDIF + *!* 04.11.2009 ^ + + If llFacturiPersonalizate + *!* 26.10.2009 +*!* lcFile = GetReportPath() + "USR_" + lcReportName + lcFile = getUserRepPath() + "USR_" + lcReportName + *!* 26.10.2009 ^ + If !File(lcFile) + Use (lcReportName) In 0 Alias UserReport Again Shared + Select UserReport + Copy To (lcFile) + Use In UserReport + Endif + lcReportPath = lcFile + Else + lcReportPath = lcReportName + Endif + + Return lcReportPath + +Endproc +********************* SFARSIT Get_report_path ********************** + + +********************* INCEPUT Modifica_raport_utilizator ********************** +* PROCEDURE Modifica_raport_utilizator( ) +* Date : 26.04.2005, 17:44:33 +* author : marius.mutu +* description: + +Procedure Modifica_raport_utilizator( ) + + Cd (gcUserReports) + lcFile = Getfile("frx","Alegeti un raport","Alege") + If File(lcFile) And Upper(Justext(lcFile)) = "FRX" + Modify Report (lcFile) + Endif + + +Endproc +********************* SFARSIT Modifica_raport_utilizator ********************** + + +*!* PROCEDURI_RAPOARTE.PRG + + +*!* LISTARE RAPORT UTILIZATOR +*!* PARAMETRI : tcAlias - alias-ul cursorului; tcTipExport - FRX/XLS; tcRaport - numele raportului; tcLogoPath - daca pe raport trebuie sa am o imagine logo in acelasi director cu raportul +*!* Se listeaza raportul USR_ din directorul \\SERVER\ROA\USERREPORTS\\\ daca exista +*!* Daca nu exista raporturl USR_ se listeaza raportul default +*!* tcReportPreviewer - procedura pentru preview rapoarte "FoxyPreview" (default gcReportPreviewer) +*!* toPreviewerConfig - obiect PreviewerConfig cu setari pentru tcReportPreviewer +Procedure LISTAREUSERREPORT + Lparameters tcAlias, tcTipExport, tcRaport, tcLogoPath, tcReportPreviewer, toPreviewerConfig && tcDestinationFile, tlDontOpenFile + Local lcEroare, laEroare,llEroare + Dimension laEroare[1,1] + + Local lcSelect, lcRaportPath, lcTipExport, lcLogoPath, lcLogoPathDest, llDeleteRaport, llDeleteLogo + LOCAL lcOldReportPreview, lcOldReportBehaviour + LOCAL loEx + llDeleteRaport = .F. + llDeleteLogo = .F. + + *!* 07.04.2010 + LOCAL lcReportPreviewer + lcReportPreviewer = IIF(EMPTY(tcReportPreviewer), IIF(TYPE('gcReportPreviewer') = 'C', gcReportPreviewer, ""), tcReportPreviewer) + *!* 07.04.2010 ^ + + If Type('tcTipExport') = 'C' + lcTipExport = Upper(Alltrim(tcTipExport)) + Else + If Empty(tcRaport) + lcTipExport = 'XLS' + Else + lcTipExport = 'FRX' + Endif + Endif + If Empty(tcAlias) + Return + Endif + If !Used(tcAlias) + Return + Endif + *!* 26.10.2009 + lcLogoPath = Iif(Type('tcLogoPath') <> 'C' Or Empty(tcLogoPath), getUserRepPath() + 'logo.jpg', tcLogoPath) && USERREPORTS\PROGRAM\FIRMA\LOGO.JPG + If !File(lcLogoPath) + lcLogoPath = GetReportPath() + 'logo.jpg' && USERREPORTS\LOGO.JPG + If !File(lcLogoPath) + lcLogoPath = '' + ENDIF + ENDIF + *!* 26.10.2009 ^ + + Do Case + Case lcTipExport = 'FRX' + + lcRaportPath = getUserRepPath() + [USR_] + Juststem(tcRaport) + [.FRX] && USERREPORTS\PROGRAM\FIRMA\USR_RAPORT.FRX + + *!* 04.11.2009 + IF !FILE(lcRaportPath) + lcRaportPath = GetReportPath() + [USR_] + Juststem(tcRaport) + [.FRX] && USERREPORTS\USR_RAPORT.FRX +*!* Get_report_path(Juststem(tcRaport)) + ENDIF + *!* 04.11.2009 ^ + + If !File(lcRaportPath) + lcRaportPath = tcRaport && raportul din executabil + + If !Empty(lcLogoPath) + ***--- inlocuire logo + + lcRaport = Juststem(tcRaport) + [.FRX] + lcRaportPath = Addbs(gcTempPath) + [USR_] + lcRaport + *!* 07.04.2010 + lcLogoPathDest = Addbs(gcTempPath) + JUSTFNAME(lcLogoPath) && "logo.jpg" + *!* 07.04.2010 ^ + + If Used(Juststem(lcRaportPath)) + Use In (Select(Juststem(lcRaportPath))) + Endif + + Use (lcRaport) In 0 Alias rapFactura + Select rapFactura + Copy To (lcRaportPath) + Use In (Select('rapFactura')) + Use In Select(Juststem(lcRaport)) + + + Copy File (lcLogoPath) To (lcLogoPathDest) + llDeleteRaport = .T. + llDeleteLogo = .T. + Endif + ***--- + + Endif + + lcSelect = Select() + If !Empty(tcAlias) And Used(tcAlias) + Select (tcAlias) + Endif + lcError = On('error') + llEroare = .F. + On Error llEroare = .T. + Do While .T. + *!* 07.04.2010 + DO CASE + CASE EMPTY(lcReportPreviewer) + Report Form (lcRaportPath) To Printer Prompt Preview + CASE VERSION(5) < 800 + Report Form (lcRaportPath) To Printer Prompt Preview + OTHERWISE + TRY + lcOldReportBehaviour = SET("ReportBehavior") + DO &lcReportPreviewer WITH lcRaportPath, toPreviewerConfig && tcDestinationFile, tlDontOpenFile + SET REPORTBEHAVIOR &lcOldReportBehaviour + CATCH TO loEx + MESSAGEBOX('Eroare: ' + loEx.Message + CRLF + 'Procedura: ' + loEx.Procedure + CRLF + 'Cod: ' + loEx.LineContents + CRLF + 'Linia nr: ' + TRANSFORM(loEx.LineNo), 0+32, _screen.Caption) +* llEroare = .F. + Report Form (lcRaportPath) To Printer Prompt Preview + ENDTRY + ENDCASE + *!* 07.04.2010 ^ + If llEroare + Aerror(laEroare) + If laEroare[1] = 1958 + lnRaspuns = Messagebox("Eroare la driverul imprimantei.Doriti sa reincercati listarea?",4+32+256,"Confirmare relistare") + If lnRaspuns <> 6 + Exit + Else + llEroare = .F. + Endif + Else + Messagebox(laEroare[2] + [ ] + Alltrim(Str(laEroare[1])) + [ ] + ALLTRIM(TRANSFORM(laEroare(3)))) + Exit + Endif + Else + Exit + Endif + Enddo + On Error &lcError + + Select (lcSelect) + + Case lcTipExport = 'XLS' + export_xls(tcAlias) + Endcase + If llDeleteRaport And File(lcRaportPath) + Delete File FORCEEXT(lcRaportPath,'*') + Endif + If llDeleteLogo And File(lcLogoPathDest) + Delete File (lcLogoPathDest) + Endif + Release lcEroare, laEroare,llEroare + + +Endproc && LISTAREUSERREPORT + +********************* INCEPUT Modifica_raport_utilizator ********************** +* PROCEDURE Modifica_raport_utilizator +* Date : 26.07.2006, 17:44:33 +* author : marius.mutu +Procedure Modifica_raport_utilizator + + lcUserRepPath = getUserRepPath() + Cd (lcUserRepPath) + lcFile = Getfile("frx","Alegeti un raport","Alege") + If File(lcFile) And Upper(Justext(lcFile)) = "FRX" + Modify Report (lcFile) + Endif + +Endproc && Modifica_raport_utilizator +********************* SFARSIT Modifica_raport_utilizator ********************** + +*!* INTOARCE DIRECTORUL CU RAPOARTE UTILIZATOR PENTRU APLICATIA, SCHEMA CURENTA +Function getUserRepPath + Local lcAppPath, lcAppName, liAt, lcDirgen, lcUserRepPath,lcAlias + *!* 07.04.2010 + IF TYPE('gcAppPath') = 'C' + lcAppPath = gcAppPath + ELSE + lcAppPath=Addbs(Justpath(Sys(16,0))) + lcAppPath = STRTRAN(lcAppPath,'PROGRAME\','') + ENDIF + IF TYPE('gcAppName') = 'C' + lcAppName = gcAppName + ELSE + lcAppName = Allt(Uppe(Juststem(Sys(16,0)))) + ENDIF + *!* 07.04.2010 ^ + liAt=Rat("\",lcAppPath,2) + lcDirgen=Addbs(Left(lcAppPath,liAt-1)) + lcUserRepPath = lcDirgen + 'USERREPORTS\' + If !Directory(lcUserRepPath) + Md (lcUserRepPath) + Endif + lcUserRepPath = lcUserRepPath + lcAppName + '\' + If !Directory(lcUserRepPath) + Md (lcUserRepPath) + Endif + + lcUserRepPath = lcUserRepPath + IIF(TYPE('nfscurt') = 'C', ALLTRIM(m.nfscurt) + '\', '') + If !Directory(lcUserRepPath) + Md (lcUserRepPath) + Endif + Return lcUserRepPath + +Endfunc + +**************************************************************************** +*!* extrage frx din executabil pe disc in directorul USERREPORTS +Procedure UserReport2File + Lparameters tcRaport + + Local lcRaport, lcFile + If Empty(tcRaport) + lcRaport= Inputbox("Raport","Scrieti numele raportului","raport.frx") + Else + lcRaport = tcRaport + Endif + + If Empty(lcRaport) + Return + Endif + + lcRaport = Juststem(lcRaport) + '.frx' + lcFile = getUserRepPath() + "USR_" + lcRaport + If File(lcFile) + Return + Endif + + *!* TRY + *!* USE (lcRaport) IN 0 again SHARED ALIAS crsRaportTemp + *!* ENDTRY + + If !File(lcRaport) + Messagebox('Nu exista raportul ' + lcRaport) + Else + Use (lcRaport) In 0 Again Shared Alias crsRaportTemp + Select crsRaportTemp + Copy To (lcFile) + Use In crsRaportTemp + Endif + +Endproc && UserReport2File + +*!* INTOARCE CALEA COMPLETA A RAPORTULUI UTILIZATOR USR_.FRX, DACA EXISTA, ALTFEL, +FUNCTION getUserRepFile + LPARAMETERS tcRaport + LOCAL lcRaportFile + + lcRaportFile = getUserRepPath() + [USR_] + Juststem(tcRaport) + [.FRX] && USERREPORTS\PROGRAM\FIRMA\USR_RAPORT.FRX + IF !FILE(lcRaportFile) + lcRaportFile = Juststem(tcRaport) + [.FRX] && RAPORTUL IN EXECUTABIL + ENDIF + + RETURN lcRaportFile +ENDFUNC && getUserRepFile + +*!* Previewer rapoarte - foloseste gcReportPreviewerPath / gcAppPath pentru localizarea FoxyPreviewer.App +Procedure FoxyPreview + Lparameters tcRaport, toPreviewerConfig && tcDestinationFile, tlDontOpenFile + Local lcRaport, lcFoxyPath, lcComunContafinPath + LOCAL llOpenDestinationFile + llOpenDestinationFile = .T. + + IF TYPE('toPreviewerConfig') <> 'O' + toPreviewerConfig = CREATEOBJECT("PreviewerConfig") + ENDIF + + lcRaport = Forceext(tcRaport, 'frx') + lcFoxyPath = IIF(TYPE('gcReportPreviewerPath') = 'C', ADDBS(gcReportPreviewerPath) + "FoxyPreviewer.App", "FoxyPreviewer.App") + IF !FILE(lcFoxyPath) + lcComunContafinPath = LEFT(ADDBS(gcAppPath), RAT('\',ADDBS(gcAppPath),2)) + 'COMUNCONTAFIN\' + lcFoxyPath = lcComunContafinPath + "FoxyPreviewer.App" + IF !FILE(lcFoxyPath) + lcFoxyPath = ADDBS(GETFILE("app","FoxyPreviewer.App","Open",0,"Alegeti locatia COMUNCONTAFIN\FoxyPreviewer.App")) + ENDIF + ENDIF + + IF EMPTY(NVL(lcFoxyPath,'')) + Report Form (tcRaport) To Printer Prompt Preview + RETURN + ENDIF + + If !'FOXYPREVIEWER'$Upper(Set("Procedure")) + Set Procedure To (lcFoxyPath) Additive + Endif + + If Empty(Justpath(m.lcRaport)) && raporte in executabil - trebuie create pe disc + Local loReport As "FoxyPreviewerCaller" && Of "FoxyPreviewerCaller.Prg" + loReport = Createobject("FoxyPreviewerCaller") + Else && rapoarte pe disc + Local loReport As "PreviewHelper" Of "FoxyPreviewer.App" + loReport = Createobject("PreviewHelper") + ENDIF + + IF TYPE('loReport') <> 'O' + Report Form (tcRaport) To Printer Prompt Preview + RETURN + ENDIF + + With loReport As ReportHelper + .AddReport(m.lcRaport, toPreviewerConfig.GetValue("cClauses")) + + ********************************************** + * Optional available parameters + ********************************************** + .cTitle = toPreviewerConfig.GetValue("cTitle") + .cDestFile = toPreviewerConfig.GetValue("cDestFile") && destination file - if not empty then save without preview + + .lSendToEmail = toPreviewerConfig.GetValue("lSendToEmail") && adds the send to email button + + .lSaveToFile = toPreviewerConfig.GetValue("lSaveToFile") && adds the save to file button + .lSaveAsImage = toPreviewerConfig.GetValue("lSaveAsImage") + .lSaveAsHTML = toPreviewerConfig.GetValue("lSaveAsHTML") + .lSaveAsRTF = toPreviewerConfig.GetValue("lSaveAsRTF") + .lSaveAsXLS = toPreviewerConfig.GetValue("lSaveAsXLS") + .lSaveAsPDF = toPreviewerConfig.GetValue("lSaveAsPDF") + + .lShowCopies = toPreviewerConfig.GetValue("lShowCopies") && shows the copies spinner + .lShowMiniatures = toPreviewerConfig.GetValue("lShowMiniatures") && shows the miniatures page + .nCopies = toPreviewerConfig.GetValue("nCopies") && The quantity of copies to be printed + .lPrintVisible = toPreviewerConfig.GetValue("lPrintVisible") && shows the print button in the toolbar + .cDefaultListener = toPreviewerConfig.GetValue("cDefaultListener") + + .nCanvasCount = toPreviewerConfig.GetValue("nCanvasCount") && initial nr of pages rendered on the preview form. + *!* && Valid values are 1 (default), 2, or 4. + + .nZoomLevel = toPreviewerConfig.GetValue("nZoomLevel") && initial zoom level of the preview window. Possible values are: + *!* && 1-10%, 2-25%, 3-50%, 4-75%, 5-100% default, 6-150% ; + *!* && 7-200%, 8-300%, 9-500%, 10-whole page + + .lPDFasImage = toPreviewerConfig.GetValue("lPDFasImage") + + .lPrinterPref = toPreviewerConfig.GetValue("lPrinterPref") + + .oListener = toPreviewerConfig.GetValue("oListener") + .cPrinterName = toPreviewerConfig.GetValue("cPrinterName") + + .nWindowState = toPreviewerConfig.GetValue("nWindowState") + .nDockType = toPreviewerConfig.GetValue("nDockType") + + .cFormIcon = toPreviewerConfig.GetValue("cFormIcon") + + .lEmailAuto = toPreviewerConfig.GetValue("lEmailAuto") + .cEmailType = toPreviewerConfig.GetValue("cEmailType") + .lEmailed = toPreviewerConfig.GetValue("lEmailed") + .cCodePage = toPreviewerConfig.GetValue("cCodePage") + + ********************************************** + loReport.RunReport() + + llOpenDestinationFile = toPreviewerConfig.GetValue("lOpenDestFile") && automatically open the destination file after save + + IF m.llOpenDestinationFile + Do Case + Case .lPrinted + *!* Messagebox("Report was printed !",64, "Report status") + Case loReport.lSaved + Messagebox("Raportul a fost salvat ca fisier: " + Chr(13) + .cDestFile, 64, _Screen.Caption) + =OPEN_DEFAULT_APP(.cDestFile) + + *!* Otherwise + *!* Messagebox("Report Preview was closed without saving or printing",48, "Report status") + + ENDCASE + ENDIF + + Endwith + +Endproc && FoxyPreview + + +*!* clasa pentru preview frx din executabil - le salveaza pe disc si apoi le previzualizeaza +DEFINE CLASS FoxyPreviewerCaller AS Custom + cPrinterName = SET("Printer",3) + + lSaveToFile = .T. && adds the save to file button + lSendToEmail = .T. && adds the send to email button + lPrintVisible = .T. && shows the print button in the toolbar + lShowCopies = .T. && shows the copies spinner + lShowMiniatures = .T. && shows the miniatures page + lPrinterPref = .T. && shows the printer preferences button + + * Output types allowed in the "Save as.." button from the toolbar + lSaveAsImage = .T. + lSaveAsHTML = .T. + lSaveAsRTF = .T. + lSaveAsXLS = .T. + lSaveAsPDF = .T. + + nPageTotal = 0 && Total pages of the current report + nCopies = 1 && The quantity of copies to be printed + cTitle = "" && The preview window title + oListener = NULL + cDefaultListener = "FXLISTENER" + nCanvasCount = 1 && initial nr of pages rendered on the preview form. + && Valid values are 1 (default), 2, or 4. + + nZoomLevel = 5 && initial zoom level of the preview window. Possible values are: + && 1-10%, 2-25%, 3-50%, 4-75%, 5-100% default, 6-150% ; + && 7-200%, 8-300%, 9-500%, 10-whole page + + lExtended = .T. && Flag that tells if the report is being run automatically + && using the _REPORTPERVIEW global variable + + nWindowState = 0 && Normal + nDockType = .F. + + cDestFile = "" && the destination file (image, htm, pdf, etc) + lPrinted = .F. && knows if the user printed the report + lSaved = .F. && knows if the user saved the report to a file + + cFormIcon = "" && "wwrite.ico" + lEmailAuto = .T. + cEmailType = "PDF" + lEmailed = .F. + cCodePage = "CP1252" && CodePage, to be used by PDF Listener + + lPDFasImage = .F. + + * Internal use properties + _oReports = "" && Internal use, collection that contains the report names to be used + _oClauses = "" + + +PROCEDURE AddReport(tcReport, tcClauses) +* populates a collection object with the report files and clauses +* This method can be called many times, providing an easy way to merge reports. + + LOCAL lcReport, lcTempDir, lcFile + lcTempDir = ADDBS(GETENV("TEMP")) + + * Retrieve the FRX and FRT files from the EXE + lcFile = lcTempDir + "TMP_FP_" + SYS(2015) + "." + + IF EMPTY(SYS(2000, tcReport)) + STRTOFILE(FILETOSTR(FORCEEXT(tcReport,"FRX")), lcFile + "FRX") + STRTOFILE(FILETOSTR(FORCEEXT(tcReport,"FRT")), lcFile + "FRT") + ELSE + lcFile = tcReport + ENDIF + + IF VARTYPE(This._oReports) <> "O" + This._oReports = CREATEOBJECT("Collection") + This._oClauses = CREATEOBJECT("Collection") + ENDIF + This._oReports.Add(FORCEEXT(lcFile, "FRX")) + This._oClauses.Add(EVL(tcClauses,"")) +ENDPROC + + +PROCEDURE RunReport + LOCAL lcFoxyPath, lcComunContafinPath + + If !'FOXYPREVIEWER'$Upper(Set("Procedure")) + lcFoxyPath = IIF(TYPE('gcReportPreviewerPath') = 'C', ADDBS(gcReportPreviewerPath) + "FoxyPreviewer.App", "FoxyPreviewer.App") + IF !FILE(lcFoxyPath) + lcComunContafinPath = LEFT(ADDBS(gcAppPath), RAT('\',ADDBS(gcAppPath),2)) + 'COMUNCONTAFIN\' + lcFoxyPath = lcComunContafinPath + "FoxyPreviewer.App" + IF !FILE(lcFoxyPath) + lcFoxyPath = ADDBS(GETFILE("app","FoxyPreviewer.App","Open",0,"Alegeti locatia COMUNCONTAFIN\FoxyPreviewer.App")) + ENDIF + ENDIF + IF EMPTY(NVL(lcFoxyPath,'')) + Report Form (tcRaport) To Printer Prompt Preview + RETURN + ENDIF + + Set Procedure To (lcFoxyPath) Additive + ENDIF + + + LOCAL loReport as "PreviewHelper" OF "FoxyPreviewer.App" + loReport = CREATEOBJECT("PreviewHelper") + + WITH loReport + + LOCAL n, lnCount + lnCount = This._oReports.Count + FOR n = 1 TO lnCount + loReport.AddReport(This._oReports(n), This._oClauses(n)) + ENDFOR + + .cTitle = This.cTitle + .lSendToEmail = This.lSendToEmail + .lSaveToFile = This.lSaveToFile + .lShowCopies = This.lShowCopies + .lShowMiniatures = This.lShowMiniatures + .lPrintVisible = This.lPrintVisible + .lPrinterPref = This.lPrinterPref + + .nCopies = This.nCopies + .lPrintVisible = This.lPrintVisible + .cDefaultListener = This.cDefaultListener + .nCanvasCount = This.nCanvasCount + .nZoomLevel = This.nZoomLevel + .oListener = This.oListener + .cPrinterName = This.cPrinterName + + .lSaveAsImage = This.lSaveAsImage + .lSaveAsHTML = This.lSaveAsHTML + .lSaveAsRTF = This.lSaveAsRTF + .lSaveAsXLS = This.lSaveAsXLS + .lSaveAsPDF = This.lSaveAsPDF + + .nWindowState = This.nWindowState + .nDockType = This.nDockType + .cDestFile = This.cDestFile + + IF NOT EMPTY(This.cFormIcon) + .cFormIcon = This.cFormIcon + ENDIF + + .lEmailAuto = This.lEmailAuto + .cEmailType = This.cEmailType + .lEmailed = This.lEmailed + .cCodePage = This.cCodePage + + .lPDFasImage = This.lPDFasImage + ENDWITH + + loReport.RunReport(This) && This flag will tell FoxyPreviewer that it has a caller object in an EXE + && The main class will update the properties "lSaved" and "lPrinted" + +ENDPROC + +PROCEDURE Destroy + * Clean up, delete the temporary FRX files + LOCAL n, lnCount, lcFile + lnCount = This._oReports.Count + FOR n = 1 TO lnCount + lcFile = This._oReports(n) + IF LEFT(JUSTFNAME(lcFile),7) = "TMP_FP_" && We have a temp FRX file to delete + TRY + DELETE FILE (lcFile) + DELETE FILE FORCEEXT(lcFile, "FRT") + CATCH + ENDTRY + ENDIF + ENDFOR +ENDPROC + +ENDDEFINE + +DEFINE CLASS PreviewerConfig as Custom + cPrinterName = SET("Printer",3) + + lSaveToFile = .T. && adds the save to file button + lSendToEmail = .T. && adds the send to email button + lPrintVisible = .T. && shows the print button in the toolbar + lShowCopies = .T. && shows the copies spinner + lShowMiniatures = .T. && shows the miniatures page + lPrinterPref = .T. && shows the printer preferences button + + * Output types allowed in the "Save as.." button from the toolbar + lSaveAsImage = .T. + lSaveAsHTML = .T. + lSaveAsRTF = .T. + lSaveAsXLS = .T. + lSaveAsPDF = .T. + + nPageTotal = 0 && Total pages of the current report + nCopies = 1 && The quantity of copies to be printed + cTitle = "" && The preview window title + oListener = NULL + cDefaultListener = "FXLISTENER" + nCanvasCount = 1 && initial nr of pages rendered on the preview form. + && Valid values are 1 (default), 2, or 4. + + nZoomLevel = 5 && initial zoom level of the preview window. Possible values are: + && 1-10%, 2-25%, 3-50%, 4-75%, 5-100% default, 6-150% ; + && 7-200%, 8-300%, 9-500%, 10-whole page + + lExtended = .T. && Flag that tells if the report is being run automatically + && using the _REPORTPERVIEW global variable + + nWindowState = 0 && Normal + nDockType = .F. + + cDestFile = "" && the destination file (image, htm, pdf, etc) + lOpenDestFile = .T. && automatically open the destination file after save +*!* lPrinted = .F. && knows if the user printed the report +*!* lSaved = .F. && knows if the user saved the report to a file + + cFormIcon = "" && "wwrite.ico" + lEmailAuto = .T. + cEmailType = "PDF" +*!* lEmailed = .F. + cCodePage = "CP1252" && CodePage, to be used by PDF Listener + + lPDFasImage = .F. && save PDF as image + cClauses = "" + + + + PROCEDURE Init + * + ENDPROC && Init + +*!* Seteaza valoarea unei proprietati daca exista sau adauga proprietatea, si intoarce valoarea + Procedure SetValue + Lparameters tcProperty, tuValue + + If Type('THIS.&tcProperty') <> 'U' + This.&tcProperty = tuValue + Else + This.AddProperty(tcProperty, tuValue) + Endif + + Return This.&tcProperty + + Endproc && SetValue + +*!* Intoarce valoarea unei proprietati daca exista, altfel valoarea empty() corespunzator tipului proprietatii + Function GetValue + Lparameters tcProperty + + Local lcProperty, luValue + lcProperty = 'THIS.' + tcProperty + + If Type('THIS.&tcProperty') <> 'U' + luValue = This.&tcProperty + Else + luValue = This.GetDefaultValue(tcProperty) + Endif + Return luValue + + Endfunc && GetValue + +*!* Intoarce valoarea empty() a unei proprietati dupa tip = prima litera din numele proprietatii daca nu primeste decat tcProperty +*!* Converteste tcValue la tipul variabilei tcProperty daca tcValue e primit ca parametru + Function GetDefaultValue + Lparameters tcProperty, tcValue + + Local lcType, luValue + luValue = "" + lcType = Upper(Left(tcProperty,1)) + llEmptyValue = Iif(Pcount() = 1, .T., .F.) + + Do Case + Case lcType $ "CM" + luValue = Iif(llEmptyValue, '', tcValue) + Case lcType $ "NIF" + luValue = Iif(llEmptyValue, 0, Val(tcValue)) + Case lcType = "T" + luValue = Iif(llEmptyValue, Dtot({}), Ctot(tcValue)) + Case lcType = "D" + luValue = Iif(llEmptyValue, {}, Ctod(tcValue)) + Case lcType = "L" + luValue = Iif(llEmptyValue, .F., Iif(tcValue = "1" Or Upper(tcValue) = "T" Or Upper(tcValue) = '.T.' Or Upper(tcValue) = 'YES', .T., .F.)) + Otherwise + luValue = "" + Endcase + + Return luValue + Endfunc && GetDefaultValue + +*!* Intoarce .T. daca exista proprietatea + Function HasProperty + Lparameters tcProperty + + Local lcProperty, llReturn + lcProperty = 'THIS.' + tcProperty + llReturn = .F. + + If Type('THIS.&tcProperty') <> 'U' + llReturn = .T. + Endif + + Return llReturn + + Endfunc && HasProperty +ENDDEFINE && PreviewerConfig \ No newline at end of file diff --git a/programe/rbinputbox.prg b/programe/rbinputbox.prg new file mode 100644 index 0000000..9b18ef2 --- /dev/null +++ b/programe/rbinputbox.prg @@ -0,0 +1,279 @@ +*-------------------------------------------------------- +* Function Name.: rbInputBox() +* +* Author........: Rick Borup +* Information Technology Associates +* Champaign, IL U.S.A. +* http://www.ita-software.com +* rborup@ita-software.com +* +* Date Written..: March 20, 2000 +* +* Date Released.: April 27, 2000 +* +* Date Revised..: January 30, 2003 +* +* Abstract......: A simple, general-purpose input box for Visual FoxPro. +* +* Parameters....: (All parameters are optional.) +* +* tcPrompt - the prompt that the user sees. +* The default is "Enter the value". +* +* tcTitle - the title for the form. +* The default is "InputBox". +* +* txDefaultValue - default value. +* This parameter can be a character, date, numeric, or +* currency data type. If this parameter is omitted, an +* empty textbox is displayed and the data type is character. +* The data type of the return value is the same as the +* data type of the default value. +* +* tnLeft - the form's Left position +* +* tnTop - the form's Top position. +* +* If Left and Top are omitted or are not numeric, rbInputBox() +* is auto-centered. +* +* tcFormat - a value for the Format property of the textbox +* +* tcInputMask - a value for the InputMask property of the textbox +* +* tcPasswordChar - a value for the textbox's PasswordChar value +* (the default is blank) +* +* Returns.......: Character, Date, Numeric, or Currency depending +* on the data type of the default value +* +* If the Cancel button is chosen, rbInputBox() returns +* an empty value of the appropriate data type. +* +* Copyright.....: Copyright (c) Information Technology Associates, 2000-2003 +* +* License.......: rbInputBox() is freeware. You may include rbInputBox() +* royalty-free inside a compiled Visual FoxPro APP or EXE +* that you create for your own use or for distribution to +* a third party. +* +* You may redistribute the rbInputBox() distribution +* package, INPUTBOX.ZIP, as long as (a) you distribute +* INPUTBOX.ZIP in its entirety and without modifications, +* and (b) you do not charge anything for it. +* +* Warranty......: NONE. This code is released AS IS without warranty +* of any kind. The user assumes all responsibility and +* liability for its use. +* +* Support.......: NONE, but your comments and suggestions for improvements +* are welcome. Please e-mail rborup@ita-software.com or +* reach me via the Universal Thread at +* http://www.universalthread.com. +* +* Release History:January 30, 2003 - Renamed as "rbInputBox" to avoid conflict +* with the native InputBox() function in +* VFP 7.0 and later. +* - Added tcPasswordChar as 8th parameter +* +* May 2, 2000 - Corrected errata in the readme.txt file. +* +* April 27, 2000 - Original Release +* +* Known Limitations: +* The original release of rbInputBox does not automatically +* resize the form or any of its controls. The current +* sizes are designed to be adequate for most simple input +* functions. There is no arbitrary limitations, other than +* VFP's own inherent limitations, on the size of the return +* value. However, long titles, prompts, or entered values may +* appear truncated on the form. +* +FUNCTION rbInputBox +lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ; + tcFormat, tcInputMask, tcPasswordChar +private pcReturnValue +pcReturnValue = txDefaultValue +local oInputBox +oInputBox = CreateObject("rbInputBox", tcPrompt, tcTitle, ; + txDefaultValue, tnLeft, tnTop, ; + tcFormat, tcInputMask, tcPasswordChar) +oInputBox.Show() +RETURN pcReturnValue + + +************************************************** +*-- Class: rbinputbox +*-- ParentClass: form +*-- BaseClass: form +*-- Time Stamp: 01/29/03 01:03:14 PM +* +DEFINE CLASS rbinputbox AS form + + + Height = 113 + Width = 318 + DoCreate = .T. + AutoCenter = .T. + Caption = "Input Box" + ControlBox = .F. + WindowType = 1 + Name = "frmInputBox" + + *-- empty value to return if Cancel is chosen; data type depends on data type of txValueIn + xemptyvalue = .F. + + *-- the default value (if any) + xdefaultvalue = .F. + + *-- the return value + xreturnvalue = .F. + + + ADD OBJECT lblinputbox AS label WITH ; + FontName = "Arial", ; + FontSize = 9, ; + Alignment = 1, ; + Caption = "Enter the value", ; + Height = 20, ; + Left = 6, ; + Top = 26, ; + Width = 190, ; + TabIndex = 1, ; + Name = "lblInputBox" + + + ADD OBJECT txtinputbox AS textbox WITH ; + FontName = "Arial", ; + FontSize = 9, ; + Century = 1, ; + Height = 24, ; + Left = 202, ; + SelectOnEntry = .T., ; + TabIndex = 2, ; + Top = 22, ; + Width = 110, ; + Name = "txtInputBox" + + + ADD OBJECT cmdok AS commandbutton WITH ; + Top = 72, ; + Left = 84, ; + Height = 24, ; + Width = 72, ; + Caption = "OK", ; + Default = .T., ; + TabIndex = 3, ; + Name = "cmdOK" + + + ADD OBJECT cmdcancel AS commandbutton WITH ; + Top = 72, ; + Left = 172, ; + Height = 24, ; + Width = 72, ; + Cancel = .T., ; + Caption = "Cancel", ; + TabIndex = 4, ; + Name = "cmdCancel" + + + PROCEDURE Unload + with thisform + if type(".xReturnValue") = "C" + .xReturnValue = RTRIM( .xReturnValue) + endif + pcReturnValue = .xReturnValue + endwith + ENDPROC + + + PROCEDURE Init + lparameters tcPrompt, tcTitle, txDefaultValue, tnLeft, tnTop, ; + tcFormat, tcInputMask, tcPasswordChar + if type("tcPrompt") <> "C" + tcPrompt = "Enter the value" + endif + if type("tcTitle") <> "C" + tcTitle = "Input Box" + endif + if !( type("txDefaultValue") $ "CDNY") + * Valid input data types are C, D, N, and Y + txDefaultValue = "" && default to character data type + endif + if type("tcFormat") <> "C" + tcFormat = "" + endif + if type("tcInputMask") <> "C" + tcInputMask = "" + endif + if type("tcPasswordChar") <> "C" + tcPasswordChar = "" + endif + if len( alltrim( tcPasswordChar)) > 1 + tcPasswordChar = left( tcPasswordChar, 1) + endif + local llAutoCenter + if pcount() < 5 && Top and Left parameters were not passed + tnLeft = 0 + tnTop = 0 + else && Top and left parameters were passed but may not be numeric + if type("tnTop") = "N" and type("tnLeft") = "N" && both are numeric + llAutoCenter = .F. + else && one or both is not numeric, so AutoCenter the form + tnLeft = 0 + tnTop = 0 + llAutoCenter = .T. + endif + endif + + with thisform + .lblInputBox.caption = ALLTRIM( tcPrompt) + .caption = ALLTRIM( tcTitle) + .xDefaultValue = txDefaultValue + .xReturnValue = .xDefaultValue + .txtInputBox.value = .xDefaultValue + .txtInputBox.format = ALLTRIM( tcFormat) + .txtInputBox.InputMask = ALLTRIM( tcInputMask) + .txtInputBox.PasswordChar = tcPasswordChar + .Top = tnTop + .Left = tnLeft + .AutoCenter = llAutoCenter && Set AutoCenter last so it overrides Top and Left if .T. + + do case + case type("txDefaultValue") = "D" + .xEmptyValue = {} + case type("txDefaultValue") = "N" + .xEmptyValue = 0 + case type("txDefaultValue") = "Y" + .xEmptyValue = $0 + otherwise + .xEmptyValue = "" + endcase + endwith + ENDPROC + + + PROCEDURE cmdok.Click + with thisform + .xReturnValue = .txtInputBox.value + .release() + endwith + ENDPROC + + + PROCEDURE cmdcancel.Click + * + * If Cancel was chosen, return the empty value of the correct data type. + * + with thisform + .xReturnValue = .xEmptyValue + .release() + endwith + ENDPROC + + +ENDDEFINE +* +*-- EndDefine: rbinputbox +************************************************** diff --git a/programe/regex.prg b/programe/regex.prg new file mode 100644 index 0000000..1b61645 --- /dev/null +++ b/programe/regex.prg @@ -0,0 +1,160 @@ +*!* CLEAR +*!* ?strtranx([ana are 1234567890.1234 lei], [\s\d+\.\d\s], [=TRANSFORM($1, "999 999 999 999.99")]) +*?strtranx([ana are <<1234567890.1234>> lei], [<<], [=TRANSFORM($1, "AA")]) +*!* RETURN + +*-- http://www.cornerstonenw.com/article_id_parsing3.htm + +*-- count words +? OccursRegExp("\b(\w+)\b", [the then quick quick brown fox fox]) +&& prints 7 + +*-- count repeatedwords +? OccursRegExp("\b(\w+)\s\1\b", [the then quick quick brown fox fox]) +&& prints 2 + + +*-- replace first and second lower-case "a" +? strtranx([Abracadabra],[a],[*],1,2) +&& prints Abr*c*dabra + +*-- replace first and second "a" case-insensitive +? strtranx([Abracadabra],[a],[*],1,2,1) +&& prints *br*cadabra + +*-- locate the replacement targets +? strtranx([Abracadabra],[^a|a$],[*],1,2,0) +&& Abracadabr* +? strtranx([Abracadabra],[^a|a$],[*],1,2,1) +&& *bracadabr* + + +lcText = "The cost, is $123,345.75. " +*-- convert the commas +lcText = strtranx( m.lcText, "(\d{1,3})\,(\d{1,}) ","$1 $2" ) + +*-- convert the decimals +? strtranx( m.lcText, "(\d{1,3})\.(\d{1,})", "$1,$2" ) + +** prints "The cost, is $123 345,75." + +*-- add 1 to all digits +? strtranx( [ABC123], "(\d)", [=TRANSFORM(VAL($1)+1)] ) +** prints "ABC234" + +*-- convert all dates to long format +? strtranx( [the date is: 7/18/2004 ] , [(\d{1,2}/\d{1,2}/\d{4})], [=TRANSFORM(CTOD($1),"@YL")]) +** prints "the date is: Sunday, July 18, 2004" + +*---------------------------------------------------------- +FUNCTION StrtranRegExp( tcSourceString, tcPattern, tcReplace ) + LOCAL loRE + loRE = CREATEOBJECT("vbscript.regexp") + WITH loRE + .PATTERN = tcPattern + .GLOBAL = .T. + .multiline = .T. + RETURN .REPLACE( tcSourceString , tcReplace ) + ENDWITH +ENDFUNC + +*---------------------------------------------------------- +FUNCTION OccursRegExp(tcPattern, tcText) + LOCAL loRE, loMatches, lnResult + loRE = CREATEOBJECT("vbscript.regexp") + WITH loRE + .PATTERN = m.tcPattern + .GLOBAL = .T. + .multiline = .T. + loMatches = loRE.Execute( m.tcText ) + lnResult = loMatches.COUNT + loMatches = NULL + ENDWITH + RETURN m.lnResult +ENDFUNC + + + +*---------------------------------------------------------- +FUNCTION strtranx(tcSearched, ; + tcSearchFor, ; + tcReplacement, ; + tnStart, tnNumber, ; + tnFlag ) + + *-- the final version of the UDF + LOCAL loRE, lcText, lnShift, lcCommand,; + loMatch, loMatches, lnI, lnK, lcSubMatch,; + llevaluate, lcMatchDelim, lcReplaceText, lcReplacement,; + lnStart, lnNumber, loCol, lcKey + + loRE = CREATEOBJECT("vbscript.regexp") + + WITH loRE + .PATTERN = m.tcSearchFor + .GLOBAL = .T. + .multiline = .T. + .ignorecase = IIF(VARTYPE(m.tnFlag)=[N],m.tnFlag = 1,.F.) + ENDWITH + + lcReplacement = m.tcReplacement + + *--- are we evaluating? + IF m.lcReplacement = [=] + llevaluate = .T. + lcReplacement = SUBSTR( m.lcReplacement, 2 ) + ENDIF + + IF VARTYPE( m.tnStart )=[N] + lnStart = m.tnStart + ELSE + lnStart = 1 + ENDIF + + IF VARTYPE( m.tnNumber) =[N] + lnNumber = m.tnNumber + ELSE + lnNumber = -1 + ENDIF + + IF m.lnStart>1 OR m.lnNumber#-1 OR m.llevaluate + + lcText = m.tcSearched + lnShift = 1 + loMatches = loRE.execute( m.lcText ) + loCol = CREATEOBJECT([collection]) + lnNumber = IIF( lnNumber=-1,loMatches.COUNT,MIN(lnNumber,loMatches.COUNT)) + + FOR lnK = m.lnStart TO m.lnNumber + loMatch = loMatches.ITEM(m.lnK-1) && zero based + lcCommand = m.lcReplacement + FOR lnI= 1 TO loMatch.submatches.COUNT + lcSubMatch = loMatch.submatches(m.lnI-1) && zero based + IF m.llevaluate + * "escape" the string we are about to use in an evaluation. + * it is important to escape due to possible delim chars (like ", ' etc) + * malicious content, or VFP line-length violations. + lcKey = ALLTRIM(TRANSFORM(m.lnK)+[_]+TRANSFORM(m.lnI)) + loCol.ADD( m.lcSubMatch, m.lcKey ) + lcSubMatch = [loCol.item(']+m.lcKey+[')] + ENDIF + lcCommand = STRTRAN( m.lcCommand, "$" + ALLTRIM( STR( m.lnI ) ) , m.lcSubMatch) + ENDFOR + + IF m.llevaluate + TRY + lcReplaceText = EVALUATE( m.lcCommand ) + CATCH TO loErr + lcReplaceText="[[ERROR #"+TRANSFORM(loErr.ERRORNO)+[ ]+loErr.MESSAGE+"]]" + ENDTRY + ELSE + lcReplaceText = m.lcCommand + ENDIF + lcText = STUFF( m.lcText, loMatch.FirstIndex + m.lnShift, m.loMatch.LENGTH, m.lcReplaceText ) + lnShift = m.lnShift + LEN( m.lcReplaceText ) - m.loMatch.LENGTH + ENDFOR + ELSE + lcText = loRE.REPLACE( m.tcSearched, m.tcReplacement ) + ENDIF + RETURN m.lcText +ENDFUNC \ No newline at end of file diff --git a/programe/testmerge.prg b/programe/testmerge.prg new file mode 100644 index 0000000..511220e --- /dev/null +++ b/programe/testmerge.prg @@ -0,0 +1,20 @@ +#DEFINE CRLF Chr(13) + Chr(10) +SET PROCEDURE TO D:\ROA_RB\ROAPRINT\COMUN\UTILE\WEB\htmlmerge.prg ADDITIVE +SET PROCEDURE TO D:\ROA_RB\ROAPRINT\COMUN\PROGRAME\regex.prg ADDITIVE +lcTemplate = "c:\roaprint_initializari\totals_win.tmpl" +Create cursor bon (TIP N(2),DENUMIRE C(50),CANTITATE N(10,4),PRET N(10,4),UM C(10),COTATVA N(5,2),DEPARTAMENT N(2)) +Insert into bon(tip, denumire, cantitate, pret, um, cotatva, departament) values (1,'ARTICOL 1', 1, 10.00, 'BUC', 1.19, 1) +loHTML = CREATEOBJ('HTMLMerge') +lcText = FILETOSTR(lcTemplate) +lcText = loHTML.ScanMerge(lcText) +lcText = loHTML.cHtml +MessageBox(lcText) +lcText = strtranregexp(lcText,"(^<.*>\r*\n*)", "") && <...> + chr(13) + chr(10) +Debug +Suspend +lnPos = At(CRLF+CRLF,lcText) +Do while lnPos > 0 + lcText = Strtran(lcText, CRLF+CRLF, CRLF) + lnPos = At(CRLF+CRLF,lcText) +EndDo +MessageBox(lcText) diff --git a/programe/utile.prg b/programe/utile.prg new file mode 100644 index 0000000..471ebc6 --- /dev/null +++ b/programe/utile.prg @@ -0,0 +1,293 @@ +*------------------------------------------- +* Function...: Xmenu +* Author.....: MARTIN +* Date.......: 04/06/1997 +* Notes......: Based on an idea from Steve Zimmelman for FoxPro 2.x +* Parameters.: tcItems = Semicolon-separated String with the various options +* ...........: tnBar = Initially selected item (default=1) +* Returns....: Selected item number +* See Also...: PROMPT() [FoxPro Native] +* lnOption = xmenu('\ 0 + lcXMLDirectory = lcXMLDirectory + Alltrim(tcCustomer_name) + '\' + Endif + + Return lcXMLDirectory + + Endfunc +Enddefine && Config + + +********************** inceput versiune ************************* +Procedure versiune + Lparameters lcvers + + External Array laVers + Local lcVersiune, lnNr + lcVersiune = [] + + lnNr = Alines(laVers,Nvl(lcvers,[]),.T.,".") + If lnNr > 1 + For i =1 To lnNr + laVers(i) = Replicate("0",3 - Len(Alltrim(Nvl(laVers(i),[])))) + laVers(i) + lcVersiune = lcVersiune + laVers(i) + "." + Endfor + lcVersiune = Left(lcVersiune,Len(lcVersiune)-1) + Else + lcVersiune = lcvers + Endif + Return lcVersiune + +Endproc +********************* versiune ^ ******************************** + + +**************************** inceput cmdPagToate ************************** +Define Class cmdPagToate As CommandButton && Create Command button + Left = 50 && Command button column + Top = 100 && Command button row + Height = 25 && Command button height + Visible = .T. + ToolTipText = "Toate inregistrarile" + Caption = "\ ] + lcp1 + + This.Parent.save_grid(This.Parent.grid1) + executasql(lcSql,This.Parent.cCursor,.T.) + Select (This.Parent.cCursor) + If Reccount() = 0 + executasql(lcSqlBackup,This.Parent.cCursor,.T.) + This.Parent.npag1 = 0 + This.Parent.npag2 = 25 + Endif + This.Parent.restore_grid(This.Parent.grid1) + Endproc +Enddefine +************************ sfarsit cmdPagUrmatoare ^ ******************************** \ No newline at end of file diff --git a/programe/xrecurse.prg b/programe/xrecurse.prg new file mode 100644 index 0000000..e8cdd3e --- /dev/null +++ b/programe/xrecurse.prg @@ -0,0 +1,101 @@ +* Test Source Code +x=CREATE('FilesList') +*!* SET TEXTMERGE ON TO TestRecurse NOSHOW +x.FileExtensions = 'sql' +x.Recurse("D:\ROA_RB\DATABASE\SCRIPTURI\") + +*!* SET TEXTMERGE TO +*!* MODI COMM TestRecurse.txt + + +DEFINE CLASS FilesList AS Recurse + + * + PROCEDURE INIT + DODEFAULT() + + CREATE CURSOR dirlist (DirName C(100), FileName C(250) , FileExt C(3), ; + rty C(1), FileAttr C(5), FileSize N(12,1), DateMod D, TimeMod C(12)) + ENDPROC && Init + * +*!* PROCEDURE ProcessDir(tcDir, tcParentDir) +*!* DODEFAULT() +*!* ENDPROC + PROCEDURE ProcessFile(tcFile, tnSize, tdLastMod, tcTime, tcAttr) + + LOCAL loRec + IF !USED('dirlist') + RETURN + ENDIF + + SELECT dirlist + SCATTER NAME loRec BLANK + WITH loRec + .rty='F' + .DirName = JUSTPATH(tcFile) + .FileAttr = tcAttr + .FileName = JUSTFNAME(tcFile) + .FileExt = JUSTEXT(tcFile) + .FileSize = IIF(tnSize > 0, ROUND(tnSize/1024,1) ,0 ) + .DateMod = tdLastMod + .TimeMod = tcTime + ENDWITH + + if len(allt(this.FileExtensions)) > 0 + if atc(loRec.FileExt , this.FileExtensions ) = 0 + return + endif + endif + + INSERT INTO dirlist FROM NAME loRec + ENDPROC && ProcessFile + +ENDDEFINE && FilesList + +DEFINE CLASS Recurse AS CUSTOM + + FileExtensions = "" && what file extensions it process + + PROCEDURE ProcessFile(tcFile, tnSize, tdLastMod, tcTime, tcAttr) + * Abstract Method to be overridden in subclasses that actually do something + ENDPROC + + PROCEDURE ProcessDir(tcDir, tcParentDir) + * Override this method as desired. + ENDPROC + + FUNCTION Recurse + LPARAMETERS pcDir + LOCAL lnPtr, lnFileCount, laFileList, lcDir, lcFile, lcCurDir + lcCurDir = FULLPATH(CURDIR()) + CHDIR (pcDir) + *? 'Dir -> ' + FULLPATH(CURDIR()) + + DIMENSION laFileList[1] + + *--- Read the chosen directory. + lnFileCount = ADIR(laFileList, '*.*', 'D') + FOR lnPtr = 1 TO lnFileCount + + IF 'D' $ laFileList[lnPtr, 5] + *--- Get directory name. + lcDir = laFileList[lnPtr, 1] + + *--- Ignore current and parent directory pointers. + IF lcDir != '.' AND lcDir != '..' + *--- Call this routine again. + THIS.ProcessDir(lcDir, pcDir) + THIS.Recurse(ADDBS(pcDir)+lcDir) + ENDIF + + ELSE + *--- Get the Long file name and process it: + THIS.ProcessFile( ADDBS(pcDir)+laFileList[lnPtr, 1], laFileList[lnPtr, 2], laFileList[lnPtr, 3], laFileList[lnPtr, 4], laFileList[lnPtr, 5] ) + ENDIF + ENDFOR + + *--- Move back to parent directory. + CHDIR (lcCurDir) + RETURN + ENDFUNC +ENDDEFINE diff --git a/programe_changelogs.xml b/programe_changelogs.xml new file mode 100644 index 0000000..ad9833b --- /dev/null +++ b/programe_changelogs.xml @@ -0,0 +1,33 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + diff --git a/rapoarte/rap_clienti.FRT b/rapoarte/rap_clienti.FRT new file mode 100644 index 0000000..bc21fde Binary files /dev/null and b/rapoarte/rap_clienti.FRT differ diff --git a/rapoarte/rap_clienti.frx b/rapoarte/rap_clienti.frx new file mode 100644 index 0000000..ef7d19d Binary files /dev/null and b/rapoarte/rap_clienti.frx differ diff --git a/rapoarte/rap_clienti_special.FRT b/rapoarte/rap_clienti_special.FRT new file mode 100644 index 0000000..e75de39 Binary files /dev/null and b/rapoarte/rap_clienti_special.FRT differ diff --git a/rapoarte/rap_clienti_special.frx b/rapoarte/rap_clienti_special.frx new file mode 100644 index 0000000..280e9b5 Binary files /dev/null and b/rapoarte/rap_clienti_special.frx differ diff --git a/rapoarte/rap_inform.FRT b/rapoarte/rap_inform.FRT new file mode 100644 index 0000000..6f6b3c8 Binary files /dev/null and b/rapoarte/rap_inform.FRT differ diff --git a/rapoarte/rap_inform.frx b/rapoarte/rap_inform.frx new file mode 100644 index 0000000..751877c Binary files /dev/null and b/rapoarte/rap_inform.frx differ diff --git a/rapoarte/semnatura_stampila_marius_mutu_romfast.jpg b/rapoarte/semnatura_stampila_marius_mutu_romfast.jpg new file mode 100644 index 0000000..d163f65 Binary files /dev/null and b/rapoarte/semnatura_stampila_marius_mutu_romfast.jpg differ diff --git a/roa-noutati-template-htmlmerge.xml b/roa-noutati-template-htmlmerge.xml new file mode 100644 index 0000000..98e4537 --- /dev/null +++ b/roa-noutati-template-htmlmerge.xml @@ -0,0 +1,25 @@ + + + + +Noutati ROA +http://www.romfast.ro +Noutati +en-us +Copyright <%=YEAR(DATE())%> +<%=RFC822Date(DATETIME())%> +http://blogs.law.harvard.edu/tech/rss + +<%=VERSION()%> +60 +

+ +<%=HTMLFix(title)%> +<%=HTMLFix(Description)%> +<%=RFC822Date(DATETIME())%> +<%=HTMLFix(Link)%> +roa.romfast.ro.<%=guid%> + +

+ + \ No newline at end of file diff --git a/settings.ini.tmpl b/settings.ini.tmpl new file mode 100644 index 0000000..c5c3bc7 --- /dev/null +++ b/settings.ini.tmpl @@ -0,0 +1,54 @@ +[connection] +host=CENTRAL +username=SOFT +password=YOUR_PASSWORD + +host_serii=ROA_CENTRAL +username_serii=SOFT_SERII +password_serii=YOUR_PASSWORD_SERII + +host_database=ROA_CENTRAL +username_database=contafin_oracle +password_database=YOUR_PASSWORD_DATABASE + +idutilizator=5 +[script] +CONTAFIN_ORACLE=CO_ +SCHEMAROA=FF_ +SOFT_SERII=RF_ +SYS=SYS_ +CONTABILITATE=JCS_ + +[folder] +actualizare=actualizariaplicatii\ +script_folder=D:\ROA\DATABASE\SCRIPTURI\ +roa_proiecte=D:\ROA\ +roa_output=Y:\ROAUPDATE\ +roa_arhive=Y:\ROAUPDATE\_ARHIVE\ +contafin_output=Y:\_CONTAFINUPDATE\XOUTPUT\ +contafin_arhive=Y:\_CONTAFINUPDATE\ +criptare_exe=. +contafin_proiecte=D:\CONTAFIN\ +xml_aplicatii=Y:\ROAUPDATE +xml_aplicatii_4450=EDUARD +xml_aplicatii_1281=STEAUANORDULUI +xml_aplicatii_1284=FRUVIMED +xml_aplicatii_4751=ROMCONSTRUCT +xml_aplicatii_4711=SIGMA +xml_aplicatii_2=ABCVAL +xml_aplicatii_11=ARGENTA +xml_aplicatii_31=CONPRESS +xml_aplicatii_102=UTMIDIA +xml_aplicatii_2468=METACOM +sqlplus_exe=D:\ORACLEINSTANTCLIENT\SQLPLUS.EXE +dummy_sql=d:\roa\database\altele\dummy.sql +xml_aplicatii_1701=ROMFAST +log_folder=D:\LOGS\ +xml_aplicatii_4742=DEMOROA +xml_aplicatii_4775=DEVROA + +[wrap] +wrap_server_path = \\YOUR_WRAP_SERVER\wrap +wrap_server_output_path = \\YOUR_WRAP_SERVER\wrap\output +wrap_ext = wrp +wrap_timeout = 30 diff --git a/tasks.PJT b/tasks.PJT new file mode 100644 index 0000000..ae6f192 Binary files /dev/null and b/tasks.PJT differ diff --git a/tasks.pjx b/tasks.pjx new file mode 100644 index 0000000..06f75f3 Binary files /dev/null and b/tasks.pjx differ diff --git a/todo.txt b/todo.txt new file mode 100644 index 0000000..b466a50 --- /dev/null +++ b/todo.txt @@ -0,0 +1,15 @@ +ACTUALIZARE ROA - DE VERIFICAT DACA EXISTA EXECUTABILELE SI SCRIPTURILE + + ret = xmenu("Rapoarte speciale clienti;Rapoarte clienti CONTAFIN;Rapoarte clienti ROA;Soft trimis la clienti;Soft trimis la clienti (alegere manuala a versiunilor)") + Do Case + Case ret = 1 + Do rapoarte_speciale_cl + Case ret = 2 + Do rapoarte_cl_CONTAFIN + Case ret = 3 + Do rapoarte_cl_ROA + Case ret = 4 + Do soft_trimis_cl + CASE ret = 5 + DO soft_trimis_cl_manual + Endcase \ No newline at end of file diff --git a/utile/foxypreviewer.app b/utile/foxypreviewer.app new file mode 100644 index 0000000..6a64c42 Binary files /dev/null and b/utile/foxypreviewer.app differ diff --git a/utile/libhpdf.dll b/utile/libhpdf.dll new file mode 100644 index 0000000..91f84fa Binary files /dev/null and b/utile/libhpdf.dll differ