romfast/tasks
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Initial commit - tasks v1.1.14

Browse Source 
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
Marius Mutu
2026-04-21 15:46:20 +03:00
commit d91b19e336
218 changed files with 8258 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

140
programe/actualizare_roa.prg Normal file
View File

@@ -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'))

22
programe/conectare.prg Normal file
View File

@@ -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

157
programe/execute_script.prg Normal file
View File

@@ -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)

222
programe/execute_script_xdir.prg Normal file
View File

@@ -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)

2
programe/generare_script.prg Normal file
View File

@@ -0,0 +1,2 @@
loFrmGen = Createobject("frm_generare_script")
loFrmGen.Show(1)

137
programe/genereazaxml_original.txt Normal file
View File

@@ -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 '{{', '}}'
\<?xml version='1.0'?>
Select crsXmlOut
*SELECT crsProgLic
Scan For customer_id = lnCustomerId
\<{{Alltrim(PROGRAM)}}>
\<codeupdate>
\<version>{{Alltrim(VERSIUNE)}}</version>
\<fileURL>{{'\_ARHIVE\' + Alltrim(PROGRAM) + '\' + Alltrim(PROGRAM) + '-' + Alltrim(VERSIUNE) + '.EXE'}}</fileURL>
\<Usermsg>S-a gasit {{Alltrim(PROGRAM)}} versiunea {{Alltrim(VERSIUNE)}}. Programul va incepe procedurile de actualizare !</Usermsg>
\</codeupdate>
\</{{Alltrim(PROGRAM)}}>
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)}}>
\<codeupdate>
\<version>{{Alltrim(VERSIUNE)}}</version>
\<fileURL>{{'\_ARHIVE\' + Alltrim(PROGRAM) + '\' + Alltrim(PROGRAM) + '-' + Alltrim(VERSIUNE) + '.EXE'}}</fileURL>
\<Usermsg>S-a gasit {{Alltrim(PROGRAM)}} versiunea {{Alltrim(VERSIUNE)}}. Programul va incepe procedurile de actualizare !</Usermsg>
\</codeupdate>
\</{{Alltrim(PROGRAM)}}>
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()

287
programe/htmlmerge.prg Normal file
View File

@@ -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 *, ;
* '<A HREF="http://localhost/default.htm">' + eng_name + '</A>' 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('<TABLE', tcTemplate)
IF lnTable = 0
* No table found
lnTable = 99999999
ENDIF
lnList = THIS.GetScanTagPos('<OL', tcTemplate)
IF lnList = 0
* No numbered list found, check for an bullet list
lnList = THIS.GetScanTagPos('<UL', tcTemplate)
IF lnList = 0
* No list found at all
lnList = 99999999
ENDIF
ENDIF
IF lnTable < lnList
* Table found before any list
THIS.MergeTable(tcTemplate, lnTable)
ELSE
* List found before any table
THIS.MergeList(tcTemplate, lnList)
ENDIF
RETURN
********************************************
PROCEDURE MergeTable(tcTemplate, tnStartPos)
********************************************
* Merge the body of a HTML table with every record
* in the current cursor
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('<TABLE', lcTemplate)
ENDIF
* Is there a table ?
IF lnAtPos > 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('</TABLE>', lcTemplate)
lcTable = LEFT(lcTemplate, lnAtPos - 1)
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
lnAtPos = ATCC('<TR', lcTable)
IF lnAtPos > 0
* Take care of the starting <TABLE ... > tag
lcText = LEFT(lcTable, lnAtPos - 1)
lcTable = SUBSTR(lcTable, lnAtPos)
THIS.Merge(lcText)
ENDIF
DO WHILE ATCC('<TH', lcTable) > 0
* Extract the headers and merger them
lnAtPos = ATCC('</TR>', 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('<OL', lcTemplate)
IF lnAtPos = 0
lnAtPos = THIS.GetScanTagPos('<UL', lcTemplate)
ENDIF
ENDIF
* Is there a list ?
IF lnAtPos > 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('</OL>', lcTemplate)
IF lnAtPos = 0
lnAtPos = ATCC('</UL>', lcTemplate)
ENDIF
lcTable = LEFT(lcTemplate, lnAtPos - 1)
lcTemplate = SUBSTR(lcTemplate, lnAtPos)
lnAtPos = ATCC('<LI', lcTable)
IF lnAtPos > 0
* Take care of the <TABLE> 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, '&lt;%', '<%')
lcText = STRTRAN(lcText, '%&gt;', '%>')
* 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

29
programe/ini.prg Normal file
View File

@@ -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

84
programe/log_mesaje.prg Normal file
View File

@@ -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 <log.txt> 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
\<<Datetime()>> <<Sys(0)>> <<Iif(Type('GCS')='C',GCS,'')>>
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
\ <<lcAddText>>
Set Textmerge To
Endproc
&& ------------------------------SFARSIT: Log ------------------------------
Enddefine && log_mesaje

545
programe/main.prg Normal file
View File

@@ -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

1367
programe/oproceduri_comune.prg Normal file
View File

File diff suppressed because it is too large Load Diff

390
programe/proceduri.prg Normal file
View File

@@ -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 <server>.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 <server>.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<server>.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 '{{', '}}'
\<?XML Version='1.0'?>
Select crsXmlOut
*SELECT crsProgLic
Scan For customer_id = lnCustomerId
\<{{Alltrim(Program)}}>
\<codeupdate>
\<Version>{{Alltrim(versiune)}}</Version>
\<fileURL>{{'\_ARHIVE\' + Alltrim(Program) + '\' + Alltrim(Program) + '-' + Alltrim(versiune) + lcExtensieArhive}}</fileURL>
\<usermsg>S-a gasit {{Alltrim(Program)}} versiunea {{Alltrim(versiune)}}. Programul va incepe procedurile de actualizare !</usermsg>
\</codeupdate>
\</{{Alltrim(Program)}}>
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 ^
*!* <program>APPUPDATE</program>
*!* <fisier>http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/appupdate-1.0.3.exe</fisier>
*!* <log>http://83.103.197.79:3002/contafinupdate/default.aspx/update/download/|licenta|/changelog_appupdate.txt</log>
*!* <versiune>1.0.3</versiune>
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

144
programe/proceduri_sql.prg Normal file
View File

@@ -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

976
programe/rapoarte.prg Normal file
View File

@@ -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_<tcRaport> din directorul \\SERVER\ROA\USERREPORTS\<APPLICATIE>\<FIRMA>\ daca exista
*!* Daca nu exista raporturl USR_<tcRaport> se listeaza raportul <tcRaport> 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_<RAPORT>.FRX, DACA EXISTA, ALTFEL, <RAPORT.FRX>
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

279
programe/rbinputbox.prg Normal file
View File

@@ -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
**************************************************

160
programe/regex.prg Normal file
View File

@@ -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

20
programe/testmerge.prg Normal file
View File

@@ -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)

293
programe/utile.prg Normal file
View File

@@ -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('\<Listare1;L\<istare2;Li\<stare3')
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 )
Endproc
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
Define Class Config As Relation
cSqlPlusFile = ""
cLogDirectory = ""
cActualizareDirectory = ""
*** ==========================================================
Procedure SetLogDirectory
Lparameters tcLogDirectory
Local lcLogDirectory
If Empty(tcLogDirectory)
lcLogDirectory = Getdir(Addbs(Justpath(Sys(16,0))), "Alegeti directorul in care se vor genera logurile","Director loguri")
Else
lcLogDirectory = tcLogDirectory
Endif
WriteINI(goApp.cIniFile, "folder", "log_folder", lcLogDirectory)
Return lcLogDirectory
Endproc && SetLogDirectory
*** ==========================================================
Procedure SetActualizareDirectory
Lparameters tcActualizareDirectory
Local lcActualizareDirectory
If Empty(tcActualizareDirectory)
lcActualizareDirectory = Getdir(Addbs(Justpath(Sys(16,0))), ;
"Alegeti directorul in care se vor genera actualizarile","Director actualizari")
Else
lcActualizareDirectory = tcActualizareDirectory
Endif
If !"actualizariaplicatii"$lcActualizareDirectory
lcActualizareDirectory = ADDBS(lcActualizareDirectory) + 'actualizariaplicatii\'
Endif
WriteINI(goApp.cIniFile, "folder", "actualizare", lcActualizareDirectory)
Return lcActualizareDirectory
Endproc && SetActualizareDirectory
*** ==========================================================
Procedure SetSqlPlus
Local lcSqlPlus
lcSqlPlus = Getfile("exe","SQLPLUS.EXE")
WriteINI(goApp.cIniFile, "folder", "sqlplus_exe", lcSqlPlus)
Return lcSqlPlus
Endproc && SetSqlPlus
*** ==========================================================
Function GetSqlPlus
Local lcSqlPlus
lcSqlPlus = ReadINI(goApp.cIniFile, "folder", "sqlplus_exe")
If Empty(lcSqlPlus) Or !File(lcSqlPlus)
lcSqlPlus = This.SetSqlPlus()
Endif
Return lcSqlPlus
Endfunc && GetSqlPlus
*** ==========================================================
Function GetLogDirectory
Local lcLogDirectory
lcLogDirectory = ReadINI(goApp.cIniFile, "folder", "log_folder")
If Empty(lcLogDirectory) Or !Directory(lcLogDirectory)
lcLogDirectory = This.SetLogDirectory()
Endif
lcLogDirectory = Addbs(lcLogDirectory)
Return lcLogDirectory
Endfunc && GetLogDirectory
*** ==========================================================
Function GetActualizareDirectory
Local lcActualizareDirectory
lcActualizareDirectory = ReadINI(goApp.cIniFile, "folder", "roa_output")
If !"actualizariaplicatii"$lcActualizareDirectory
lcActualizareDirectory = ADDBS(lcActualizareDirectory) + 'actualizariaplicatii\'
ENDIF
If Empty(lcActualizareDirectory) Or !Directory(lcActualizareDirectory)
lcActualizareDirectory = This.SetActualizareDirectory()
Endif
lcActualizareDirectory = Addbs(lcActualizareDirectory)
Return lcActualizareDirectory
Endfunc && GetActualizareDirectory
*** ==========================================================
Function GetDailyLogDirectory
lparameters tcHost, tcUserName
Local lcDailyLogDirectory, lcHost, lcUserName
lcHost = iif(!empty(m.tcHost), alltrim(m.tcHost), Alltrim(goApp.cUserName))
lcUserName = iif(!empty(m.tcUserName), alltrim(m.tcUserName), Alltrim(goApp.cUserName))
lcDailyLogDirectory = ""
lcLogDirectory = This.GetLogDirectory()
If !Empty(lcLogDirectory) And Directory(lcLogDirectory)
lcDailyLogDirectory = lcLogDirectory + m.lcHost + [\] + ;
m.lcUserName + [_] + Ttoc(Datetime(),1) + [\]
Endif
Return lcDailyLogDirectory
Endfunc && GetDailyLogDirectory
*** ==========================================================
Function getXMLDirectory
Lparameters tcCustomer_name
LOCAL lcXMLDirectory
lcXMLDirectory = This.GetActualizareDirectory()
If Pcount() > 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 = "\<Toate"
Procedure Click
Local lcSql, lnSucces
If This.Parent.npag2 = 25
This.Caption = "\<Reset"
This.Parent.npag2 = 1000001
Else
This.Caption = "\<Toate"
This.Parent.npag1 = 0
This.Parent.npag2 = 25
Endif
lcSql = [select * from (] + This.Parent.cSelect + ;
[) where rownum < ] + Alltrim(Str(This.Parent.npag2))
This.Parent.save_grid(This.Parent.grid1)
executasql(lcSql,This.Parent.cCursor,.T.)
This.Parent.restore_grid(This.Parent.grid1)
Endproc
Enddefine
************************** sfarsit cmdPagToate ^ ******************************
************************** inceput cmdPagUrmatoare ****************************
Define Class cmdPagUrmatoare As CommandButton && Create Command button
Left = 50 && Command button column
Top = 100 && Command button row
Height = 25 && Command button height
Visible = .T. && implicit, butonul se adauga cu prop visible = .f.
ToolTipText = "Urmatoarele inregistrari"
Caption = "\<Urmatoarele"
Procedure Click
Local lcSql, lcSqlBackup, lnSucces, lcSel, lcp1, lcp2
This.Parent.npag1 = This.Parent.npag1 + 25
This.Parent.npag2 = This.Parent.npag2 + 25
lcSel = This.Parent.cSelect
lcp1 = Alltrim(Str(This.Parent.npag1))
lcp2 = Alltrim(Str(This.Parent.npag2))
lcSqlBackup = This.Parent.cSelect && daca nu mai sunt inregistrari pt paginare, se vor afisa toate inreg
lcSql = [select * from ] + ;
[ ( select a.*, rownum r from ] + ;
[ ( select * from ] + ;
[ ( ] + lcSel + [) t ) a ] + ;
[ where rownum <= ] + lcp2 + [) ] + ;
[ where r > ] + 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 ^ ********************************

101
programe/xrecurse.prg Normal file
View File

@@ -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