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

Import initial: surse ROASTART + text FoxBin2Prg in arbore

Browse Source 
Binarele VFP raman pe SVN si sunt git-ignored; COMUN e gestionat separat.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01A5okKjUKMM5Xk1egq2w81P
This commit is contained in:
Marius Mutu
2026-08-03 09:34:12 +03:00
commit b241a639b1
81 changed files with 24199 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

506
Programe/oproceduri_start.prg Normal file
View File

@@ -0,0 +1,506 @@
*************************************************************************************************************
*!* Procedure actualizeaza_etichete
*!* Lparameters toObiectFundal
*!* With toObiectFundal
*!* IF CPCURRENT(1) <> CPCURRENT()
*!* MESSAGEBOX(CPCONVERT(CPCURRENT(1),CPCURRENT(),.cw_meniu2.lb_meniu1.Caption))
*!* MESSAGEBOX(ASC(SUBSTR(.cw_meniu2.lb_meniu1.Caption,4,1)))
*!* endif
*!* .cw_meniu1.lb_meniu1.Caption = tradu(.cw_meniu1.lb_meniu1.Caption)
*!* .cw_meniu2.lb_meniu1.Caption = tradu(.cw_meniu2.lb_meniu1.Caption)
*!* .cw_meniu3.lb_meniu1.Caption = tradu(.cw_meniu3.lb_meniu1.Caption)
*!* .cw_meniu4.lb_meniu1.Caption = tradu(.cw_meniu4.lb_meniu1.Caption)
*!* .cw_meniu5.lb_meniu1.Caption = tradu(.cw_meniu5.lb_meniu1.Caption)
*!* .config.Caption = tradu(.config.Caption)
*!* .actualizari.Caption = tradu(.actualizari.Caption)
*!* .lb_logoff.Caption = tradu(.lb_logoff.Caption)
*!* Endwith
*!* Endproc
*************************************************************************************************************
Procedure adauga_grup_in_favorite
Lparameters tnIdGrupProg
Local lnIdGrupProg,j
lnIdGrupProg=tnIdGrupProg
lcNumeParinte=[scrollcont]+Alltrim(Str(lnIdGrupProg))
lcNumeContainer=[Application.Forms.Item(1).pgf_optiuni1.page1.]+lcNumeParinte
With &lcNumeContainer.
For j=1 To .Objects.Count
If Upper(.Objects(j).Class)=[CW_PROGRAME]
lcNume=.Objects(j).Name
lnIdProg=.Objects(j).nid_prog
adauga_in_favorite(lcNumeParinte,lcNume,lnIdProg,.F.)
Endif
Endfor
Endwith
Endproc && adauga_grup_in_favorite
*************************************************************************************************************
Procedure sterge_grup_din_favorite
Lparameters tnIdGrupProg
Local lnIdGrupProg,j
lnIdGrupProg=tnIdGrupProg
lcNumeParinte=[scrollcont]+Alltrim(Str(lnIdGrupProg))
lcNumeContainer=[Application.Forms.Item(1).pgf_optiuni1.page1.]+lcNumeParinte
With &lcNumeContainer.
For j=1 To .Objects.Count
If Upper(.Objects(j).Class)=[CW_PROGRAME]
lcNume=.Objects(j).Name
lnIdProg=.Objects(j).nid_prog
sterge_din_favorite(lnIdGrupProg,lcNume,lnIdProg)
Endif
Endfor
Endwith
Endproc && sterge_grup_din_favorite
*************************************************************************************************************
Procedure adauga_in_favorite
Lparameters tcNumeParinte,tcNume,tnIdProg,tlArataMesaj
Local llArataMesaj
Store .T. To llArataMesaj
llArataMesaj=tlArataMesaj
lcNume=Alltrim(tcNume)
lcNumeObiect=[Application.Forms.Item(1).pgf_optiuni1.page1.]+Alltrim(tcNumeParinte)+[.]+lcNume
lcNumeContainerFav=[Application.Forms.Item(1).pgf_optiuni1.page1.scrollcont0]
Do Case
Case Type(lcNumeContainerFav+"."+lcNume)='U'
With &lcNumeContainerFav.
lcSql=[begin pack_drepturi.adauga_program_favorit(]+Alltrim(Str(tnIdProg))+[,]+;
ALLTRIM(Str(.nnrobiecte+1))+[,]+Alltrim(Str(gnIdUtil))+[); end;]
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
aMessagebox(goExecutor.cEroare,0+16,'Eroare')
Else
lcImagine=&lcNumeObiect..lb_imagine.Picture
&lcNumeObiect..lb_imagine.Picture=Substr(lcImagine,1,Len(lcImagine)-4)+"_fav.png"
.do_adaugaobiect(lcNume,"cw_programe")
.&lcNume..lb_program.Caption= &lcNumeObiect..lb_program.Caption
.&lcNume..lb_imagine.Picture = lcImagine
.&lcNume..cprogram= &lcNumeObiect..cprogram
.&lcNume..Visible=.T.
.&lcNume..nid_grup_prog= 0
.&lcNume..nid_prog = &lcNumeObiect..nid_prog
.&lcNume..nid_grup_prog_tata = &lcNumeObiect..nid_grup_prog
Endif
Endwith
Case llArataMesaj
aMessagebox("Acest program este deja in grupul de programe favorite!",0+48,"Atentie")
Endcase
Endproc && adauga_in_favorite
*************************************************************************************************************
Procedure sterge_din_favorite
Lparameters tnIdGrupParinte,tcNume,tnIdProg
lcNume=Alltrim(tcNume)
lcNumeContainerFav=[Application.Forms.Item(1).pgf_optiuni1.page1.scrollcont0]
If Type(lcNumeContainerFav+"."+lcNume)<>'U'
lcSql=[begin pack_drepturi.sterge_program_favorit(]+Alltrim(Str(tnIdProg))+[,]+;
ALLTRIM(Str(gnIdUtil))+[); end;]
lnSucces = goExecutor.oExecute(lcSql)
If lnSucces < 0
aMessagebox(goExecutor.cEroare,0+16,'Eroare')
Else
lcNumeObiect=[Application.Forms.Item(1).pgf_optiuni1.page1.scrollcont]+Alltrim(Str(tnIdGrupParinte))+[.]+lcNume
lcImagine=lcNumeContainerFav+[.]+lcNume+[.lb_imagine.Picture]
&lcNumeObiect..lb_imagine.Picture=&lcImagine.
With &lcNumeContainerFav.
.do_stergeobiect(lcNume)
Endwith
Endif
Endif
Endproc && sterge_din_favorite
*************************************************************************************************************
Procedure viz_grup_program
Private pogrupprog,pcschema1,pcselect1
Store '' To pogrupprog
If Used('v_grupprog')
Use In v_grupprog
Endif
llAfisare=.F.
pcschema1 = ['id_grup_prog n(5),explicatie c(150),ordine n(5)']
pcselect1=['select id_grup_prog,explicatie,ordine from vdef_grup_programe where 1=2']
pcorder1=[explicatie]
pcfiltru1 = [2=2]
gencursor('pogrupprog','v_grupprog',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
pogrupprog.ca_baza1.afisare()
*!* Select v_grupprog
*!* Scatter Name poRec
ofrmgrprog=Createobject("frm_grup_prg")
ofrmgrprog.Show(1)
Release ofrmgrprog
Release pogrupprog
Endproc
*************************************************************************************************************
Procedure viz_firme
Private pofirme,pcschema1,pcselect1
Store '' To pofirme
If Used('v_firme')
Use In v_firme
Endif
llAfisare=.F.
pcschema1 = ['']
pcselect1=['select * from SYN_V_nom_firme where 1=2']
pcorder1=[firma]
pcfiltru1 = [2=2]
gencursor('pofirme','v_firme',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
pofirme.ca_baza1.afisare()
Select v_firme
Scatter Name poRec
ofrmfirme=Createobject("frm_firme")
ofrmfirme.Show(1)
Release ofrmfirme
Release pofirme
Endproc
*************************************************************************************************************
*!* modificare v 2.0.29
*!* Procedure mod_parola
*!* gnButon=1
*!* ofrmparola=Createobject("frm_parola_nou")
*!* ofrmparola.Show(1)
*!* Release ofrmparola
*!* If gnButon=1
*!* aMessagebox("Parola a fost schimbata!",0+64,"Modificare parola")
*!* Release All
*!* goApp.SetCaption("ROA Romfast Applications")
*!* Do Form frm_fundal
*!* Endif
*!* Endproc
*!* modificare v 2.0.29 ^
*************************************************************************************************************
Procedure mod_optiuni
If Used('crsoptiuniprog')
Use In crsoptiuniprog
Endif
Do viz_optiuni_prg In update_start.prg
Select * From v_optiuni_programe Into Cursor crsoptiuniprog Readwrite
If Used('v_optiuni_programe')
Use In v_optiuni_programe
Endif
gnButon=1
ofrmoptiuni=Createobject("frm_optiuni_util")
ofrmoptiuni.Show(1)
Release ofrmoptiuni
If gnButon=1
aMessagebox("Modificarile vor fi vizibile la urmatoarea logare!",0+64,"Modificare optiuni")
Endif
Endproc
*************************************************************************************************************
Procedure viz_utilgrupfirma
Private poprograme,pcschema1,pcselect1,poutilgrup,poutilizatori
Store '' To poprograme,poutilgrup,poutilizatori
llAfisare=.F.
pcschema1 = ['']
pcselect1=['select id_util,utilizator from vutilizatori where 1=2']
pcorder1=[utilizator]
pcfiltru1 = [inactiv=0]
gencursor('poutilizatori','v_utilizatori',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
poutilizatori.ca_baza1.afisare()
llAfisare=.F.
pcschema1 = ['']
pcselect1=['select id_dug,id_grup,grup,id_firma,firma from vdef_util_grup where 1=2']
pcorder1=[grup]
pcfiltru1 = [1=2]
gencursor('poutilgrup','v_utilgrf',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
poutilgrup.ca_baza1.afisare()
Select v_utilgrf
Select Distinct id_grup,grup From v_utilgrf Into Cursor v_utgrupuri
Select id_firma,firma From v_utilgrf Into Cursor v_utfirme
pcschema1 = ['']
pcselect1=['select id_program,denumire as program from vdef_grup_drept where 1=2']
pcorder1=[program]
pcfiltru1 = [1=2]
gencursor('poprograme','v_programe',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
poprograme.ca_baza1.afisare()
ofrmutilgf=Createobject("frm_utilgrupf")
ofrmutilgf.Show(1)
If Used('v_utilizatori')
Use In v_utilizatori
Endif
If Used('v_utilgrf')
Use In v_utilgrf
Endif
If Used('v_utgrupuri')
Use In v_utgrupuri
Endif
If Used('v_utfirme')
Use In v_utfirme
Endif
If Used('v_programe')
Use In v_programe
Endif
Release ofrmutilgf
Release poprograme,poutilgrup,poutilizatori
Endproc
*************************************************************************************************************
Procedure viz_utilizatori
Private pogrupuri,pcschema1,pcselect1
Store '' To poutilizatori
llAfisare=.F.
pcschema1 = ['']
pcselect1=['select * from vutilizatori where 1=2']
pcorder1=[utilizator]
pcfiltru1 = [2=2]
gencursor('poutilizatori','v_utilizatori',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
poutilizatori.ca_baza1.afisare()
ofrmutil=Createobject("frm_utilizatori")
ofrmutil.Show(1)
Release ofrmutil
Release poutilizatori
Endproc
*************************************************************************************************************
Procedure viz_organigrama_firme
update_organigrama_firme_grup()
update_organigrama_firme_util()
ofrmorganigrama=Createobject("frm_organigrama_firme")
ofrmorganigrama.Show(1)
Release ofrmorganigrama
Endproc
*************************************************************************************************************
Procedure viz_organigrama_programe
update_organigrama_programe_grup()
update_organigrama_programe_firme()
update_organigrama_programe_util()
ofrmorganigrama=Createobject("frm_organigrama_prog")
ofrmorganigrama.Show(1)
Release ofrmorganigrama
Endproc
*************************************************************************************************************
Procedure viz_organigrama_utilizatori
update_organigrama_util_grup()
update_organigrama_util_firme()
ofrmorganigrama=Createobject("frm_organigrama_util")
ofrmorganigrama.Show(1)
Release ofrmorganigrama
Endproc
*************************************************************************************************************
Procedure viz_organigrama_grupuri
update_organigrama_grupuri()
ofrmorganigrama=Createobject("frm_organigrama_grup")
ofrmorganigrama.Show(1)
Release ofrmorganigrama
Endproc
*************************************************************************************************************
Procedure viz_grupprog
Private poprograme,pcschema1,pcselect1,pogrupuri
Store '' To poprograme,pogrupuri
llAfisare=.F.
pcschema1 = ['']
pcselect1=['select * from vdef_grup where 1=2']
pcorder1=[grup]
pcfiltru1 = [2=2]
gencursor('pogrupuri','v_grupuri',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
pogrupuri.ca_baza1.afisare()
pcschema1 = ['']
pcselect1=['select * from vdef_grup_drept where 1=2']
pcorder1=[denumire]
pcfiltru1 = [1=2]
gencursor('poprograme','v_grupprog',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
pogrupuri.ca_baza1.afisare()
ofrmgrprog=Createobject("frm_grupprog")
ofrmgrprog.Show(1)
Release ofrmgrprog
Release poprograme,pogrupuri
Endproc
*************************************************************************************************************
Procedure viz_programe
Private poprograme,pcschema1,pcselect1
Store '' To poprograme
llAfisare=.F.
pcschema1 = ['']
pcselect1=['select * from vdef_programe where 1=2']
pcorder1=[ordine_grup,nume]
pcfiltru1 = [2=2]
gencursor('poprograme','v_programe',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
poprograme.ca_baza1.afisare()
ofrmprog=Createobject("frm_programe")
ofrmprog.Show(1)
Release ofrmprog
Release poprograme
Endproc
*************************************************************************************************************
Procedure viz_grupuri
Private pogrupuri,pcschema1,pcselect1
Store '' To pogrupuri
llAfisare=.F.
pcschema1 = ['id_grup N(10),grup C(100),id_tata N(10),grup_sup C(100)']
pcselect1=['select a.id_grup,a.grup,a.id_tata,TRIM(SUBSTR(a.tata,1,INSTR(a.tata,CHR(92),1,a.nivel)-1)) '+]+;
['as grup_sup from vdef_grup a where 1=2']
pcorder1=[a.grup]
pcfiltru1 = [2=2]
gencursor('pogrupuri','v_grupuri',pcselect1,pcfiltru1,pcschema1,pcorder1,llAfisare)
pogrupuri.ca_baza1.afisare()
ofrmgrup=Createobject("frm_grupuri")
ofrmgrup.Show(1)
Release ofrmgrup
Release pogrupuri
Endproc
*************************************************************************************************************
*************************************************************************************************************
Procedure mod_validari
PRIVATE poutilizatori,pofirme
LOCAL lcschema,lcselect
Store '' To poutilizatori,pofirme,lcgroup
llModParam=.t.
llAfisare=.F.
lcschema = []
lcselect=[select * from vutilizatori]
lcorder=[utilizator]
lcfiltru=[inactiv=0]
gencursor('poutilizatori', 'v_utilizatori', lcselect, lcfiltru, lcschema, lcorder, llAfisare, lcgroup, llModParam)
poutilizatori.ca_baza1.afisare()
llAfisare=.F.
lcschema = []
lcselect=[select distinct a.ID_util,a.id_firma,a.firma,NVL(b.autovalidare,0) as autovalidare,NVL(b.dreptvalidare,0) as dreptvalidare,0 as modificat from vdef_util_grup a left join def_utilizatori_validare b on b.id_util=a.id_util and b.id_firma=a.id_firma]
lcorder=[firma]
lcfiltru=[]
gencursor('pofirme','v_firme',lcselect,lcfiltru,lcschema,lcorder,llAfisare, lcgroup, llModParam)
pofirme.ca_baza1.afisare()
SELECT v_firme
ofrmutil=Createobject("frm_validari")
ofrmutil.Show(1)
PRIVATE porec
porec=null
IF gnbuton=1
Select v_firme
Set Filter To
Scan For(modificat=1)
SCATTER NAME porec
* Messagebox(ALLTRIM(STR(id_util))+","+ALLTRIM(Str(id_firma)) + ","+ALLTRIM(str(autovalidare))+","+ALLTRIM(STR(dreptvalidare)))
lnSucces = 1
&& apelez functia de merge de pe server
IF lnSucces > 0
lcSql = [begin pack_drepturi.mergedatevalidare(?porec.id_util,?porec.id_firma,?porec.autovalidare,?porec.dreptvalidare); end;]
lnSucces = goExecutor.oExecute(lcSql)
IF lnSucces < 0
AMESSAGEBOX(goExecutor.cEroare,0+16,"Eroare")
ENDIF
ENDIF
Endscan
ENDIF
Release ofrmutil
Release poutilizatori
Endproc
*************************************************************************************************************
Procedure conectare
Lparameters tcHost, tcSchema, tcPassword
Private pcexec,pnsucces
If Pcount() <> 3
lcHost = Alltrim(gcHost)
lcSchema = Alltrim(gcUserName)
lcPassword = Alltrim(gcPassword)
Else
lcHost = Alltrim(tcHost)
lcSchema = Alltrim(tcSchema)
lcPassword = Alltrim(tcPassword)
Endif
*!* 22.06.2012
gnHandle = goConn.Connect(lcHost, lcSchema, lcPassword)
*!* If gnhandle < 0
*!* gnhandle = SQLConnect(Alltrim(lcHost),Alltrim(lcSchema),Alltrim(lcPassword))
*!* Endif
*!* 22.06.2012 ^
If gnhandle <= 0
*!* _Screen.Caption="Deconectat: "+Sys(0)
aMessagebox("Conectarea nu a reusit!",0+48,"Atentie")
Return gnhandle
Else
*!* _Screen.Caption="ROA (" + lcHost + ") " + +Sys(0)
Endif
goExecutor.nhandle = gnhandle
Return gnhandle
Endproc
*************************************************************************************************************
Procedure Deconectare( tnHandle )
*!* 22.06.2012
goConn.Disconnect(tnHandle)
*!* SQLDisconnect(0)
*!* gnhandle = -1
*!* goExecutor.nhandle = -1
*!* 22.06.2012 ^
Endproc
*************************************************************************************************************
*!* Procedure iesire
*!* goConn.Disconnect()
*!* *!* SQLDisconnect(0)
*!* Release All
*!* Quit
*!* Endproc
*************************************************************************************************************
Procedure arata_meniu_tray
Lparameters tnXCoord,tnYCoord
Local lcCursor, lnIdActual, lnIdPrec, loPop
lcCursor = [crsprogramemeniu]
lnIdActual = 0
lnIdPrec = 0
Select 0 As id_grup_prog, 'FAVORITE' As grup, nume, explicatie, 0 As ordine_grup,id_prog,ordine_favorit As ordine From v_programe_instalate ;
WHERE favorit = 1 ;
UNION All ;
SELECT id_grup_prog, grup, nume, explicatie, ordine_grup, id_prog, ordine From v_programe_instalate ;
Order By 5,7 Into Cursor (lcCursor)
*!* Select nume, explicatie,ordine_favorit,id_prog From v_programe_instalate ;
*!* WHERE favorit = 1 ;
*!* Order By ordine_favorit Into Cursor (lcCursor)
If Reccount(lcCursor) > 0
loPop = Newobject('PopMenu', 'menuTool.vcx')
With loPop
.nMenuBackColor = Rgb(255,251,247)
.nItemHeight = 23
.nBarStyle = 2
.nBarWidth = 22
.nBarFillColor1 = Rgb(2,2,88) && Rgb(255,251,247)
.nBarFillColor2 = Rgb(255,251,247) && Rgb(214,215,206)
.nTextLeft = 23
.nTextMargin = 8
.nSelectedStyle = 1
.lSelectedEnabled = .T.
.nSelectedForeColor = Rgb(0, 0, 0)
.nReturn = 2
.lOwnerDraw = .T.
Select (lcCursor)
lnIdPrec = -1
Scan
&& ParentKey, Key, Caption, Command, Image
*!* .Add('', '', Alltrim(explicatie), 'goApp.aforms[1].pgf_optiuni1.page1.scrollcont0.cw_'+Alltrim(Str(id_prog))+'.click()', Alltrim(nume)+'.bmp')
lnIdActual = id_grup_prog
If lnIdActual <> lnIdPrec
.Add('', Alltrim(Str(lnIdActual)), caps_first(ALLTRIM(grup)), '', Iif(lnIdActual = 0,'favorites.bmp',''))
lnIdPrec = lnIdActual
Endif
.Add(Alltrim(Str(lnIdActual)), '', caps_first(ALLTRIM(explicatie)), ;
'goApp.aforms[1].pgf_optiuni1.page1.scrollcont'+ALLTRIM(STR(lnIdActual))+'.cw_'+Alltrim(Str(id_prog))+'.click()',;
IIF(FILE(Alltrim(nume)+'.bmp'),Alltrim(nume)+'.bmp','na.bmp'))
Endscan
.Add('','', '\-', '','' )
.Add('','', Upper(Alltrim(gcUserNameApp))+'', 'schimba_utilizator()','iesire.bmp' )
*!* .Add('','', 'Iesire', 'goApp.aforms[1].lb_logoff.click()','logoff.bmp' )
.Add('','', 'Iesire', 'goApp.onshutdown()','logoff.bmp' )
.Show(tnXCoord,tnYCoord,.T.)
Endwith
Endif
Use In (lcCursor)
Release lcCursor, lnIdActual, lnIdPrec, loPop
Endproc
*************************************************************************************************************
PROCEDURE schimba_utilizator
goApp.aforms[1].oobjsystray.icondblclickevent()
goApp.aforms[1].lb_numeutilizator.Click()
Endproc
*************************************************************************************************************

752
Programe/roastart.prg Normal file
View File

@@ -0,0 +1,752 @@
*!* 24.06.2015
*!* marius.mutu
*!* Obiect KeepAlive Tin conexiunea deschisa. La wert??? apare eroarea odbc "timeout occured" daca se lasa peste 1 minut programul fara sa se lucreze
Public gnhandle
Public gTransferTotal
Public gcmdCancelDownload
Public gnewcryptfll
Public gnewcryptxml
gnewcryptfll=.F.
gnewcryptxml=.F.
Store -1 To gTransferTotal
Store -1 To gnhandle
gcmdCancelDownload=.F.
_Screen.Visible = (_VFP.StartMode <> 2)
_Screen.AutoCenter = .T.
_Screen.Caption = "ROA Romfast Applications"
_Screen.MaxButton=.F.
_Screen.BorderStyle=2
_Screen.Closable=.T.
_Screen.Icon=[ROASTART.ICO]
Public gcNumeProgram
gcNumeProgram = 'ROASTART'
Private gcCopyRight
gcCopyRight = '<27> ROA Romfast SRL'
*tparam=myinstance(JUSTPATH(SYS(16,0)))
Set Deleted On
Set Century On
Set Date Dmy
Set Safety Off
Set Console Off
Set NullDisplay To '*'
Set Seconds Off
Set Excl Off
Set Status Off
Set Status Bar Off
Set Exact On
Set Ansi On
Set Hours To 24
Set Sysmenu Off
Local lcMainClassLib
Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
*-- Save and configure environment.
lcLastSetTalk=Set("TALK")
Set Talk Off
lcLastSetPath=Set("PATH")
*** variabile publice
*!* Public gcAppPath,gcDatePath,buton,gctemppath,gcDirMare,gcDateRetea, gcSecurityPath, gcSecurityFile
*!* Store 2 To buton
*!* Store "" To gctemppath
Declare Integer GetPrivateProfileString In Kernel32 ;
string, String, String, String @, Integer, String
Declare Integer WritePrivateProfileString In Kernel32 ;
string, String, String, String
Declare Integer CopyFile In kernel32;
STRING lpExistingFileName,;
STRING lpNewFileName,;
INTEGER bFailIfExists
Declare Integer URLDownloadToFile In urlmon.Dll;
INTEGER pCaller, String szURL, String szFileName,;
INTEGER dwReserved, Integer lpfnCB
Declare Integer PathFileExists In shlwapi;
STRING pszPath
*!* modificare v 2.0.23
Declare ExitProcess In WIN32API Integer
*!* modificare v 2.0.23 ^
Push Menu _Msysmenu
***************************************************************
Public gcAppPath,gcAppName,gcDirMare,gcSecurityFile,gcTempPath
Public plEroare
Store .F. To plEroare
Public goApi
SET PROCEDURE TO "D:\ROA\ROASTART\COMUN\utile\web\wwAPI.prg" ADDITIVE
SET PROCEDURE TO "D:\ROA\ROASTART\COMUN\utile\web\wwUtils.prg" ADDITIVE
goApi = CREATEOBJECT("wwAPI")
gcTempPath = Addbs(shortpath(goApi.GetTempPath())) && WWAPI.PRG
gcAppPath = Addbs(shortpath(STRTRAN(GetAppStartPath(),'PROGRAME\','',1,1,1)))
gcAppName=Juststem(Sys(16,0))
liat=Rat("\",gcAppPath,2)
gcDirMare=Left(gcAppPath,liat)
*!* gcDateRetea=gcDirMare+"DateRetea\"
DIRGEN = gcDirMare
gcDatePath=gcAppPath+"\Data\"
*!* modificare v 2.0.14
*!* gcComunPath=Addbs(gcDirMare)+"comun\"
gcComunPath=Addbs(gcDirMare)+"COMUNROA\"
*!* modificare v 2.0.14 ^
gcSecurityPath = gcDirMare + 'Security\'
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
SET DEFAULT TO (m.gcAppPath)
lcPath = gcAppPath + 'Date;' + ;
gcAppPath + 'Include;' + ;
gcAppPath + 'FERESTRE;' + ;
gcAppPath + 'GRAFICE;' + ;
gcAppPath + 'CLASE;' + ;
gcAppPath + 'MENIURI;' + ;
gcAppPath + 'PROGRAME;' + ;
gcAppPath + 'RAPOARTE;' + ;
gcAppPath + 'COMUN\CLASE;' + ;
gcAppPath + 'COMUN\FERESTRE;' + ;
gcAppPath + 'COMUN\PROGRAME;' + ;
gcAppPath + 'COMUN\GRAFICE;' + ;
gcAppPath + 'COMUN\INCLUDE;' + ;
gcAppPath + 'COMUN\RAPOARTE;' + ;
gcAppPath + 'COMUN\UTILE\CTL32;' + ;
gcAppPath + 'COMUN\UTILE\HPDF;' + ;
gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
gcAppPath + 'COMUN\UTILE\WEB;' + ;
Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\]
SET PATH TO &lcPath ADDITIVE
*!* Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive && modificare v 2.0.14
***************************************************************
lcLastSetClassLib=Set("CLASSLIB")
*!* lcMainClassLib="libs\"+gcAppName
lcMainClassLib = gcAppPath + "clase\ostart.vcx"
Set Classlib To (lcMainClassLib) Additive
Set Classlib To registry Additive
Set Classlib To decabaza Additive
Set Classlib To ofundal Additive
Set Classlib To ofundal_start Additive
Set Classlib To ostart_init Additive
Set Classlib To ostart_grup Additive
Set Classlib To ostart_util Additive
Set Classlib To ostart_admin Additive
Set Classlib To scrollcontainer Additive
Set Classlib To Messagebox Additive
Set Classlib To crypto Additive
Set Classlib To wwdialogs Additive
Set Classlib To ofirma Additive
*!* modificare v 2.0.23
Set Classlib To systray Additive
*!* modificare v 2.0.23 ^
SET CLASSLIB TO ctl32.vcx ADDITIVE
SET CLASSLIB TO appwiz_start.vcx ADDITIVE && modificare v 2.1.5
SET CLASSLIB TO accessibility.vcx ADDITIVE && modificare v 2.1.5
Set Procedure To wwcodeupdate Additive
Set Procedure To oproceduri_start Additive
Set Procedure To log_mesaje Additive
Set Procedure To oproceduri_ams Additive
Set Procedure To oproceduri_comune Additive
Set Procedure To proceduri_comune Additive
Set Procedure To gencursor Additive
Set Procedure To update_start Additive
Set Procedure To osecurity Additive
*!* 25.09.2006
*!* marius.mutu
Set Procedure To wwxmlhttp.prg Additive
*!* Set Procedure To wwutils.prg Additive
Set Procedure To WWHTTP.prg Additive
Set Procedure To ini.prg Additive
*!* 05.09.2007
*!* Vasile Cristian
Set Procedure To iniacces.prg Additive
Set Procedure To xmlaccess.prg Additive
Set Procedure To xmlparser.prg Additive
Set Procedure To Version.prg Additive
Set Procedure To filebringer.prg Additive
Set Procedure To procese.prg Additive
Set Procedure To updatecheck.prg Additive
Set Procedure To wwconfig.prg Additive
Set Procedure To oexport.prg Additive
Set Procedure To oupdate.prg Additive
If TooManyInstances(1) &&Too many instance already running?
Quit
Endif
*!* PRIVATE gcInstructiuniPath, gcRaportPath,gcAlfaPath
*!* modificare v 2.0.31
PUBLIC glFontCharSet
glFontCharSet = AFONT(laFontCharSet,"Arial Narrow",238)
*!* modificare v 2.0.31 ^
*!* Locale
Set Classlib To locale Additive
Private gcLocalePath, goLocale, glTraducere
gcLocalePath = gcAppPath + "Locale\"
glTraducere = .F.
lcLocaleDb = gcLocalePath + "locale.dbc"
Open Database (m.lcLocaleDb)
goLocale=Newobject("Locale","Locale.vcx")
lcFisierIni = shortpath(GetIniPath())
lcBuffer=Space(255)
*!* 16.01.2009
lcBuffer2=Space(255)
GetPrivateProfileString( "locale","llocale","", @m.lcBuffer2, Len(m.lcBuffer2), m.lcFisierIni)
lcBuffer2 = Strtran(m.lcBuffer2,Chr(0),"")
lcBuffer2 = Alltrim(m.lcBuffer2)
If Empty(lcBuffer2)
WritePrivateProfileString( "locale","llocale", '0' , m.lcFisierIni)
m.lcBuffer2='0'
Endif
If m.lcBuffer2<>'0'
goLocale.llocale=.T.
Endif
*!* 16.01.2009 ^
GetPrivateProfileString( "locale","lang","", @m.lcBuffer, Len(m.lcBuffer), m.lcFisierIni)
lcBuffer = Strtran(m.lcBuffer,Chr(0),"")
lcBuffer = Alltrim(m.lcBuffer)
If Empty(lcBuffer)
WritePrivateProfileString( "locale","lang", 'Romana' , m.lcFisierIni)
lcBuffer='Romana'
Endif
goLocale.locale = m.lcBuffer
*!* Locale ^
*!* modificare v 2.0.14
*!* Local loex17 As Exception
*!* Try
*!* gnewcryptfll=.T.
*!* Set Default To (gcComunPath)
*!* Set Library To vfpencryption.fll Additive
*!* Catch To loex17
*!* gnewcryptfll=.F.
*!* *MESSAGEBOX(loex17.Message)
*!* Endtry
*!* modificare v 2.0.14 ^
*set library to bbDownLoadURL.fll additive
#include registry.h
*!* **variabile publice care imi folosesc in start pentru nivelele de acces
*!* Public id_utilizator,nivel_acces
*!* Store 0 To id_utilizator
*!* Store .F. To nivel_acces
Public poLog, goLog && obiect pt logarea mesajelor sistemului ; modificare v 2.1.2 : am adaugat goLog
Local lcLog
poLog = Newobject("Log_Mesaje","Log_Mesaje.prg")
lcLog = [0]
goLog = poLog && modificare v 2.1.2
poLog.Log(lcLog,Program())
Public gcHost,gnIdUtil,gcUtil,gcuserName,gcPassword,glIntrat,gcUserNameApp,gnButon,glSupervizor,glAdministrator,gcAcces,gcS
gcAcces="1;2;3;4;"
glSupervizor = .F.
glAdministrator = .F.
gnButon=1
glIntrat=.F.
gcHost = "jcsserver"
gcuserName = "contafin_ORACLE"
gcPassword = "123"
**variabile publice care imi folosesc in start pentru nivelele de acces
*!* gcInstructiuniPath = gcAppPath + 'Instructiuni\'
*!* gcRaportPath = gcAppPath + 'Raport\'
*!* gcAlfaPath = gcAppPath + 'Alfa\'
*!* If !Directory(gcRaportPath)
*!* Md (gcRaportPath)
*!* Endif
*!* If !Directory(gcAlfaPath)
*!* Md (gcAlfaPath)
*!* Endif
*!* If !Directory(gcInstructiuniPath)
*!* Md (gcInstructiuniPath)
*!* Endif
Private goExecutor,goExport
goExecutor = Createobject("oExecutor")
goExport = Createobject("oExportConfig")
&& obiect global wrap pentru sqlconnect, sqldisconnect; apeleaza proceduri postconectare pentru setare variabile sesiune
Private goConn
goConn = Createobject("oConn")
*!* modificare v 2.0.29
PRIVATE gnIdFirma
gnIdFirma = 0
*!* modificare v 2.0.29 ^
*!* 25.09.2006
*!* marius.mutu
Private gcGeneralIniFile, gcSettingsFile
gcGeneralIniFile = DIRGEN + "settings.ini"
gcSettingsFile = gcGeneralIniFile
If !File(gcGeneralIniFile)
TEXT TO lcSettings NOSHOW
[errors]
host=http://roa.romfast.ro:3000/errors/create_xml
ENDTEXT
Strtofile(lcSettings, gcGeneralIniFile)
Endif
*** Tin conexiunea deschisa. La wert??? apare eroarea odbc "timeout occured" daca se lasa peste 1 minut programul fara sa se lucreze
LOCAL lcKeepAlive, lnKeepAlive
PRIVATE goKeepAlive
lcKeepAlive = NVL(getini(m.gcGeneralIniFile,'update','keepalive_seconds'), '')
lnKeepAlive = 0
IF EMPTY(m.lcKeepAlive)
setini(m.gcGeneralIniFile,'update','keepalive_seconds', '0')
lnKeepAlive = 0
ELSE
lnKeepAlive = VAL(m.lcKeepAlive)
ENDIF
IF m.lnKeepAlive >= 5 && minim 5 secunde
goKeepAlive = NEWOBJECT("keepalive","ostart.vcx")
goKeepAlive.interval = m.lnKeepAlive * 1000
goKeepAlive.enabled = .T.
ENDIF
Private goMyXMLHTTP
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
goMyXMLHTTP = Createobject("MyXMLHTTP", lcHostErrors)
*************************
* Modificare IP: roa.romfast.ro in loc de 83.103.197.79
* settings.ini si tnsnames.ora
UpdateIniROA()
*************************
*!* lcLog = [1']
*!* poLog.Log(lcLog,Program())
lcOnShutdown="ShutDown()"
On Shutdown &lcOnShutdown
On Error ErrorHandler(Error(),Program(),Lineno())
*ON ERROR SUSPEND
_Shell="DO Cleanup IN progs\start"
*!* lap=Create("registry")
*!* *** verific cale temporare
*!* If lap.iskey("Contafin\temporare",-2147483647)=.T.
*!* lap.openkey("Contafin\temporare",-2147483647,.F.)
*!* gctemppath=lap.getkeyvalue("temp",)
*!* Else
*!* lap.openkey("Contafin\temporare",-2147483647,.T.)
*!* lcTempPath =[c:\contafin\temp\]
*!* gctemppath = lcTempPath
*!* If Directory(lcTempPath)
*!* lap.setregkey("temp",gctemppath,"Contafin\temporare",,.T.)
*!* Else
*!* lcError = On('error')
*!* On Error Teroare()
*!* Md (lcTempPath)
*!* On Error &lcError
*!* lap.setregkey("temp",gctemppath,"Contafin\temporare",,.T.)
*!* Endif
*!* Endif
*!* If !Directory(gctemppath)
*!* lcError = On('error')
*!* On Error Teroare()
*!* Md (gctemppath)
*!* On Error &lcError
*!* lap.setregkey("temp",gctemppath,"Contafin\temporare",,.T.)
*!* Endif
*!* gctemppath= Addbs(gctemppath)
**** verific cale_server_date
*!* lcCaleServerDate = []
*!* gcserver = "serverdate_"+Strtran(gcDirMare,"\","")
*!* *!* WAIT WINDOW gcserver
*!* If lap.iskey("contafin\"+gcserver,-2147483647)
*!* lap.openkey("contafin\"+gcserver,-2147483647,.F.)
*!* lcCaleServerDate=lap.getkeyvalue("cale",)
*!* If Empty(lcCaleServerDate) Or Type('lcCaleServerDate')!="C"
*!* lap.deletekey(-2147483647,"cale")
*!* lcCaleServerDate= gcDirMare
*!* lap.setregkey("cale",lcCaleServerDate,"contafin\"+gcserver,,.T.)
*!* Endif
*!* Else
*!* lcCaleServerDate= gcDirMare
*!* lap.setregkey("cale",lcCaleServerDate,"contafin\"+gcserver,,.T.)
*!* Endif
*!* gcCaleServerDate = lcCaleServerDate
**** verific numestatie
*!* lcNumeStatie = []
*!* If lap.iskey("contafin\"+gcserver,-2147483647)=.T.
*!* lap.openkey("contafin\"+gcserver,-2147483647,.F.)
*!* gcnumestatie=lap.getkeyvalue("numestatie",)
*!* If Empty(gcnumestatie) Or Type('gcNumeStatie')!="C"
*!* lap.deletekey(-2147483647,"numestatie")
*!* lcSys0 = Sys(0)
*!* gcnumestatie = Alltrim(Left(lcSys0,At("#",lcSys0)-1))
*!* lap.setregkey("numestatie",gcnumestatie ,"contafin\"+gcserver,,.T.)
*!* Endif
*!* Else
*!* lcSys0 = Sys(0)
*!* gcnumestatie = Alltrim(Left(lcSys0,At("#",lcSys0)-1))
*!* lap.setregkey("numestatie",gcnumestatie ,"contafin\"+gcserver,,.T.)
*!* Endif
*!* lcLog = [2]
*!* poLog.Log(lcLog,Program())
*!* Release lap
*!* Do totv
*!* Select cai
*!* lccaledir=Upper(Alltrim(gcDirMare))
*!* Locate For Strtran(Strtran(Upper(Alltrim(caleserver)),"\",""),":","")=Strtran(Strtran(lccaledir,"\",""),":","")
*!* If !Found()
*!* If Flock()
*!* Append Blank
*!* Replace caleserver With gcDirMare
*!* Replace numecale With "Contafin"
*!* Endif
*!* Endif
*!* ENDIF
*!* lcLog = [3]
*!* poLog.Log(lcLog,Program())
*!* Do v_util
*!* lcLog = [4]
*!* poLog.Log(lcLog,Program())
Local loex17 As Exception
Try
gnewcryptfll=.T.
Set Default To (gcComunPath)
Set Library To vfpencryption.fll Additive
Set Library To vfpcompression.fll Additive
Catch To loex17
gnewcryptfll=.F.
*MESSAGEBOX(loex17.Message)
Endtry
UpdateRoastart()
*!* modificare v 2.0.14 ^
*!* idstring=""
*!* Try
*!* idstring=Filetostr(gcDirMare+"USERREPORTS\Userreports_id.txt")
*!* Catch
*!* *MESSAGEBOX(gcDirMare)
*!* idstring="userreports"
*!* Endtry
*!* If idstring#""
*!* loUpdate = createobject("oUpdate")
*!* loUpdate.updatecheck(idstring,lotemp)
*!* Endif
*!* Release lotemp
*-- Instantiate application object.
Release goApp
Public goApp
goApp=Createobject("wzApplication")
*-- Configure application object.
*!* modificare v 2.0.29
*!* goApp.SetCaption("ROA Romfast Applications")
*!* goApp.cStartupMenu=gcAppPath+"menus\start.mpr"
*!* modificare v 2.0.29 ^
goApp.cStartupForm=gcAppPath+"ferestre\frm_fundal.scx"
goApp.SetCaption("ROA Romfast Applications")
*-- Show application.
goApp.Show
*-- Release application.
Release goApp
*-- Restore default menu.
Pop Menu _Msysmenu
*-- Restore environment.
On Error
On Shutdown
If Not lcLastSetClassLib==Set("classlib")
Release Classlib (lcMainClassLib)
Endif
If Empty(lcLastSetPath)
Set Path To
Else
Set Path To &lcLastSetPath
Endif
If lcLastSetTalk=="ON"
Set Talk On
Else
Set Talk Off
Endif
Return
*************************************************************************************************************************
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: "+Alltrim(Str(nLine))
If Not Empty(lcCodeLineMsg)
lcErrorMsg=lcErrorMsg+Chr(13)+Chr(13)+lcCodeLineMsg
Endif
Endif
If Type('goMyXMLHTTP') = 'O'
lcLunaHTTP = Iif(Type('gnLuna') = 'N', Transform(gnLuna) + "/","") + Iif(Type('GNAN') = 'N', Transform(gnAn),"")
lcErrorMsgHTTP = Sys(0) + ":" + Iif(Type('GCS')='C'," " + gcS,"") + ": " + lcLunaHTTP + Chr(13) +Chr(10) + lcErrorMsg + ;
CHR(13) +Chr(10) + Chr(13) + Chr(10) + GETCALLSTACK()
lcUserName = gcUserNameApp
lcProgram = Juststem(Sys(16,0))
goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
Endif
If _vfp.StartMode=0
Debug
Suspend
Endif
If AMESSAGEBOX(lcErrorMsg,17,_Screen.Caption)#1
On Error
Return .F.
Endif
Endfunc
*************************************************************************************************************************
Function Shutdown
&&&&
If Pemstatus(_Screen,"SemaphoreHandle",5)
Declare Integer ReleaseSemaphore In kernel32 Integer hSemaphore, Integer lReleaseCount, Integer @lpPreviousCount
Declare Integer CloseHandle In Kernel32 Integer hObject
ReleaseSemaphore(_Screen.SemaphoreHandle,1,0)
CloseHandle(_Screen.SemaphoreHandle)
Clear Dlls "ReleaseSemaphore", "CloseHandle"
Endif
&&&&
If plEroare=.T.
Quit
Endif
*!* ldel=Create("registry")
*!* ldel.openkey("contafin\"+gcserver,-2147483647,.F.)
*!* ldel.deletekey(-2147483647,"contafin\"+gcserver+"\util")
*!* Select programe
*!* Scan For Id#0
*!* ldel.deletekey(-2147483647,"contafin\"+gcserver+"\prog\"+Alltrim(Juststem(nume)))
*!* Endscan
*!* ldel.deletekey(-2147483647,"contafin\"+gcserver+"\prog")
*!* Release ldel
If Type("goApp")=="O" And Not Isnull(goApp)
Return goApp.OnShutDown()
Endif
Cleanup()
Quit
Endfunc
*************************************************************************************************************************
Function Cleanup
If Cntbar("_msysmenu")=7
Return
Endif
On Error
On Shutdown
Set Classlib To
Set Path To
Clear All
Close All
Pop Menu _Msysmenu
Return
*************************************************************************************************************************
*!* ***************************
*!* 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
*!* *************************************************************************************************************************
*!* ***************************
*!* 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
*************************************************************************************************************************
Function Teroare()
gcTempPath=Getdir("c:","Alegeti calea fisierelor temporare!","Alegeti directorul!",64)
Do While Empty(gcTempPath)
gcTempPath=Getdir("c:","Alegeti calea fisierelor temporare!","Alegeti directorul!",64)
Enddo
Endfunc
*** pentru goconn.connect
Procedure InitSesiune
ENDPROC
* --------------------------------------
* Modificare IP: roa.romfast.ro in loc de 83.103.197.79
* settings.ini si tnsnames.ora
* --------------------------------------
PROCEDURE UpdateIniROA
Local laDirs[1], lcDir, lcFile, lcInternetPath, lcIsURLROA, lcSkeletonDir, lcSuportVersionURL
Local lcText, lnDir, lnDirs, lnIsURLROA, lcErrorsHost, lcBaseDir
lcIsURLROA = NVL(getini(m.gcGeneralIniFile,'update','is_url_roa'), '')
lnIsURLROA = IIF(EMPTY(NVL(m.lcIsURLROA,'0')), 0, INT(VAL(m.lcIsURLROA)))
* Daca am modificat deja fisierul settings.ini si tnsnames.ora
IF m.lnIsURLROA = 1
RETURN
ENDIF
* settings.ini
lcErrorsHost = NVL(getini(m.gcGeneralIniFile,'errors','host'), '')
IF 'http://83.103.197.79'$m.lcErrorsHost
lcErrorsHost = STRTRAN(m.lcErrorsHost, 'http://83.103.197.79','https://roa.romfast.ro',1,1,1)
setini(m.gcGeneralIniFile,'errors','host', m.lcErrorsHost)
ENDIF
*!* lcInternetPath = NVL(getini(m.gcGeneralIniFile,'update','InternetPath'), '')
*!* IF '83.103.197.79'$m.lcInternetPath
*!* lcInternetPath = STRTRAN(m.lcInternetPath, '83.103.197.79','roa.romfast.ro',1,1,1)
*!* setini(m.gcGeneralIniFile,'update','InternetPath', m.lcInternetPath)
*!* ENDIF
lcSuportVersionURL = NVL(getini(m.gcGeneralIniFile,'update','suportversionurl'), '')
IF '83.103.197.79'$m.lcSuportVersionURL
lcSuportVersionURL = STRTRAN(m.lcSuportVersionURL , 'http://83.103.197.79:3002','https://roa.romfast.ro',1,1,1)
setini(m.gcGeneralIniFile,'update','suportversionurl', m.lcSuportVersionURL)
ENDIF
* tnsnames.ora
lcBaseDir = ADDBS(JUSTPATH(m.gcGeneralIniFile))
lcSkeletonDir = m.lcBaseDir + 'instantclient*'
lnDirs =ADIR(laDirs, m.lcSkeletonDir, "D")
FOR lnDir = 1 TO m.lnDirs
lcDir = m.lcBaseDir + laDirs[lnDir,1] + '\'
lcFile = m.lcDir + 'tnsnames.ora'
IF FILE(m.lcFile)
lcText = FILETOSTR(m.lcFile)
lcText = STRTRAN(m.lcText, '83.103.197.79','roa.romfast.ro',1,100,1)
STRTOFILE(m.lcText, m.lcFile)
ENDIF
ENDFOR
* am facut modificarile
setini(m.gcGeneralIniFile,'update','is_url_roa', '1')
ENDPROC && UpdateIniROA

1
Programe/security.h Normal file
View File

@@ -0,0 +1 @@
#DEFINE ENCRYPTKEY "233!do*32Di3-o23\409"

53
Programe/update_nomenclator.prg Normal file
View File

@@ -0,0 +1,53 @@
**********************************************************
PROCEDURE update_nomenclator
*!* *!* DO update_coresp_tip_part
*!* *!* DO update_coresp_tip_cont
*!* DO update_lunilean
*!* *** tabele meniu deschise din proiect
*!* LOCAL lcCaleDateMenu
*!* lcCaleDateMenu=gcAppPath+[DATEMENU\]
*!* IF !USED('XREQUEST')
*!* USE &lcCaleDateMenu.XREQUEST IN 0 ALIAS XREQUEST
*!* ENDIF
*!* IF !USED('xitems')
*!* USE &lcCaleDateMenu.xitems IN 0 ALIAS xitems
*!* ENDIF
*!* IF !USED('YACT')
*!* USE &lcCaleDateMenu.YACT IN 0 ALIAS YACT
*!* ENDIF
*!* IF !USED('XSETS')
*!* USE &lcCaleDateMenu.XSETS IN 0 ALIAS XSETS ORDER TAG ID_SET
*!* ENDIF
*!* IF !USED('xACT')
*!* USE &lcCaleDateMenu.xACT IN 0 ALIAS xACT
*!* ENDIF
*!* IF !USED('xnote')
*!* USE &lcCaleDateMenu.xnote IN 0 ALIAS xnote
*!* ENDIF
*!* IF !USED('menu1')
*!* USE &lcCaleDateMenu.menu1 IN 0 ALIAS menu1 EXCL
*!* ENDIF
*!* IF !USED('INFISIERE')
*!* USE &lcCaleDateMenu.INFISIERE IN 0 ALIAS INFISIERE
*!* ENDIF
*!* IF !USED('nom_meniu')
*!* USE &lcCaleDateMenu.nom_meniu IN 0 ALIAS nom_meniu
*!* ENDIF
*!* IF !USED('refaceri')
*!* USE &lcCaleDateMenu.refaceri IN 0 ALIAS refaceri
*!* ENDIF
*!* IF !USED('tabela_fisa_cont')
*!* USE &lcCaleDateMenu.tabela_fisa_cont IN 0 ALIAS tabela_fisa_cont
*!* ENDIF
ENDPROC && update_nomenclator

229
Programe/update_start.prg Normal file
View File

@@ -0,0 +1,229 @@
******************************************************************************
Procedure citeste_drepturi
Lparameters tnIdGrup,tnIdProgram
lcCursor = [v_obiectegrup]
If Used(lcCursor)
*!* Select v_obiectegrup
*!* Locate For id_firma=gnIdFirma
*!* If Found()
*!* Return
*!* Else
Use In (lcCursor)
*!* Endif
Endif
lcSql=[select cheie from vdef_grup_obiecte_prog ]+;
[where id_grup=]+Alltrim(Str(tnIdGrup))+[ and id_program=]+Alltrim(Str(tnIdProgram))
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
If lnSucces < 0
aMessagebox(goExecutor.cEroare,0+16,'Eroare')
Return
Endif
Endproc
******************************************************************************
Procedure viz_prg_instalat
If Used('v_programe_instalate')
Use In v_programe_instalate
Endif
*!* lcSql = [select * from vdef_util_programe where id_util=]+Alltrim(Str(gnIdUtil))+;
*!* [ order by ordine]
lcSql = [{call pack_drepturi.programe_utilizator(]+ALLTRIM(STR(gnIdUtil))+[)}]
lcCursor = [v_programe_instalate]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure viz_optiuni_prg
If Used('v_optiuni_programe')
Use In v_optiuni_programe
Endif
lcSql = [select * from vdef_util_optiuni where id_util=]+Alltrim(Str(gnIdUtil))+;
[ order by ordine]
lcCursor = [v_optiuni_programe]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_firme_util
If Used('v_organigrama_fu')
Use In v_organigrama_fu
Endif
lcSql = [select * from vdef_organigrama_firme_util]
lcCursor = [v_organigrama_fu]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_firme_grup
If Used('v_organigrama_fg')
Use In v_organigrama_fg
Endif
lcSql = [select * from vdef_organigrama_firme_grup]
lcCursor = [v_organigrama_fg]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_programe_firme
If Used('v_organigrama_pf')
Use In v_organigrama_pf
Endif
lcSql = [select * from vdef_organigrama_prog_firme]
lcCursor = [v_organigrama_pf]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_programe_util
If Used('v_organigrama_pu')
Use In v_organigrama_pu
Endif
lcSql = [select * from vdef_organigrama_programe_util]
lcCursor = [v_organigrama_pu]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_programe_grup
If Used('v_organigrama_pg')
Use In v_organigrama_pg
Endif
lcSql = [select * from vdef_organigrama_programe_grup]
lcCursor = [v_organigrama_pg]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_util_firme
If Used('v_organigrama_uf')
Use In v_organigrama_uf
Endif
lcSql = [select * from vdef_organigrama_util_firme]
lcCursor = [v_organigrama_uf]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_util_grup
If Used('v_organigrama_ug')
Use In v_organigrama_ug
Endif
lcSql = [select * from vdef_organigrama_util_grup]
lcCursor = [v_organigrama_ug]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_organigrama_grupuri
If Used('v_organigrama')
Use In v_organigrama
Endif
lcSql = [select * from vdef_organigrama_grupuri]
lcCursor = [v_organigrama]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_programe
Lparameters tnIdGrup
If Used('v_programe')
Use In v_programe
Endif
If Empty(tnIdGrup)
lcSql = [select ide_program,nume from vdef_programe where instalat=1 order by nume]
Else
lcSql = [{call pack_drepturi.programe_grup(]+Alltrim(Str(tnIdGrup))+[)}]
Endif
lcCursor = [v_programe]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_obiecte_prog
Lparameters tnIdGrup,tnIdProgram
If Used('v_obiecte')
Use In v_obiecte
Endif
lcSql = [select * from vdef_obiecte where id_program=]+Alltrim(Str(tnIdProgram))+;
[ order by cale]
*!* lcSql = [{call pack_drepturi.obiecte_program(]+Alltrim(Str(tnIdGrup))+[,]+;
*!* Alltrim(Str(tnIdProgram))+[)}]
lcCursor = [v_obiecte]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
If lnSucces<0
aMessagebox(goExecutor.cEroare+" "+lcSql)
Endif
goExecutor.oReset()
Endproc
******************************************************************************
*!* modificare v 2.0.25
*!* Procedure update_obiecte_grup
*!* Lparameters tnIdGrup
*!* If Used('v_obiectegrup')
*!* Use In v_obiecte
*!* Endif
*!* lcSql = [select * from vdef_grup_drept_obiecte where id_grup=]+Alltrim(Str(tnIdGrup))+;
*!* [ order by id_obiect]
*!* lcCursor = [v_obiectegrup]
*!* lnSucces = goExecutor.oExecute(lcSql,lcCursor)
*!* goExecutor.oReset()
*!* Endproc
*!* modificare v 2.0.25 ^
******************************************************************************
Procedure update_grupuri
If Used('v_grupuri')
Use In v_grupuri
Endif
lcSql = [select * from vdef_grup order by grup]
lcCursor = [v_grupuri]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_firme
If Used('v_firme')
Use In v_firme
Endif
If Used('v_firmeo')
Use In v_firmeo
Endif
lcSql = [select id_firma,firma from v_nom_firme order by firma]
lcCursor = [v_firmeo]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Create Cursor v_firme(id_firma N(10),firma C(100))
Select v_firme
Append Blank
Replace id_firma With -1,firma With "<<TOATE FIRMELE>>"
Insert Into v_firme(id_firma,firma) Select id_firma,firma From v_firmeo Order By firma
If Used('v_firmeo')
Use In v_firmeo
Endif
Endproc
******************************************************************************
Procedure update_nom_programe
If Used('vnom_programe')
Use In vnom_programe
Endif
lcSql = [select id_program,denumire as nume from vnom_programe order by 2]
lcCursor = [vnom_programe]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
goExecutor.oReset()
Endproc
******************************************************************************
Procedure update_grup_prog
If Used('vgrup_programe')
Use In vgrup_programe
Endif
lcSql = [select id_grup_prog,explicatie,ordine from vdef_grup_programe ]+;
[order by ordine]
lcCursor = [vgrup_programe]
lnSucces = goExecutor.oExecute(lcSql,lcCursor)
If lnSucces<0
aMessagebox(goExecutor.cEroare+" "+lcSql)
Endif
goExecutor.oReset()
Endproc
******************************************************************************

222
Programe/updatecheck.prg Normal file
View File

@@ -0,0 +1,222 @@
*!* 24.11.2016
*!* marius.mutu
*!* UpdateRoastart - nu mai verific romfast_suport.exe de pe site-ul romfast.ro. Unele calculatoare nu au internet si sta mult sa verifice.
#Define crlf Chr(13)+Chr(10)
Procedure citeste_server_info
Local lColNumeServer, lcSelect, lcCursor, lnSucces
lcSelect = "select distinct f.nume_server ;
from nom_firme f inner join def_util_grup ug on ;
f.id_firma = ug.id_firma and ug.id_util = " + Transform(gnIdUtil) + ;
" where f.sters = 0 and ug.sters = 0"
lcCursor = "crsServerUtil"
lnSucces = goExecutor.oExecute(lcSelect, lcCursor)
lColNumeServer = lnSucces > 0
lcSelect = "SELECT VALUE,ID_SERVER_INFO FROM SERVER_INFO where Name='NAME'"
lcCursor = "crstempsrv"
lnSucces = goExecutor.oExecute(lcSelect, lcCursor)
If lColNumeServer
Select c.* From crstempsrv c INNER Join crsServerUtil S On c.Value=S.nume_server Into Cursor crstempsrv1
Use In crstempsrv
Select * From crstempsrv1 Into Cursor crstempsrv
Endif
If Used('crsserverinfo')
Use In crsserverinfo
Endif
Create Cursor crsserverinfo (Value c(35),id_server_info N(3))
If lnSucces > 0
Insert Into crsserverinfo Select Alltrim(Substr(Value,1,35)),id_server_info From crstempsrv Order By id_server_info
Select crsserverinfo
Go Top
Endif
If Used('crstempsrv')
Use In crstempsrv
Endif
Endproc
********************************************
* Verifica daca programul care ruleaza
* este la ultima versiune de pe server
********************************************
Procedure UpdateRoastart
Local iniHandler As Object,lnTipFisier,lcdefa,lnTipActualizare,loUpdatei
IF !DIRECTORY(gcSecurityPath)
MD (gcSecurityPath)
ENDIF
llXMLStart=.T.
polog.Log("S-a pornit actualizarea Roastart.xml.",Program())
lotemp=Createobject("EditBox")
If !File(gcDirMare+"settings.ini")
updatecheckfiles("settings.ini")
Endif
iniHandler=Createobject("iniaccess")
loUpdatei = Createobject("oUpdate",[ROASTART],loTemp)
If Type('loUpdatei') = 'O'
*!* modificare v 2.1.8 : romfast_suport.exe
* loUpdatei.updatecheckTxt([romfast_suport], .T.) && nu mai verific romfast_suport de pe site-ul romfast.ro, pentru ca sunt unele calculatoare fara acces la internet si dureaza mult verificarea
*!* modificare v 2.1.8 ^
loUpdatei.createUpdateCursor("cRoastartXml")
Select cRoastartXml
Scan
If !Deleted()
lcitem=UPPER(Alltrim(cRoastartXml.Item))
lnTipActualizare = IIF(lcItem = [ROASTART],2,1)
Do Case
Case Upper(Alltrim(Left(lcitem,4)))="USER" Or Like("*_USER*",Upper(lcitem))
lcitem = Iif(Upper(Alltrim(Left(lcitem,4)))="USER",lcitem,Substr(lcitem,At("_USER",lcitem)+1))
idstring=""
Try
idstring=Filetostr(gcDirMare+lcitem+"\"+lcitem+"_id.txt")
Catch
idstring=Upper(Alltrim(lcitem))
Endtry
If idstring#""
loUpdatei.updatecheck(idstring,.F.,lnTipActualizare,lcitem)
lnRecno = Recno()
Delete From cRoastartXml Where Like("*"+lcitem+"*",Item)
Go lnRecno
Endif
Case Upper(Alltrim(lcitem))="SECURITY"
Delete File(gcSecurityPath+"ROA_SECURITY.TXT")
Otherwise
loUpdatei.updatecheck(lcitem,.F.,lnTipActualizare)
Endcase
Endif
Endscan
If Used("cRoastartXml")
Use In cRoastartXml
Endif
If !File(gcSecurityPath+"ROA_SECURITY.TXT")
updatecheckfiles("ROA_SECURITY.XML",.T.) && modificare 25.06.2012 : sa nu mai apara mesajul de eroare daca nu exista ROA_SECURITY.XML pe server
Endif
Endif
Release lotemp,loUpdatei
Endproc
Function UpdatePrograme
#Define crlf Chr(13)+Chr(10)
Local lcdefa,loUpdates
polog.Log("S-a pornit formularul de actualizari in masa.",Program())
loUpdates=Createobject("oUpdate",IIF(Reccount('crsserverinfo') = 0,[],Alltrim(crsserverinfo.Value)))
iniHandler=Createobject("iniaccess")
If Type('loUpdates') = 'O'
Local lcLanPath
If (iniHandler.getDefault()="NetworkPath")
lcdefa=Alltrim(Sys(5))+Curdir()
cale=iniHandler.getNetworkPath()
polog.Log("Calea de retea : "+ADDBS(cale),Program())
Try
Set Default To Justpath(Alltrim(cale))
Catch
aMessagebox("Nu s-a putut ajunge la calea de retea.",16,"Eroare")
polog.Log("Nu s-a putut ajunge la "+ADDBS(cale),Program())
Return .F.
Endtry
If Reccount('crsserverinfo') = 0
polog.Log("NU exista tabela SERVER_INFO",Program())
Else
***!* Daca exista fisierul xml pentru un server
****
lcServerName = Alltrim(crsserverinfo.Value)
polog.Log("Se aduce lista programelor din "+Addbs(cale)+lcServerName+".xml",Program())
Select cProgrameUpdate
*!* Parcurgere programe
Scan
lcidentifier=cProgrameUpdate.nume
XmlData=loUpdates.getVersion(Alltrim(lcidentifier)) &&se verifica versiunea
Select cProgrameUpdate
If(XmlData#"nu s-a putut conecta" And XmlData#"<>(){}")
If(Not Compareversion(stripXmlVersion(XmlData),XmlData,Alltrim(lcidentifier),.T.))
*!* Daca versiunea programului este aceeasi cu cea din xml nu se mai trece in lista
Delete
Else
*!* modificare v 2.0.6
*!* Scatter Name oTest Blank
Scatter Name oTest Fields versiune,imagine
*!* modificare v 2.0.6 ^
*UPDATE cProgrameUpdate SET versiune="&lcVersionData" WHERE nume=lcidentifier
oTest.versiune=stripXmlVersion(XmlData)
*!* modificare v 2.0.6
If Not File(oTest.imagine)
oTest.imagine="na.png"
Endif
*!* Gather Name oTest Fields versiune
Gather Name oTest Fields versiune,imagine
*!* modificare v 2.0.6 ^
Endif
Else
Delete
Endif
Endscan
*!* Curatari----------------&&|
Set Default To (lcdefa) &&|
Go Top &&|
*!* ---------------------------
****
Endif
Else
*!* ------------------ web
*-------------------------
*!* clocalfile=Alltrim(Sys(5))+Alltrim(Curdir())+"temp.txt"
*!* loUpdate=Createobject("wwCodeUpdate")
*!* polog.Log("Calea de internet : "+iniHandler.getURL(),Program())
If Reccount('crsserverinfo') = 0
polog.Log("NU s-a gasit tabela Server_Info",Program())
Else
lcServerName = Alltrim(crsserverinfo.Value)
Select cProgrameUpdate
*!* Parcurgere programe
Scan
lcidentifier=cProgrameUpdate.nume
XmlData=loUpdates.getVersion(Alltrim(cProgrameUpdate.nume)) &&se verifica versiunea
polog.Log("Se cauta in "+lcServerName+".XML programul : "+Alltrim(lcidentifier),Program())
If(XmlData#"nu s-a putut conecta" And XmlData#"<>(){}")
If(Not Compareversion(stripXmlVersion(XmlData),XmlData,Alltrim(lcidentifier),.T.))
polog.Log("Programul din XML are aceeasi versiune cu programul de pe disc.Nu se mai adauga in lista",Program())
*!* Daca versiunea programului este aceeasi cu cea din xml nu se mai trece in lista
Delete
Else
polog.Log("Programul din XML este diferit fata de programul de pe disc.Se adauga in lista : "+Alltrim(lcidentifier)+" "+Alltrim(stripXmlVersion(XmlData)),Program())
Select cProgrameUpdate
Scatter Name oTest Fields versiune,imagine
*UPDATE cProgrameUpdate SET versiune="&lcVersionData" WHERE nume=lcidentifier
oTest.versiune=stripXmlVersion(XmlData)
If Not File(oTest.imagine)
oTest.imagine="na.png"
Endif
Gather Name oTest Fields versiune,imagine
Endif
Else
*!* Daca pentru program nu s-a gasit un fisier xml nu se mai verifica versiunea
*!* se sterge direct din lista
Delete
Endif
*!* /Parcurgere programe
Endscan
Endif
Endif
Release loUpdates
Release iniHandler
Return .T.
Else
Return .F.
Endif
Endfunc