1230 lines
35 KiB
Plaintext
1230 lines
35 KiB
Plaintext
Define Class RoaApp As Custom
|
||
|
||
Dimension aVersiune[12]
|
||
Dimension aforms[1] && Forms collection for application object.
|
||
Dimension aformnames[1] && Form name collection for application object.
|
||
|
||
lParametri = .F.
|
||
cHost = Null
|
||
cUserName = Null
|
||
cPassword = Null
|
||
nIdUtil = 0
|
||
nIdProgram = 0
|
||
nAn = 0
|
||
nLuna = 0
|
||
cSchema = Null
|
||
nIdFirma = 0
|
||
cLastSetTalk = Null
|
||
cLastSetPath = Null
|
||
cLastSetClassLib = Null
|
||
cMainClassLib = Null
|
||
|
||
cNumeProgram = Null
|
||
cAppName = Null
|
||
cAppPath = Null
|
||
cUtilizatoriPath = Null
|
||
cDirMare = Null
|
||
|
||
cLocalePath = Null
|
||
lTraducere = .F.
|
||
oLocale = Null
|
||
|
||
cGeneralIniFile = Null
|
||
cSecurityFile = Null
|
||
lnewcryptxml = .T.
|
||
lnewcryptfll = .T.
|
||
|
||
lQuit = .F.
|
||
|
||
oLog = Null
|
||
oExecutor = Null
|
||
oConn = Null
|
||
oMyXMLHTTP = Null
|
||
oBaraFavorite = Null
|
||
oBaraManual = Null
|
||
oCalendar = Null
|
||
oExport = Null
|
||
|
||
lFontCharSet = .F.
|
||
|
||
cStartUpForm = ""
|
||
cStartUpMenu = "" && Menu (MPR) which is executed when the application object is shown.
|
||
Protected ccaption
|
||
ccaption = "" && Caption of the application object.
|
||
Protected cicon
|
||
cicon = "" && Icon of the application object.
|
||
Protected clasticon
|
||
clasticon = "" && Last icon setting of _screen before application object was intantiated.
|
||
Protected clastcaption
|
||
clastcaption = "" && Last caption setting of _screen before application object was intantiated.
|
||
nformcount = 0 && Forms collection count for application object.
|
||
npixeloffset = 22 && Number of pixels which offset multiple instances of the same form.
|
||
lcascadeforms = .T. && Specifies whether forms are cascaded if multiple instances of the same form are opened in the same top and left positions of the desktop.
|
||
lreadevents = .T. && Enable READ EVENTS within ReadEvents method.
|
||
Name = "roaapplication"
|
||
cReportPreviewer = ""
|
||
cReportPreviewerPath = ""
|
||
|
||
|
||
Function initializeaza
|
||
Lparameters tParametri,tcNumeProgram,tcMainClassLib
|
||
Local llReturn
|
||
llReturn = .F.
|
||
This.ResetFormsCollection()
|
||
This.cNumeProgram = tcNumeProgram
|
||
This.cMainClassLib = tcMainClassLib
|
||
If This.verificaProgram()
|
||
If This.citesteParametri(tParametri)
|
||
This.initializeazaFunctiiWin()
|
||
This.initializeazaEnv()
|
||
This.initializeazaCai()
|
||
This.initializeazaClassLib()
|
||
This.initializeazaProceduri()
|
||
This.initializeazaSettingsIni()
|
||
This.initializeazaSecurity()
|
||
This.initializeazaReportPreviewer()
|
||
This.initializeazaLocale()
|
||
This.initializeazaVariabile()
|
||
This.initializeazaVariabileGlobale()
|
||
This.initializeazaObiecte()
|
||
This.initializeazaObiecteGlobale()
|
||
llReturn = .T.
|
||
Endif
|
||
Endif
|
||
Return llReturn
|
||
Endfunc
|
||
|
||
Function verificaProgram
|
||
Local llReturn
|
||
llReturn = .T.
|
||
If !Like(This.cNumeProgram + '*', Upper(Alltrim(Juststem(Sys(16,0))))) AND _VFP.StartMode <> 0
|
||
Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
|
||
llReturn = .F.
|
||
Else
|
||
_Screen.Icon=This.cNumeProgram + [.ICO]
|
||
Endif
|
||
Return llReturn
|
||
Endfunc
|
||
|
||
Procedure initializeazaFunctiiWin
|
||
Declare Integer GetShortPathName In Win32API;
|
||
STRING @lpszLongPath, String @lpszShortPath,;
|
||
INTEGER cchBuffer
|
||
|
||
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 MoveFile In Win32API String @cSource, String @cTarget
|
||
|
||
Declare Integer DeleteFile In kernel32 String @pFileName
|
||
|
||
Declare Integer URLDownloadToFile In urlmon.Dll;
|
||
INTEGER pCaller, String szURL, String szFileName,;
|
||
INTEGER dwReserved, Integer lpfnCB
|
||
|
||
Declare Integer PathFileExists In shlwapi;
|
||
STRING pszPath
|
||
Endproc
|
||
|
||
Function ShortPath
|
||
Lparameter tcPath
|
||
Local lcPath, lcShortName, lnLength, lnResult
|
||
lcPath = tcPath
|
||
lcShortName = Space(260)
|
||
lnLength = Len(lcShortName)
|
||
lnResult = GetShortPathName(@lcPath, @lcShortName, lnLength)
|
||
If lnResult = 0
|
||
Return ""
|
||
Endif
|
||
Return Left(lcShortName,lnResult)
|
||
Endfunc
|
||
|
||
Function GetAppStartPath
|
||
Local lcPath
|
||
Do Case
|
||
*** VFP 6 provides ServerName property for COM servers EXE/DLL/MTDLL
|
||
Case Inlist(Application.StartMode,2,3,5)
|
||
lcPath = Justpath(Application.ServerName)
|
||
*!* *** Interactive
|
||
*!* CASE (Application.StartMode) = 0
|
||
*!* lcPath = SYS(5) + CURDIR()
|
||
*** Active Document
|
||
Case Atc(".APP",Sys(16,0)) > 0
|
||
lcPath = Justpath(Sys(16,0))
|
||
*** Standalone EXE or VFP Development
|
||
Otherwise
|
||
lcPath = Justpath(Sys(16,0))
|
||
If Atc("PROCEDURE",lcPath) > 0
|
||
lcPath = Substr(lcPath,Rat(":",lcPath)-1)
|
||
Endif
|
||
Endcase
|
||
Return Addbs(lcPath)
|
||
Endfunc
|
||
|
||
************************************************************************
|
||
* wwAPI :: CopyFile
|
||
*********************************
|
||
*** Function: Copies File. Faster than Fox Copy and handles
|
||
*** errors internally.
|
||
*** Pass: tcSource - Source File
|
||
*** tcTarget - Target File
|
||
*** tnFlag - 0* override, 1 don't
|
||
*** Return: .T. or .F.
|
||
************************************************************************
|
||
Function CopyFile
|
||
Lparameters lcSource, lcTarget, lnFlag
|
||
Local lnRetVal
|
||
|
||
*** Copy File and overwrite
|
||
lnFlag = Iif(Type("nFlag") = "N", nFlag, 0)
|
||
lnRetVal = CopyFile(m.lcSource, m.lcTarget, m.lnFlag)
|
||
|
||
Return Iif(m.lnRetVal = 0, .F., .T.)
|
||
Endproc
|
||
|
||
************************************************************************
|
||
* wwAPI :: MoveFile
|
||
*********************************
|
||
*** Function: Rename/Moves a file
|
||
*** Pass: tcSource - Source File
|
||
*** tcTarget - Target File
|
||
*** Return: .T. or .F.
|
||
************************************************************************
|
||
Function MoveFile
|
||
Lparameters lcSource, lcTarget
|
||
Local lnRetVal
|
||
|
||
lnRetVal = MoveFile(m.lcSource, m.lcTarget)
|
||
|
||
Return Iif(m.lnRetVal = 0, .F., .T.)
|
||
Endfunc
|
||
|
||
************************************************************************
|
||
* wwAPI :: MoveFile
|
||
*********************************
|
||
*** Function: Deletes a file
|
||
*** Pass: tcFile - File path
|
||
*** Return: .T. or .F.
|
||
************************************************************************
|
||
Function DeleteFile
|
||
Lparameters tcFile
|
||
Local lnRetVal
|
||
|
||
lnRetVal = DeleteFile(m.tcFile)
|
||
|
||
Return Iif(m.lnRetVal = 0, .F., .T.)
|
||
ENDFUNC
|
||
|
||
*--------------------------------------------
|
||
* Check file exist
|
||
* Return .T. / .F.
|
||
FUNCTION FileExist
|
||
LPARAMETERS tcFileName
|
||
LOCAL ARRAY laDirFiles[1,5]
|
||
LOCAL llExist
|
||
llExist = .F.
|
||
IF !EMPTY(m.tcFileName)
|
||
IF ADIR(laDirFiles, m.tcFileName) > 0
|
||
llExist = .T.
|
||
ENDIF
|
||
ENDIF
|
||
RETURN m.llExist
|
||
ENDFUNC && FileExist
|
||
|
||
*--------------------------------------------
|
||
Function ShowErrorEx
|
||
Lparameters toEx, tcMesaj
|
||
* tcMesaj (optional): mesaj suplimentar
|
||
Local loEx as Exception, lcMesaj
|
||
loEx = m.toEx
|
||
lcMesaj = IIF(!EMPTY(m.tcMesaj), ALLTRIM(TRANSFORM(m.tcMesaj)) + CHR(13) + CHR(10), '')
|
||
|
||
amessagebox(lcMesaj + ;
|
||
loEx.Message + Chr(13) + Chr(10) + ;
|
||
'Eroare #' + Alltrim(Str(loEx.ErrorNo)) + Chr(13) + Chr(10) + ;
|
||
'Linia #' + Alltrim(Str(loEx.Lineno)) + Chr(13) + Chr(10) + ;
|
||
'Procedura ' + loEx.Procedure + Chr(13) + Chr(10) + ;
|
||
'Cod ' + loEx.LineContents + CHR(13) + CHR(10) + ;
|
||
GETCALLSTACK(), 0 + 16, _Screen.Caption)
|
||
ENDFUNC
|
||
|
||
************************************************************************
|
||
Procedure Lista2Array
|
||
Lparameters tcLista,taArray,tcSeparator
|
||
&& tcLista este un sir de caractere care contine elementele separate prin <;> default
|
||
&& tarray este vectorul care se completeaza - trebuie dat prin referinta
|
||
&& tcSeparator separatorul de elemente din tcLista - default este ";" - este optional
|
||
&& intoarce numarul de elemente gasite
|
||
&& ex: lnNr = lista2array("ana;are;mere",@alista,";")
|
||
External Array taArray
|
||
Local Lclista,lcSeparator,lnNRF,lcF1,i
|
||
lnNRF = 0
|
||
|
||
Lclista=Allt(tcLISTA)
|
||
If Parameters()<3 Or Empty(tcSeparator)
|
||
lcSeparator=";"
|
||
Else
|
||
lcSeparator=Alltrim(tcSeparator)
|
||
Endif
|
||
|
||
If Right(Lclista,1)!=lcSeparator
|
||
Lclista=Lclista+lcSeparator
|
||
Endif
|
||
|
||
lnNRF=Occurs(lcSeparator,Lclista)
|
||
|
||
If lnNRF>0
|
||
Dimension taArray[lnNrf,1]
|
||
|
||
For i=1 To lnNRF
|
||
lcF1=Left(Lclista,At(lcSeparator,Lclista)-1)
|
||
|
||
If i!=lnNRF
|
||
Lclista=Substr(Lclista,At(lcSeparator,Lclista)+1)
|
||
Endif
|
||
|
||
taArray[i]=lcF1
|
||
Endfor
|
||
Else
|
||
lnNRF = 0
|
||
Endif
|
||
|
||
Return lnNRF
|
||
|
||
Endproc && lista2array
|
||
|
||
Function citesteParametri
|
||
Lparameters tParametri
|
||
Local llReturn, lcParametri, lnNr
|
||
Private paParametri
|
||
Declare paParametri[1]
|
||
llReturn = .T.
|
||
If Type('tParametri') = 'C'
|
||
This.lParametri = .T.
|
||
lcParametri = Alltrim(tParametri)
|
||
lnNr = This.lista2array(lcParametri,@paParametri,";")
|
||
Do Case
|
||
Case lnNr < 5
|
||
aMessagebox('Numar incorect de parametri',0+16,'Eroare')
|
||
llReturn = .F.
|
||
Case Type('paParametri',1)<>"A"
|
||
llReturn = .F.
|
||
Otherwise
|
||
This.cHost = paParametri[1]
|
||
This.cUserName = paParametri[2]
|
||
This.cPassword = paParametri[3]
|
||
This.nIdUtil = Round(Val(paParametri[4]),0)
|
||
This.nIdProgram = Round(Val(paParametri[5]),0)
|
||
If Alen(paParametri,1)=10
|
||
This.nAn = Val(paParametri[7])
|
||
This.nLuna = Val(paParametri[8])
|
||
This.cSchema = paParametri[9]
|
||
This.nIdFirma = Val(paParametri[10])
|
||
Endif
|
||
Endcase
|
||
Else
|
||
This.lParametri = .F.
|
||
This.cHost = ''
|
||
This.cUserName = ''
|
||
This.cPassword = ''
|
||
This.nIdUtil = 0
|
||
This.nIdProgram = 0
|
||
This.nAn = 0
|
||
This.nLuna = 0
|
||
This.cSchema = ''
|
||
This.nIdFirma = -1
|
||
Endif
|
||
Release paParametri, lcParametri, lnNr
|
||
Return llReturn
|
||
Endfunc
|
||
|
||
Procedure initializeazaEnv
|
||
This.cLastSetTalk = Set("TALK")
|
||
This.clastcaption=_Screen.Caption
|
||
This.clasticon=_Screen.Icon
|
||
This.lFontCharSet = AFONT(laFontCharSet,"Arial Narrow",238)
|
||
|
||
Push Menu _Msysmenu
|
||
Set Century On
|
||
Set Deleted On
|
||
Set Date To Dmy
|
||
Set Exclusive Off
|
||
Set Cpdialog Off
|
||
Set Talk Off
|
||
Set Safety Off
|
||
Set Escape Off
|
||
Set Exact On
|
||
Set Mark To '/'
|
||
Set Ansi On
|
||
Set Console Off
|
||
Set Notify Off
|
||
Set Seconds Off
|
||
Set NullDisplay To ''
|
||
Set Decimals To 4
|
||
Set Point To '.'
|
||
SET HOURS TO 24
|
||
Set SQLBUFFERING On
|
||
_Screen.Visible=.F.
|
||
_Screen.AutoCenter=.T.
|
||
|
||
* On Shutdown do onShutDown()
|
||
On Error goApp.ErrorHandler(Error(),Program(),Lineno())
|
||
Endproc
|
||
|
||
Procedure restaureazaEnv
|
||
On Error
|
||
On Shutdown
|
||
If Not Empty(This.clastcaption) And Not _Screen.Caption==This.clastcaption
|
||
_Screen.Caption=This.clastcaption
|
||
Endif
|
||
If Not Empty(This.clasticon) And Not _Screen.Icon==This.clasticon
|
||
_Screen.Icon=This.clasticon
|
||
Endif
|
||
If Not This.cLastSetClassLib==Set("classlib") AND !EMPTY(This.cMainClassLib)
|
||
Release Classlib (This.cMainClassLib)
|
||
Endif
|
||
If Empty(NVL(This.cLastSetPath, ''))
|
||
Set Path To
|
||
Else
|
||
Set Path To (This.cLastSetPath)
|
||
Endif
|
||
If This.cLastSetTalk=="ON"
|
||
Set Talk On
|
||
Else
|
||
Set Talk Off
|
||
Endif
|
||
|
||
If Cntbar("_msysmenu")=7
|
||
Return
|
||
Endif
|
||
Set Classlib To
|
||
Set Path To
|
||
* Clear All
|
||
|
||
* Close All
|
||
Pop Menu _Msysmenu
|
||
Endproc
|
||
|
||
Procedure initializeazaCai
|
||
This.cLastSetPath=Set("PATH")
|
||
This.cAppPath = Addbs(This.ShortPath(This.GetAppStartPath()))
|
||
If Right(This.cAppPath ,9)="PROGRAME\"
|
||
This.cAppPath = Substr(This.cAppPath ,1,Len(This.cAppPath )-9)
|
||
Endif
|
||
This.cAppName=Allt(Uppe(Juststem(Sys(16,0))))
|
||
This.cUtilizatoriPath = This.cAppPath + "UTILIZATORI\"
|
||
This.cDirMare = Addbs(Left(This.cAppPath,Rat("\",This.cAppPath,2)-1))
|
||
|
||
Set Default To (This.cAppPath)
|
||
lcPath = This.cAppPath + 'Date;' + ;
|
||
This.cAppPath + 'Include;' + ;
|
||
This.cAppPath + 'FERESTRE;' + ;
|
||
This.cAppPath + 'GRAFICE;' + ;
|
||
This.cAppPath + 'CLASE;' + ;
|
||
This.cAppPath + 'MENIURI;' + ;
|
||
This.cAppPath + 'PROGRAME;' + ;
|
||
This.cAppPath + 'RAPOARTE;' + ;
|
||
This.cAppPath + 'COMUN\CLASE;' + ;
|
||
This.cAppPath + 'COMUN\FERESTRE;' + ;
|
||
This.cAppPath + 'COMUN\PROGRAME;' + ;
|
||
This.cAppPath + 'COMUN\GRAFICE;' + ;
|
||
This.cAppPath + 'COMUN\RAPOARTE;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\CTL32;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\HPDF;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\WEB;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\CALENDAR;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\GridExtras;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\nfjson;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\tooltip;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\excel;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\Menu;' + ;
|
||
This.cAppPath + 'COMUN\UTILE\email;' + ;
|
||
This.cDirMare + 'COMUNROA\'
|
||
|
||
Set Path To &lcPath Additive
|
||
This.initializeazaAlteCai()
|
||
Endproc
|
||
|
||
Procedure initializeazaAlteCai
|
||
*!* suprascrisa in fiecare aplicatie care are cai suplimentare
|
||
*!* la sfarsit trebuie sa aiba SET PATH TO ... ADDITIVE
|
||
Endproc
|
||
|
||
Procedure initializeazaClassLib
|
||
This.cLastSetClassLib=Set("CLASSLIB")
|
||
If !Empty(Nvl(This.cMainClassLib,[]))
|
||
Set Classlib To (This.cMainClassLib) Additive
|
||
Endif
|
||
*!* _
|
||
Set Classlib To _calendar.vcx Additive
|
||
*!* A
|
||
Set Classlib To appwiz Additive
|
||
Set Classlib To accessibility Additive
|
||
*!* B
|
||
Set Classlib To baza Additive
|
||
*!* C
|
||
Set Classlib To CAUT Additive
|
||
Set Classlib To caut_ora Additive
|
||
Set Classlib To cauta_alfa_forms Additive
|
||
*!* D
|
||
Set Classlib To decabaza Additive
|
||
*!* F
|
||
Set Classlib To ferestre_cere_date Additive
|
||
Set Classlib To ferestre_oracle Additive
|
||
*!* L
|
||
Set Classlib To locale Additive
|
||
*!* M
|
||
Set Classlib To Messagebox Additive
|
||
*!* O
|
||
Set Classlib To ofirma Additive
|
||
*Set Classlib To onom_sal Additive
|
||
Set Classlib To onomenclatoare Additive
|
||
Set Classlib To ooptiuni Additive
|
||
*Set Classlib To opersonal Additive
|
||
Set Classlib To otoolbar Additive
|
||
SET CLASSLIB TO ocriterii ADDITIVE
|
||
*!* R
|
||
Set Classlib To registry Additive
|
||
*!* V
|
||
SET CLASSLIB TO vfpxworkbookxlsx ADDITIVE
|
||
*!* W
|
||
Set Classlib To wwdialogs Additive
|
||
|
||
|
||
This.initializeazaAlteClassLib()
|
||
|
||
Set Library To (This.cDirMare+[COMUNROA\vfpencryption.fll]) Additive
|
||
Endproc
|
||
|
||
|
||
Procedure initializeazaAlteClassLib
|
||
*!* suprascrisa in fiecare aplicatie care are clase suplimentare
|
||
Endproc
|
||
|
||
Procedure initializeazaProceduri
|
||
*!* _
|
||
Set Procedure To _libpdf Additive
|
||
*!* A
|
||
Set Procedure To acces_meniu Additive
|
||
Set Procedure To acces_meniu2 Additive
|
||
*!* B
|
||
Set Procedure To build_err_msgs Additive
|
||
*!* C
|
||
Set Procedure To cauta_alfa Additive
|
||
*!* F
|
||
Set Procedure To filebringer Additive
|
||
Set Procedure To frxoutput Additive
|
||
*!* G
|
||
Set Procedure To gencursor Additive
|
||
*!* I
|
||
Set Procedure To ini Additive
|
||
Set Procedure To iniacces Additive
|
||
Set Procedure To init_program Additive
|
||
*!* O
|
||
Set Procedure To ocautare Additive
|
||
Set Procedure To oExport Additive
|
||
Set Procedure To oinit_optiuni Additive
|
||
Set Procedure To onomenclatoare Additive
|
||
Set Procedure To ooperatii_comune Additive
|
||
Set Procedure To oproceduri_ams Additive
|
||
Set Procedure To oproceduri_comune Additive
|
||
Set Procedure To oproceduri_maintenance Additive
|
||
Set Procedure To osecurity Additive
|
||
Set Procedure To oupdate Additive
|
||
*!* P
|
||
Set Procedure To pdflistener Additive
|
||
Set Procedure To proceduri_comune Additive
|
||
Set Procedure To proceduri_Excel Additive
|
||
Set Procedure To procese.prg Additive
|
||
*!* R
|
||
SET PROCEDURE TO regex.prg ADDITIVE
|
||
*!* Q
|
||
Set Procedure To quitapp Additive
|
||
Set Procedure To updateserver Additive
|
||
*!* V
|
||
Set Procedure To validare Additive
|
||
Set Procedure To Version Additive
|
||
*!* W
|
||
Set Procedure To This.cAppPath + "\COMUN\UTILE\web\WWAPI.PRG" Additive
|
||
Set Procedure To wwconfig Additive
|
||
Set Procedure To wwcodeupdate Additive
|
||
Set Procedure To wwhttp Additive
|
||
Set Procedure To This.cAppPath + "\COMUN\UTILE\web\WWUTILS.PRG" Additive
|
||
Set Procedure To wwxmlhttp Additive
|
||
*!* X
|
||
Set Procedure To xmlaccess Additive
|
||
Set Procedure To xmlparser Additive
|
||
|
||
This.initializeazaAlteProceduri()
|
||
Endproc
|
||
|
||
Procedure initializeazaAlteProceduri
|
||
*!* suprascrisa in fiecare aplicatie care are proceduri suplimentare
|
||
Endproc
|
||
|
||
Procedure initializeazaLocale
|
||
Local lcObjLocale, lcLanguage, llLocale, lcLocale, lcLocalePath
|
||
lcLocalePath = This.cAppPath + "Locale\"
|
||
If Directory(lcLocalePath)
|
||
This.cLocalePath = lcLocalePath
|
||
This.lTraducere = .F.
|
||
Endif
|
||
lcLanguage = getini(This.cGeneralIniFile,"locale","lang")
|
||
llLocale = getini(This.cGeneralIniFile,"locale","llocale")
|
||
If Empty(lcLanguage) OR UPPER(m.lcLanguage) = 'ROMANA'
|
||
lcLocale = 'Romana'
|
||
lcObjLocale = [Locale_dummy]
|
||
Else
|
||
lcLocale = lcLanguage
|
||
lcObjLocale = [Locale]
|
||
Endif
|
||
This.oLocale=Newobject(lcObjLocale,"Locale.vcx")
|
||
If !Empty(llLocale) And llLocale<>'0'
|
||
This.oLocale.llocale=.T.
|
||
Endif
|
||
This.oLocale.locale = lcLocale
|
||
Release lcObjLocale, lcLanguage, llLocale, lcLocale, lcLocalePath
|
||
Endproc
|
||
|
||
Procedure initializeazaReportPreviewer
|
||
This.cReportPreviewer = "FoxyPreview"
|
||
This.cReportPreviewerPath = This.cDirMare + "COMUNROA\"
|
||
Endproc
|
||
|
||
Procedure initializeazaSettingsIni
|
||
Local lcSettings
|
||
This.cGeneralIniFile = This.cDirMare + "settings.ini"
|
||
If !File(This.cGeneralIniFile)
|
||
TEXT TO lcSettings NOSHOW
|
||
[errors]
|
||
host=http://83.103.197.79:3000/errors/create_xml
|
||
ENDTEXT
|
||
|
||
Strtofile(lcSettings, This.cGeneralIniFile)
|
||
Endif
|
||
Release lcSettings
|
||
Endproc
|
||
|
||
Procedure initializeazaSecurity
|
||
Local lnValid
|
||
This.cSecurityFile = This.cDirMare + 'Security\ROA_SECURITY.TXT'
|
||
If !This.lParametri
|
||
lnValid = This.getcrsSecurity()
|
||
If lnValid > 0
|
||
If Used('crsHost')
|
||
Select crsHost
|
||
Go Top
|
||
This.cHost = Alltrim(Host)
|
||
This.cUserName = Alltrim(schema)
|
||
This.cPassword = Alltrim(pwd)
|
||
Use In crsHost
|
||
Endif
|
||
Endif
|
||
Endif
|
||
Release lnValid
|
||
Endproc
|
||
|
||
Procedure initializeazaObiecte
|
||
This.oLog = Newobject("Log_Mesaje","Log_Mesaje.prg")
|
||
This.oExecutor = Createobject("oExecutor")
|
||
This.oConn = Createobject("oConn")
|
||
This.oExport = Createobject("oExportConfig")
|
||
This.oMyXMLHTTP = Createobject("MyXMLHTTP", getini(This.cGeneralIniFile,'errors','host'))
|
||
This.oBaraFavorite = Null
|
||
This.oBaraManual = Null
|
||
This.oCalendar = Null
|
||
Endproc
|
||
|
||
Procedure initializeazaVariabile
|
||
*!* Public CRLF,CR,LF,Tab
|
||
CR=Chr(13)
|
||
LF=Chr(10)
|
||
CRLF = CR + LF
|
||
Tab=Chr(9)
|
||
Agetfileversion(This.aVersiune,Sys(16,0))
|
||
This.SetCaption(Iif(Alen(This.aVersiune,1)<10,This.cNumeProgram,This.aVersiune(10)))
|
||
This.cStartUpMenu = This.cAppPath + "meniuri\" + This.cNumeProgram + '.mpr'
|
||
This.cStartUpForm = This.cAppPath + "comun\ferestre\frm_login.scx"
|
||
Endproc
|
||
|
||
Procedure initializeazaVariabileGlobale
|
||
*!* Public gcNumeProgram, NUMEPROGRAM, MENIUPROGRAM, FUNDALPROGRAM
|
||
gcNumeProgram = This.cNumeProgram
|
||
_program = This.cNumeProgram
|
||
NUMEPROGRAM = This.ccaption
|
||
MENIUPROGRAM = This.cStartUpMenu
|
||
|
||
*!* Public pcNl, pcAn, gcAcces, gcAppPath, gcAppName, gcUtilizatoriPath, gcDirMare, DIRGEN, gcTempPath, ;
|
||
*!* glParametri, gcHost, gcUsername, gcPassword, gcUserNameApp, gcPasswordApp, gnIdUtil, gnIdProgram, ;
|
||
*!* gnAn, gnLuna, gcS, gnIdFirma, gcGeneralIniFile, gcSecurityFile, gnHandle, gnButon, BUTON, gcFirma, gcBasePath
|
||
Store "" To pcNl,pcAn && se initializeaza in start00
|
||
gcAcces = []
|
||
gcAppPath = This.cAppPath
|
||
gcAppName = This.cAppName
|
||
gcUtilizatoriPath = This.cUtilizatoriPath
|
||
gcDirMare = This.cDirMare
|
||
gcComunPath = This.cDirMare+[COMUNROA\]
|
||
DIRGEN = This.cDirMare
|
||
gcBasePath = This.cDirMare
|
||
gcTempPath = [] && o citesc in oinit_optiuni.prg
|
||
glParametri = This.lParametri
|
||
gcHost = This.cHost
|
||
gcUsername = This.cUserName
|
||
gcPassword = This.cPassword
|
||
gcUserNameApp = [] && le citesc in frm_login
|
||
gcPasswordApp = [] &&
|
||
gnIdUtil = This.nIdUtil
|
||
gnIdProgram = This.nIdProgram
|
||
gnAn = This.nAn
|
||
gnLuna = This.nLuna
|
||
gcS = This.cSchema
|
||
gnIdFirma = This.nIdFirma
|
||
If !Empty(Nvl(This.cLocalePath,[]))
|
||
Private gcLocalePath, goLocale, glTraducere
|
||
gcLocalePath = This.cLocalePath
|
||
glTraducere = This.lTraducere
|
||
goLocale = This.oLocale
|
||
Endif
|
||
gcLocale = This.oLocale.locale
|
||
gcGeneralIniFile = This.cGeneralIniFile
|
||
gcSettingsFile = This.cGeneralIniFile
|
||
gcSecurityFile = This.cSecurityFile
|
||
gnHandle = -1
|
||
gnButon = 2
|
||
BUTON = 2
|
||
gcFirma = []
|
||
glFontCharSet = This.lFontCharSet
|
||
gcReportPreviewer = This.cReportPreviewer
|
||
gcReportPreviewerPath = This.cReportPreviewerPath
|
||
|
||
*!* Private gcCopyRight, pcTitlu
|
||
pcTitlu = []
|
||
gcCopyRight = '<27> ROA Romfast SRL'
|
||
|
||
*!* Private glUltimaLuna, glPrimaLuna, glLunaBuna, glLuna_neplatita, glLunaInchisa
|
||
*!* Private glQuit, pl_verificat
|
||
Store .F. To glUltimaLuna, glPrimaLuna, glLunaBuna, glLuna_neplatita, glLunaInchisa
|
||
Store .F. To glQuit, pl_verificat
|
||
|
||
*!* Public gnewcryptfll, gnewcryptxml, gTransferTotal
|
||
Store -1 To gTransferTotal
|
||
gnewcryptfll = This.lnewcryptfll
|
||
gnewcryptxml = This.lnewcryptxml
|
||
&& ALTELE
|
||
*!* Declare nror[65000]
|
||
*!* Declare RTVA[22,2]
|
||
*!* Public luna_inchisa, luna_neplatita, PRIMADATA, m.ctva, m.ctvam, m.ctvai, antet, m.nivel
|
||
*!* Public OStart,OSETVIZ,OSETTULBAR,OSETINSTRUM,orm,OTEXT,OJUR,osetgest,tlbr_INSTR,tlbr_VIZ,oprinc
|
||
*!* Public pcapsocsub,pcapsocvar
|
||
pcapsocsub=0
|
||
pcapsocvar=0
|
||
*!* Public a4
|
||
a4=.T.
|
||
m.nrgrup=999
|
||
|
||
Store .F. To luna_inchisa,tlbr_INSTRum,tlbr_VIZ
|
||
Store 1 To col_menu
|
||
Store .T. To PRIMADATA,luna_neplatita
|
||
|
||
This.initializeazaAlteVariabileGlobale()
|
||
Endproc
|
||
|
||
Procedure initializeazaAlteVariabileGlobale
|
||
*!* suprascrisa in fiecare aplicatie care are variabile globale suplimentare
|
||
Endproc
|
||
|
||
Procedure initializeazaObiecteGlobale
|
||
*!* Private poLog, goLog, oTool, oHelp, goExecutor, goConn, goMyXMLHTTP, goCalendar, goExport, goUtilizator, goFundal, goFirma
|
||
poLog = This.oLog
|
||
goLog = This.oLog
|
||
oTool = This.oBaraFavorite
|
||
oHelp = This.oBaraManual
|
||
goExecutor = This.oExecutor
|
||
goConn = This.oConn
|
||
goMyXMLHTTP = This.oMyXMLHTTP
|
||
goCalendar = This.oCalendar
|
||
goExport = This.oExport
|
||
goUtilizator = Null
|
||
goFundal = Null
|
||
goFirma = Null
|
||
|
||
This.initializeazaAlteObiecteGlobale()
|
||
Endproc
|
||
|
||
Procedure initializeazaAlteObiecteGlobale
|
||
*!* suprascrisa in fiecare aplicatie care are obiecte globale suplimentare
|
||
Endproc
|
||
|
||
Procedure lanseazaAplicatie
|
||
_Screen.Visible = .T.
|
||
_Screen.WindowState=2
|
||
|
||
This.DoMenu(This.cStartUpMenu)
|
||
This.DoForm(This.cStartUpForm)
|
||
This.ReadEvents()
|
||
Endproc
|
||
|
||
Procedure getcrsSecurity
|
||
Lparameters tcSecurityFile
|
||
*!* SECURITY.TXT - NECRIPTAT
|
||
*!* SECURITY.XML - CRIPTAT
|
||
*!* DACA EXISTA SECURITY.XML - PARSEZ XML, ALTFEL PARSEZ TXT
|
||
*!* gnewcryptxml - daca roa_security.xml are criptare noua(blowfish)
|
||
*!* gnewcryptfll - daca exista vfpencryption.fll
|
||
*!* 19.05.2009
|
||
*!* nu mai exista fisiere roa_security.xml cu criptarea veche (windows api)
|
||
*!* gnewcryptxml=.F.
|
||
|
||
Local lcSecurityFile, lcSecurityPath, lcCursor, lnValid, llSucces, lcSecurityFileXML
|
||
lcCursor = "crsHost"
|
||
If !Empty(tcSecurityFile)
|
||
lcSecurityFile = tcSecurityFile
|
||
Else
|
||
lcSecurityFile = This.cSecurityFile
|
||
Endif
|
||
lcSecurityFileXML = Forceext(lcSecurityFile,'xml')
|
||
lcSecurityPath = Addbs(Justpath(lcSecurityFile))
|
||
lnValid = 0
|
||
llSucces = .T.
|
||
If !Directory(lcSecurityPath)
|
||
Try
|
||
Md (lcSecurityPath)
|
||
Catch
|
||
aMessagebox('Nu se poate crea directorul ' + lcSecurityPath + '!',0+16,'Atentie')
|
||
Endtry
|
||
Endif
|
||
|
||
If !(File(lcSecurityFile) Or File(lcSecurityFileXML))
|
||
Cd (lcSecurityPath)
|
||
If !File(lcSecurityFileXML)
|
||
lcSecurityText = 'ROA;CONTAFIN_ORACLE;123;'
|
||
lcSecurityText = Inputbox('Host(DSN);SCHEMA;SCHEMA_PASSWORD;1;','Server',lcSecurityText)
|
||
lcSecurityText = Alltrim(lcSecurityText)
|
||
If !Empty(lcSecurityText)
|
||
If Right(lcSecurityText,1) # ';'
|
||
lcSecurityText = lcSecurityText + ';'
|
||
Endif
|
||
Else
|
||
llSucces = .F.
|
||
Endif
|
||
Endif
|
||
|
||
If llSucces
|
||
Try
|
||
If !(File(lcSecurityFileXML) Or File(lcSecurityFile))
|
||
*!* SECURITY.TXT
|
||
Strtofile(lcSecurityText, lcSecurityFile)
|
||
*!* SECURITY.TXT ^
|
||
Endif
|
||
*!* SECURITY.XML
|
||
If !File(lcSecurityFileXML)
|
||
Create Cursor cXML (Host c(50), schema c(50), pwd c(50))
|
||
Insert Into cXML (Host, schema, pwd) Values("ROA","CONTAFIN_ORACLE","ENCRYPTED PWD")
|
||
Cursortoxml("cXML",lcSecurityFileXML, 1, 512, 0, "1")
|
||
Use In cXML
|
||
Endif
|
||
*!* SECURITY.XML ^
|
||
Catch
|
||
aMessagebox('Nu s-a putut crea fisierul ' + lcSecurityFile,0+16,'Atentie')
|
||
llSucces = .F.
|
||
Endtry
|
||
Endif
|
||
Endif
|
||
|
||
If llSucces
|
||
If !File(lcSecurityFile) And !File(lcSecurityFileXML)
|
||
aMessagebox('Nu exista fisierul ' + lcSecurityFile,0+16,'Atentie')
|
||
llSucces = .F.
|
||
Endif
|
||
Endif
|
||
|
||
If llSucces
|
||
If Used(lcCursor)
|
||
Use In (lcCursor)
|
||
Endif
|
||
|
||
&& daca exista security.xml - il transform in cursorul cXML si completez crsHost
|
||
Create Cursor (lcCursor)(Host c(100), schema c(100), pwd v(100), IsEncrypted c(1))
|
||
If File(lcSecurityFileXML)
|
||
Try
|
||
lcSecurityText = Filetostr(lcSecurityFileXML)
|
||
Xmltocursor(lcSecurityFileXML, "cXML", 512)
|
||
Select cXML
|
||
Go Top
|
||
Scatter Name lofirstrecord
|
||
|
||
If lofirstrecord.Host="ENCRYPTION"
|
||
This.lnewcryptxml=.T.
|
||
Delete
|
||
Else
|
||
This.lnewcryptxml=.F.
|
||
Endif
|
||
|
||
Insert Into (lcCursor) (Host, schema, pwd, IsEncrypted) ;
|
||
SELECT Host, schema, pwd, "1" As IsEncrypted ;
|
||
FROM cXML
|
||
lnValid = Reccount('cXML')
|
||
|
||
Use In cXML
|
||
Catch To loex
|
||
goApp.ErrorHandler(loex.ErrorNo,loex.Procedure,loex.Lineno)
|
||
Finally
|
||
Use In (Select('cXML'))
|
||
Endtry
|
||
|
||
Else
|
||
* CREATE CURSOR (lcCursor)(HOST c(100), Schema c(100), Pwd v(100), IsEncrypted c(1))
|
||
lcSecurityText = Filetostr(lcSecurityFile)
|
||
Local laHost
|
||
Dimension laHost[1]
|
||
|
||
lnLen = Alines(laHost, lcSecurityText)
|
||
|
||
If lnLen > 0
|
||
For i = 1 To lnLen
|
||
lcLinie = laHost[i]
|
||
|
||
lcHost = Getwordnum(lcLinie, 1, ';')
|
||
lcSchema = Getwordnum(lcLinie, 2, ';')
|
||
lcPassword = Getwordnum(lcLinie, 3, ';')
|
||
lcMode = "0" && necriptat - security.txt
|
||
|
||
If Empty(lcHost) Or Empty(lcSchema) Or Empty(lcPassword)
|
||
Loop
|
||
Endif
|
||
|
||
lnValid = lnValid + 1
|
||
Insert Into &lcCursor (Host, schema, pwd, IsEncrypted) Values (lcHost, lcSchema, lcPassword, Iif(Empty(lcMode), '0', lcMode))
|
||
Endfor
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
Return lnValid
|
||
Endproc
|
||
|
||
Procedure Release
|
||
RETURN
|
||
If Not This.ReleaseForms()
|
||
Return .F.
|
||
Endif
|
||
This.ClearEvents()
|
||
Release This
|
||
Endproc
|
||
|
||
*-- Executes an SCX form.
|
||
Procedure DoForm
|
||
Lparameters tcFileName,tcClass,tlNoMultipleInstances,tlNoShow
|
||
Local lcFileName,lcClass,oForm,oForm2,lcName,lnCount,lnTop,lnLeft
|
||
Local lcFormName,lnFormCount
|
||
_Screen.Visible=.T.
|
||
lcFileName=Alltrim(tcFileName)
|
||
If Empty(lcFileName)
|
||
Return .F.
|
||
Endif
|
||
lcClass=Iif(Type("tcClass")=="C",Lower(Alltrim(tcClass)),"")
|
||
lcFileName=Lower(Fullpath(lcFileName))
|
||
If Not "."$lcFileName
|
||
lcFileName=lcFileName+Iif(Empty(lcClass),".scx",".vcx")
|
||
Endif
|
||
If Not File(lcFileName)
|
||
This.FileNotFoundMsgBox(lcFileName)
|
||
Return .F.
|
||
Endif
|
||
lcFormName=Iif(Empty(lcClass),lcFileName,lcFileName+","+lcClass)
|
||
If tlNoMultipleInstances
|
||
For lnCount = 1 To This.nformcount
|
||
If This.aformnames[lnCount]==lcFormName And ;
|
||
TYPE("this.aForms[lnCount]")=="O" And ;
|
||
NOT Isnull(This.aforms[lnCount])
|
||
This.aforms[lnCount].Show
|
||
Return .F.
|
||
Endif
|
||
Endfor
|
||
Endif
|
||
This.RefreshFormsCollection
|
||
This.nformcount=This.nformcount+1
|
||
Dimension This.aforms[this.nFormCount],This.aformnames[this.nFormCount]
|
||
This.aformnames[this.nFormCount]=lcFormName
|
||
If Not Empty(lcClass)
|
||
Set Classlib To (lcFileName) Additive
|
||
This.aforms[this.nFormCount]=Createobject(lcClass)
|
||
If Not tlNoShow And Type("this.aForms[this.nFormCount]")=="O" And ;
|
||
NOT Isnull(This.aforms[this.nFormCount])
|
||
This.aforms[this.nFormCount].Show
|
||
Endif
|
||
Else
|
||
Do Form (lcFileName) Name This.aforms[this.nFormCount] Linked Noshow
|
||
Endif
|
||
lnFormCount=This.nformcount
|
||
This.RefreshFormsCollection
|
||
If This.lcascadeforms And This.nformcount>=lnFormCount
|
||
oForm=This.aforms[this.nFormCount]
|
||
lnTop=oForm.Top
|
||
lnLeft=oForm.Left
|
||
lcName=oForm.Name
|
||
If Wexist(lcName) And oForm.WindowState#2
|
||
For lnCount = 1 To (This.nformcount-1)
|
||
oForm2=This.aforms[lnCount]
|
||
If Type("oForm2")#"O" Or Isnull(oForm2)
|
||
Loop
|
||
Endif
|
||
If lcName==oForm2.Name And Wlrow(lcName)=Wlrow(oForm2.Name) And ;
|
||
WLCOL(lcName)=Wlcol(oForm2.Name)
|
||
lnTop=lnTop+This.npixeloffset
|
||
lnLeft=lnLeft+This.npixeloffset
|
||
Endif
|
||
Endfor
|
||
If oForm.Top#lnTop
|
||
oForm.Top=lnTop
|
||
Endif
|
||
If oForm.Left#lnLeft
|
||
oForm.Left=lnLeft
|
||
Endif
|
||
Endif
|
||
Endif
|
||
|
||
If !(tlNoShow Or ('LOGIN'$Upper(lcFileName) And This.lParametri))
|
||
This.aforms[this.nFormCount].Show
|
||
Endif
|
||
Endproc
|
||
|
||
Procedure DoMenu
|
||
Lparameters tcFileName
|
||
Local lcFileName
|
||
lcFileName=Alltrim(tcFileName)
|
||
If Empty(lcFileName)
|
||
Return .F.
|
||
Endif
|
||
If At('.', lcFileName) = 0
|
||
lcFileName = lcFileName + '.mpr'
|
||
ENDIF
|
||
|
||
If File(lcFileName)
|
||
If Type('This.oLocale') = '0'
|
||
This.oLocale.SetMenu(lcFileName,"menu", Null)
|
||
Endif
|
||
Do &lcFileName
|
||
Endif
|
||
Endproc
|
||
|
||
Procedure ClearEvents
|
||
Clear Events
|
||
Endproc
|
||
|
||
*-- Starts read events mode.
|
||
Procedure ReadEvents
|
||
This.BeforeReadEvents()
|
||
|
||
RETURN
|
||
|
||
If This.lreadevents
|
||
Read Events
|
||
Endif
|
||
Endproc
|
||
|
||
*-- Sets the caption of the application.
|
||
Procedure SetCaption
|
||
Lparameters tcCaption
|
||
|
||
If Type("tcCaption")#"C"
|
||
Return .F.
|
||
Endif
|
||
This.ccaption=tcCaption
|
||
_Screen.Caption=tcCaption
|
||
Endproc
|
||
|
||
|
||
*-- Sets the icon of the application.
|
||
Procedure seticon
|
||
Lparameters tcIcon
|
||
If Type("tcIcon")#"C"
|
||
Return .F.
|
||
Endif
|
||
This.cicon=tcIcon
|
||
_Screen.Icon=tcIcon
|
||
Endproc
|
||
|
||
*-- Returns the caption of the application.
|
||
Procedure getcaption
|
||
Return This.ccaption
|
||
Endproc
|
||
|
||
*-- Returns the icon of the application.
|
||
Procedure geticon
|
||
Return This.cicon
|
||
Endproc
|
||
|
||
*-- Occurs when the user attempts to exit Visual FoxPro.
|
||
Procedure onShutDown
|
||
Local loMesaj
|
||
|
||
If This.lQuit
|
||
Quit
|
||
Endif
|
||
|
||
loMesaj=Createobject('frm_mesaj', This.cNumeProgram ,'intreb.ico','INTREBARE','Dori<72>i s<> ie<69>i<EFBFBD>i din program?')
|
||
loMesaj.lbl_mesaj1.FontBold=.T.
|
||
loMesaj.lbl_mesaj1.FontSize=12
|
||
loMesaj.lbl_mesaj1.Top=55
|
||
loMesaj.Show(1)
|
||
If BUTON=1
|
||
On Shutdown
|
||
On Error
|
||
*Clear Events
|
||
If _vfp.StartMode <> 0
|
||
Quit
|
||
Endif
|
||
Endif
|
||
Endproc
|
||
|
||
*-- Release all application forms from memory.
|
||
Procedure ReleaseForms
|
||
Local lnFormCount
|
||
|
||
This.RefreshFormsCollection
|
||
Do While This.nformcount>0
|
||
lnFormCount=This.nformcount
|
||
If Not This.ReleaseForm(This.aforms[lnFormCount]) Or This.nformcount=lnFormCount
|
||
Return .F.
|
||
Endif
|
||
Enddo
|
||
Endproc
|
||
|
||
|
||
*-- Release specifc or active form from memory.
|
||
Procedure ReleaseForm
|
||
Lparameters toForm
|
||
|
||
If Parameters()=0
|
||
If Type("_screen.ActiveForm")#"O" Or Isnull(_Screen.ActiveForm)
|
||
Return .F.
|
||
Endif
|
||
_Screen.ActiveForm.Release
|
||
Else
|
||
If Type("toForm")#"O" Or Isnull(toForm)
|
||
Return .F.
|
||
Endif
|
||
toForm.Release
|
||
Endif
|
||
This.RefreshFormsCollection
|
||
Endproc
|
||
|
||
|
||
*-- Reset arrays and counters of forms collection.
|
||
Protected Procedure ResetFormsCollection
|
||
This.nformcount=0
|
||
Dimension This.aforms[1],This.aformnames[1]
|
||
This.aforms=.Null.
|
||
This.aformnames=""
|
||
Endproc
|
||
|
||
|
||
*-- Refresh forms collection arrays and counters.
|
||
Procedure RefreshFormsCollection
|
||
Local lnCount,lnCount2
|
||
|
||
lnCount=1
|
||
Do While lnCount<=This.nformcount
|
||
If Type("this.aForms[lnCount]")=="O" And Not Isnull(This.aforms[lnCount])
|
||
lnCount=lnCount+1
|
||
Loop
|
||
Endif
|
||
For lnCount2 = lnCount To (This.nformcount-1)
|
||
This.aforms[lnCount2]=This.aforms[lnCount2+1]
|
||
This.aforms[lnCount2+1]=.Null.
|
||
This.aformnames[lnCount2]=This.aformnames[lnCount2+1]
|
||
This.aformnames[lnCount2+1]=""
|
||
Endfor
|
||
This.nformcount=This.nformcount-1
|
||
If This.nformcount=0
|
||
Exit
|
||
Endif
|
||
Dimension This.aforms[this.nFormCount],This.aformnames[this.nFormCount]
|
||
Enddo
|
||
If This.nformcount=0
|
||
This.ResetFormsCollection
|
||
Endif
|
||
Endproc
|
||
|
||
Protected Procedure Destroy
|
||
* Clear Events
|
||
* This.restaureazaEnv()
|
||
Endproc
|
||
|
||
*-- Method executed before READ EVENTS is executed when ReadEvents is called.
|
||
Protected Procedure BeforeReadEvents
|
||
Endproc
|
||
|
||
Function ErrorHandler
|
||
*!* de modificat variabilele globale cu proprietati ale obiectului atunci cand
|
||
*!* o sa si actualizez proprietatile coresp. obiectului din schimba_firma, etc.
|
||
Lparameters nError,cMethod,nLine
|
||
Local lcErrorMsg,lcCodeLineMsg
|
||
|
||
Wait Clear
|
||
lcErrorMsg=Message()+Chr(13)+Chr(13)
|
||
lcErrorMsg=lcErrorMsg+"Metoda: "+cMethod
|
||
lcCodeLineMsg=Message(1)
|
||
If Between(nLine,1,10000) And Not lcCodeLineMsg="..."
|
||
lcErrorMsg=lcErrorMsg+Chr(13)+"Linia: "+Alltrim(Str(nLine))
|
||
If Not Empty(lcCodeLineMsg)
|
||
lcErrorMsg=lcErrorMsg+Chr(13)+Chr(13)+lcCodeLineMsg
|
||
Endif
|
||
ENDIF
|
||
lcErrorMsg = m.lcErrorMsg + CHR(13) + CHR(13) + GETCALLSTACK()
|
||
|
||
|
||
*!* If Type('This.oMyXMLHTTP') = '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))
|
||
*!* This.oMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
|
||
*!* Endif
|
||
|
||
If aMessagebox(lcErrorMsg,17,_Screen.Caption)#1
|
||
If _vfp.StartMode = 0
|
||
Set Step On
|
||
ELSE
|
||
ON SHUTDOWN
|
||
ON ERROR
|
||
Quit
|
||
Endif
|
||
Endif
|
||
Endfunc
|
||
|
||
FUNCTION ReadIni
|
||
LPARAMETERS tcSection, tcVariable
|
||
|
||
lcSection = IIF(!EMPTY(m.tcSection), ALLTRIM(LOWER(m.tcSection)), '')
|
||
lcVariable = IIF(!EMPTY(m.tcVariable), ALLTRIM(LOWER(m.tcVariable)), '')
|
||
lcValue = ''
|
||
|
||
IF TYPE('goApi') = 'O' AND !EMPTY(m.lcSection) AND !EMPTY(m.lcVariable)
|
||
lcValue = goAPI.GetProfileString(m.gcSettingsFile, m.lcSection, m.lcVariable)
|
||
ENDIF
|
||
|
||
RETURN NVL(m.lcValue,'')
|
||
ENDFUNC
|
||
|
||
PROCEDURE WriteIni
|
||
LPARAMETERS tcSection, tcVariable, tcValue
|
||
|
||
lcSection = IIF(!EMPTY(m.tcSection), ALLTRIM(LOWER(m.tcSection)), '')
|
||
lcVariable = IIF(!EMPTY(m.tcVariable), ALLTRIM(LOWER(m.tcVariable)), '')
|
||
lcValue = IIF(!EMPTY(m.tcValue), ALLTRIM(TRANSFORM(m.tcValue)), '')
|
||
|
||
IF TYPE('goApi') = 'O' AND !EMPTY(m.lcSection) AND !EMPTY(m.lcVariable)
|
||
goAPI.WriteProfileString(m.gcSettingsFile, m.lcSection, m.lcVariable, m.lcValue)
|
||
ENDIF
|
||
ENDPROC
|
||
|
||
ENDDEFINE
|