sync SVN r18175

This commit is contained in:
2026-09-17 22:44:25 +03:00
parent c1966421e5
commit fb38ab99d6
3 changed files with 297 additions and 9 deletions

View File

@@ -15,6 +15,8 @@ DEFINE CLASS actualizare_curs_bnr AS _custom OF "_baza.vcx"
*m: scrie_curs_bnr
*p: ccursor
*p: clink
*p: clinkan
*p: clinkarhiva
*p: ctempfile
*p: ddata
*p: ncurs
@@ -26,6 +28,8 @@ DEFINE CLASS actualizare_curs_bnr AS _custom OF "_baza.vcx"
*<PropValue>
ccursor = ccrsbnr
clink = https://curs.bnr.ro/nbrfxrates.xml
clinkan = https://curs.bnr.ro/files/xml/years/nbrfxrates%.xml
clinkarhiva = https://curs.bnr.ro/nbrfxrates10days.xml
ctempfile = C:\temp\temp.xml
ddata = {}
Height = 17
@@ -37,6 +41,8 @@ DEFINE CLASS actualizare_curs_bnr AS _custom OF "_baza.vcx"
_memberdata = <VFPData>
<memberdata name="ctempfile" display="cTempFile"/>
<memberdata name="clink" display="cLink"/>
<memberdata name="clinkan" display="cLinkAn"/>
<memberdata name="clinkarhiva" display="cLinkArhiva"/>
<memberdata name="ccursor" display="cCursor"/>
<memberdata name="ddata" display="dData"/>
<memberdata name="ntip" display="nTip"/>
@@ -98,8 +104,13 @@ DEFINE CLASS actualizare_curs_bnr AS _custom OF "_baza.vcx"
ENDPROC
PROCEDURE citeste_curs_bnr
Lparameters tnSursa
Local loHTTP As 'winHTTP.winHTTPrequest.5.1'
Local lcData, lcFisier, lcServer
Local lcData, lcFisier, lcServer, lcCubeCautat, ldCandidat, lnIncercari, lnAnCautat, llRetrasAnAnterior, lnStatus
If Vartype(tnSursa) <> "N"
tnSursa = 0
Endif
If Empty(This.cCursor)
This.cCursor = [ccrsbnr]
@@ -109,30 +120,90 @@ DEFINE CLASS actualizare_curs_bnr AS _custom OF "_baza.vcx"
Use In (This.cCursor)
Endif
lcServer = This.cLink
Do Case
Case tnSursa = 1
lcServer = This.cLinkArhiva
Case tnSursa = 2
lnAnCautat = Year(This.dData - 1)
lcServer = Strtran(This.cLinkAn,"%",Alltrim(Str(lnAnCautat)))
Otherwise
lcServer = This.cLink
Endcase
loHTTP = Createobject('winHTTP.winHTTPrequest.5.1')
loHTTP.Open('GET', lcServer, .F.)
loHTTP.SetTimeouts(5000,5000,5000,15000)
loHTTP.setRequestHeader("Content-Type", "application/xml;")
poLog.Log(m.lcServer)
loHTTP.Send()
Try
loHTTP.Send()
lnStatus = loHTTP.Status
Catch
lnStatus = 0
Endtry
If loHTTP.Status = 200
If lnStatus = 200
lcFisier = loHTTP.Responsebody
lcFisier = Strextract(lcFisier,[</OrigCurrency>],[</Body>])
lcData = Strextract(lcFisier,[date="],["])
lcFisier= Strtran(lcFisier,[date="]+lcData+["],[])
If tnSursa = 0
lcData = Strextract(lcFisier,[date="],["])
lcFisier= Strtran(lcFisier,[date="]+lcData+["],[])
Else
lcCubeCautat = []
ldCandidat = This.dData - 1
lnIncercari = 0
llRetrasAnAnterior = .F.
Do While Empty(lcCubeCautat) And lnIncercari < 10
If tnSursa = 2 And Year(ldCandidat) < lnAnCautat And !llRetrasAnAnterior
llRetrasAnAnterior = .T.
lnAnCautat = lnAnCautat - 1
lcServer = Strtran(This.cLinkAn,"%",Alltrim(Str(lnAnCautat)))
loHTTP = Createobject('winHTTP.winHTTPrequest.5.1')
loHTTP.Open('GET', lcServer, .F.)
loHTTP.SetTimeouts(5000,5000,5000,15000)
loHTTP.setRequestHeader("Content-Type", "application/xml;")
poLog.Log(m.lcServer)
Try
loHTTP.Send()
lnStatus = loHTTP.Status
Catch
lnStatus = 0
Endtry
If lnStatus <> 200
repune_backup_cursoare(This.cCursor)
Release loUpdate,loIp,loUrl,lcData,lnSize,lcFisier,lcData
Return 1
Endif
lcFisier = Strextract(loHTTP.Responsebody,[</OrigCurrency>],[</Body>])
Endif
lcData = Str(Year(ldCandidat),4) + "-" + Padl(Alltrim(Str(Month(ldCandidat))),2,"0") + "-" + Padl(Alltrim(Str(Day(ldCandidat))),2,"0")
lcCubeCautat = Strextract(lcFisier,[<Cube date="]+lcData+[">],[</Cube>])
ldCandidat = ldCandidat - 1
lnIncercari = lnIncercari + 1
Enddo
If Empty(lcCubeCautat)
repune_backup_cursoare(This.cCursor)
Release loUpdate,loIp,loUrl,lcData,lnSize,lcFisier,lcData
Return 2
Endif
lcFisier = [<Cube>] + lcCubeCautat + [</Cube>]
Endif
lcFisier= Strtran(Strtran(lcFisier,[">],[" curs="]),[</Rate>],[" />])
Xmltocursor(lcFisier,This.cCursor)
This.dData = Ttod(Ctot(lcData+[T000000]))+1
If tnSursa = 0
This.dData = Ttod(Ctot(lcData+[T000000]))+1
Endif
*!* modificare 03.06.2013
sterge_backup_cursoare(This.cCursor)
Else
repune_backup_cursoare(This.cCursor)
Release loUpdate,loIp,loUrl,lcData,lnSize,lcFisier,lcData
Return 1
Endif
*!* modificare 03.06.2013 ^
Release loUpdate,loIp,loUrl,lcData,lnSize,lcFisier,lcData
Return 0
ENDPROC
PROCEDURE Destroy
@@ -168,9 +239,20 @@ DEFINE CLASS actualizare_curs_bnr AS _custom OF "_baza.vcx"
Case (This.dData = Ttod(ltDataOra) And Hour(ltDataOra) <13) Or (This.dData = Ttod(ltDataOra) + 1 And Hour(ltDataOra) >= 13)
This.citeste_curs_bnr()
Case This.dData < Ttod(ltDataOra) Or This.dData = Ttod(ltDataOra) And Hour(ltDataOra) >= 13
If amessagebox("Nu poate fi preluat automat cursul BNR. Doriti sa accesati pagina BNR?",4+32,"Confirmare") = 6
goUrl("http://www.bnr.ro") && din wwutils.prg
lnStareBnr = This.citeste_curs_bnr(1)
If lnStareBnr = 2
lnStareBnr = This.citeste_curs_bnr(2)
Endif
Do Case
Case lnStareBnr = 0
&& curs preluat din arhiva sau fisierul anual BNR
Case lnStareBnr = 2
amessagebox("Nu exista cursul BNR pentru data specificata!",48,"Atentie")
Otherwise
If amessagebox("Nu poate fi preluat automat cursul BNR. Doriti sa accesati pagina cursbnr.ro?",4+32,"Confirmare") = 6
goUrl("https://www.cursbnr.ro/")
Endif
Endcase
Otherwise
amessagebox("Nu exista cursul BNR pentru data specificata!",48,"Atentie")
Endcase