Define Class ROABaseApplication As Custom cLastSetClassLib = Null cLastSetTalk = Null cLastSetPath = Null cNumeProgram = [ROA] cCopyRight = [© ROA Romfast SRL] cUserNameApp = Null cExplicatieProgram = Null cROAPath = Null cAppPath = Null cSecurityPath = Null cGeneralIniFile = Null oLog = Null oExecutor = Null oConn = Null oExport = Null oMyXmlHttp = Null Procedure Init Lparameters tcNumeProgram This.cNumeProgram = Upper(Alltrim(tcNumeProgram)) _Screen.Icon = tcNumeProgram + [.ico] _Screen.Visible=.F. This.definesteConstante() This.setMediu() This.setClase() This.setProceduri() This.declaraDLL() This.setVariabile() This.setAlteProceduri() This.initializeazaControllere() This.setExplicatieProgram() Endproc PROCEDURE setVariabile This.cAppPath = Addbs(ShortPath(GetAppStartPath())) This.cROAPath = Addbs(Left(This.cAppPath,Rat("\",This.cAppPath,2)-1)) This.cSecurityPath = This.cROAPath + 'Security\' This.cGeneralIniFile = This.cROAPath + "settings.ini" ENDPROC PROCEDURE setAlteProceduri Set Path To Addbs(Substr(This.cAppPath,1,Rat([\],This.cAppPath,2)))+[COMUNROA\] Additive ENDPROC PROCEDURE setExplicatieProgram Local laVersion Dimension laVersion(12) If Agetfileversion(laVersion, Sys(16,0)) > 0 This.cExplicatieProgram = laVersion(10) IF TYPE('gcExplicatieProgram') = 'C' gcExplicatieProgram = This.cExplicatieProgram ENDIF Endif Release laVersion ENDPROC Procedure definesteConstante Public LF,CR,CRLF,CTAB,CT_INSUCCES,CT_SUCCES Store Chr(10) To LF Store Chr(13) To CR Store Chr(13) + Chr(10) To CRLF Store Chr(9) To CTAB Store -1 To CT_INSUCCES Store 1 To CT_SUCCES Endproc Procedure initializeazaControllere This.oLog = Createobject("logBaseController",This.cAppPath + "log_" + This.cNumeProgram + "_" + DTOS(DATE()) + ".txt") This.oExecutor = Createobject("oExecutor") This.oConn = Createobject("oConn") This.oExport = Createobject("oExportConfig") This.oMyXmlHttp = Createobject("MyXMLHTTP", getini(gcGeneralIniFile,'errors','host')) Endproc Procedure declaraDLL Declare Integer Beep In kernel32; INTEGER dwFreq,; INTEGER dwDuration Declare Integer CoCreateGuid In OLE32.Dll String @lcBuffer Endproc Procedure setClase Set Classlib To registry Additive Set Classlib To Messagebox Additive Endproc Procedure setProceduri Set Procedure To wwxmlhttp.prg Additive Set Procedure To wwutils.prg Additive Set Procedure To wwApi.prg Additive SET PROCEDURE TO oproceduri_comune.prg additive SET PROCEDURE TO ini.prg additive Endproc Procedure setMediu This.backupMediu() Set Path To ;Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS Push Menu _Msysmenu Set Century On Set Date Dmy Set Ansi On Set Exact On Set Talk Off Set Console Off Set Safety Off Close Databases All Set Deleted On Set Point To '.' Set Hours To 24 Set NullDisplay To "*" Set Mark To '/' Set Exclusive Off Set Cpdialog Off Set Escape Off Set Notify Off Set Seconds Off Set Decimals To 4 Endproc Procedure backupMediu This.cLastSetClassLib=Set("CLASSLIB") This.cLastSetTalk=Set("TALK") This.cLastSetPath=Set("PATH") Endproc Procedure ResetMediu If Cntbar("_msysmenu")<>7 Pop Menu _Msysmenu Endif On Error On Shutdown Set Classlib To Set Path To Close All Clear Events If Inlist(Application.StartMode,4) && EXE Quit Endif This.restoreMediu() Endproc Procedure restoreMediu 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 Endproc Function Shutdown If Type("goApp")=="O" And Not Isnull(goApp) If Pemstatus(goApp,"OnShutdown",5) Return goApp.OnShutDown() Endif Endif This.ResetMediu() Endfunc Function ErrorHandler(nError,cMethod,nLine) Local lcErrorMsg,lcCodeLineMsg,lcUserName 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 lcErrorMsg = Sys(0) + ":" + Iif(Type('GCS')='C'," " + gcS,"") + Chr(13) +Chr(10) + lcErrorMsg lcUserName = This.cUserNameApp lcProgram = Juststem(Sys(16,0)) This.oMyXMLHTTP.postError(lcErrorMsg, lcUserName, lcProgram) If aMessagebox(lcErrorMsg,17,_Screen.Caption)#1 On Error Return .F. Endif Endfunc Function verificaAplicatie If !Like(This.cNumeProgram + '*', Upper(Alltrim(Juststem(Sys(16,0))))) aMessagebox("Nu puteti porni acest program!",0+16,"Atentie") Return .F. Endif Endfunc Enddefine