911 lines
26 KiB
Plaintext
911 lines
26 KiB
Plaintext
*!* 24.04.2012
|
||
*!* nu se mai verifica seria HDD
|
||
|
||
PARAMETERS tparam
|
||
&&& roaimob
|
||
LOCAL lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
|
||
STORE '' TO lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp
|
||
STORE 0 TO lnIdUtil, lnIdProgram
|
||
PRIVATE gcNumeProgram
|
||
gcNumeProgram = [ROAIMOB]
|
||
_SCREEN.ICON = gcNumeProgram + [.ICO]
|
||
IF !LIKE(gcNumeProgram + '*', UPPER(ALLTRIM(JUSTSTEM(SYS(16,0)))))
|
||
Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
|
||
RETURN
|
||
ENDIF
|
||
|
||
SET CENTURY ON
|
||
SET DELETED ON
|
||
SET DATE TO DMY
|
||
SET MARK TO '/'
|
||
SET EXCLUSIVE OFF
|
||
SET CPDIALOG OFF
|
||
SET TALK OFF
|
||
SET SAFETY OFF
|
||
SET ESCAPE OFF
|
||
SET EXACT ON
|
||
SET ANSI ON
|
||
SET CONSOLE OFF
|
||
SET NOTIFY OFF
|
||
SET SECONDS OFF
|
||
*SET NULLDISPLAY TO '*'
|
||
SET NULLDISPLAY TO ''
|
||
SET DECIMALS TO 4
|
||
SET POINT TO '.'
|
||
|
||
_SCREEN.VISIBLE=.F.
|
||
|
||
*VARIABILE_______
|
||
LOCAL lcMainClassLib
|
||
LOCAL lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
|
||
|
||
*VARIABILE__________________________________________________________________________
|
||
DECLARE nror[65000]
|
||
PUBLIC CRLF
|
||
STORE CHR(13) + CHR(10) TO CRLF
|
||
*!* PUBLIC pcNl,pcAn
|
||
*!* STORE "" TO pcNl,pcAn && se initializeaza in start00
|
||
|
||
PUBLIC pcTitlu,pl_verificat,pcdurata
|
||
STORE "" TO pcTitlu
|
||
STORE .F. TO pl_verificat
|
||
|
||
*!* PUBLIC BUTON, luna_inchisa, luna_neplatita, PRIMADATA, m.ctva, m.ctvam, m.ctvai, antet, m.nivel
|
||
PUBLIC buton,primadata,dirgen,col_menu,gestiune,gcAntet, m.antet
|
||
*!* Public OStart,OSETVIZ,OSETTULBAR,OSETINSTRUM,orm,OTEXT,OJUR,osetgest,tlbr_INSTR,tlbr_VIZ,oprinc,DIRGEN,buton
|
||
*!* 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 buton,col_menu
|
||
STORE .T. TO primadata &&,luna_neplatita
|
||
|
||
|
||
*-- Save and configure environment.***********************
|
||
lcLastSetTalk=SET("TALK")
|
||
SET TALK OFF
|
||
lcLastSetPath=SET("PATH")
|
||
|
||
PUBLIC glVerificTabel && daca se verifica structura tabelelor in totv.prg
|
||
glVerificTabel=.T.
|
||
|
||
PUBLIC glQuit
|
||
glQuit = .F.
|
||
|
||
PUBLIC gnIdIstoric
|
||
gnIdIstoric = 0
|
||
|
||
PUBLIC gcAppPath,gcAppName, gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp
|
||
STORE '' TO gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces
|
||
*!* PUBLIC gcSchemaPath
|
||
*!* STORE '' TO gcSchemaPath
|
||
|
||
Set Procedure To "D:\ROA\ROAIMOB\COMUN\UTILE\web\WWUTILS.PRG" Additive
|
||
Set Procedure To "D:\ROA\ROAIMOB\COMUN\UTILE\web\WWAPI.PRG" Additive
|
||
|
||
gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg
|
||
If Right(gcAppPath ,9)="PROGRAME\"
|
||
gcAppPath = Substr(gcAppPath ,1,Len(gcAppPath )-9)
|
||
Endif
|
||
gcAppName=ALLT(UPPE(JUSTSTEM(SYS(16,0)))) && "roaimob"
|
||
|
||
gcUtilizatoriPath = gcAppPath + "UTILIZATORI\"
|
||
|
||
Set Default To (gcAppPath)
|
||
lcPath = gcAppPath + 'Date;' + ;
|
||
gcAppPath + 'Include;' + ;
|
||
gcAppPath + 'FERESTRE;' + ;
|
||
gcAppPath + 'GRAFICE;' + ;
|
||
gcAppPath + 'CLASE;' + ;
|
||
gcAppPath + 'MENIURI;' + ;
|
||
gcAppPath + 'PROGRAME;' + ;
|
||
gcAppPath + 'RAPOARTE;' + ;
|
||
gcAppPath + 'COMUN;' + ;
|
||
gcAppPath + 'COMUN\CLASE;' + ;
|
||
gcAppPath + 'COMUN\FERESTRE;' + ;
|
||
gcAppPath + 'COMUN\PROGRAME;' + ;
|
||
gcAppPath + 'COMUN\GRAFICE;' + ;
|
||
gcAppPath + 'COMUN\RAPOARTE;' + ;
|
||
gcAppPath + 'COMUN\MENIURI;' + ;
|
||
gcAppPath + 'COMUN\UTILE\GRIDEXTRAS;' + ;
|
||
gcAppPath + 'COMUN\UTILE\CTL32;' + ;
|
||
gcAppPath + 'COMUN\UTILE\HPDF;' + ;
|
||
gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
|
||
gcAppPath + 'COMUN\UTILE\WEB;' + ;
|
||
gcAppPath + 'COMUN\UTILE\Excel;' + ;
|
||
Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\]
|
||
|
||
*!*Set Path To Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS
|
||
|
||
SET PATH TO &lcPath ADDITIVE
|
||
|
||
PUSH MENU _MSYSMENU
|
||
lcLastSetClassLib=SET("CLASSLIB")
|
||
lcMainClassLib= gcAppPath + "clase\oimobilizari.vcx"
|
||
|
||
STORE "" TO gcTempPath, gcCaleServerDate
|
||
|
||
*** DIRGEN
|
||
liat = RAT("\",gcAppPath,2)
|
||
dirgen = ADDBS(LEFT(gcAppPath,liat-1))
|
||
*!* v 2.0.17
|
||
PUBLIC gcDirMare
|
||
gcDirMare = dirgen
|
||
*!* v 2.0.17 ^
|
||
|
||
gcSecurityPath = dirgen + 'Security\'
|
||
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
|
||
|
||
|
||
*CLASE__________________________________________________________
|
||
SET CLASSLIB TO (lcMainClassLib) ADDITIVE
|
||
SET CLASSLIB TO registry ADDITIVE
|
||
SET CLASSLIB TO cauta_alfa_forms ADDITIVE
|
||
SET CLASSLIB TO caut_ora ADDITIVE
|
||
SET CLASSLIB TO ofundal_imob ADDITIVE
|
||
|
||
SET CLASSLIB TO serii_numere ADDITIVE
|
||
*PROCEDURI______________________________________________________
|
||
*!* Set Procedure To proceduri Additive
|
||
*!* Set Procedure To pmenu Additive
|
||
SET PROCEDURE TO proceduri_comune ADDITIVE
|
||
SET PROCEDURE TO sitan ADDITIVE
|
||
SET PROCEDURE TO quitapp ADDITIVE
|
||
SET PROCEDURE TO init_program ADDITIVE
|
||
SET PROCEDURE TO oproceduri_listari ADDITIVE
|
||
SET PROCEDURE TO proceduri_meniu ADDITIVE
|
||
*!* 11.11.2009
|
||
SET PROCEDURE TO oserii_numere ADDITIVE
|
||
*!* 11.11.2009 ^
|
||
|
||
SET PROCEDURE TO regex ADDITIVE
|
||
|
||
&& CLASE ORACLE
|
||
SET CLASSLIB TO DECABAZA ADDITIVE
|
||
SET CLASSLIB TO onomenclatoare ADDITIVE
|
||
SET CLASSLIB TO ferestre_oracle ADDITIVE
|
||
SET CLASSLIB TO onom_imob ADDITIVE
|
||
SET CLASSLIB TO otoolbar ADDITIVE
|
||
SET CLASSLIB TO ocriterii ADDITIVE
|
||
|
||
SET CLASSLIB TO MESSAGEBOX ADDITIVE
|
||
*!* v 2.0.17
|
||
SET CLASSLIB TO wwdialogs.vcx additive
|
||
*!* v 2.0.17 ^
|
||
|
||
*!* 11.11.2009
|
||
SET CLASSLIB TO serii_numere.vcx ADDITIVE
|
||
*!* 11.11.2009 ^
|
||
|
||
SET CLASSLIB TO accessibility.vcx ADDITIVE
|
||
|
||
************************************************************************************************
|
||
&& PROCEDURI ORACLE
|
||
SET PROCEDURE TO gencursor.prg ADDITIVE
|
||
SET PROCEDURE TO oproceduri_comune.prg ADDITIVE
|
||
SET PROCEDURE TO oproceduri_imob.prg ADDITIVE
|
||
SET PROCEDURE TO oproceduri_operatii.prg ADDITIVE
|
||
SET PROCEDURE TO ofunctii_imob.prg ADDITIVE
|
||
SET PROCEDURE TO oinit_optiuni.prg ADDITIVE
|
||
SET PROCEDURE TO update_imob.prg ADDITIVE
|
||
SET PROCEDURE TO updateserver.prg ADDITIVE
|
||
SET PROCEDURE TO oproceduri_ams.prg ADDITIVE
|
||
SET PROCEDURE TO ocautare.prg ADDITIVE
|
||
SET PROCEDURE TO osecurity.prg ADDITIVE
|
||
SET PROCEDURE TO acces_meniu.prg ADDITIVE
|
||
SET PROCEDURE TO oheader.prg ADDITIVE
|
||
*!* 12.07.2006
|
||
*!* marius.mutu
|
||
SET PROCEDURE TO oproceduri_comune_imob.prg ADDITIVE
|
||
*!* 19feb2009
|
||
*!* liana.neagu
|
||
Set Procedure To cauta_alfa.prg ADDITIVE
|
||
|
||
SET PROCEDURE TO oexport.prg ADDITIVE
|
||
|
||
*!* v 2.0.17
|
||
Set Procedure To validare.prg ADDITIVE
|
||
SET PROCEDURE TO iniacces.prg ADDITIVE
|
||
SET PROCEDURE TO oupdate.prg additive
|
||
SET PROCEDURE TO procese.prg additive
|
||
SET PROCEDURE TO version.prg additive
|
||
SET PROCEDURE TO xmlaccess.prg additive
|
||
SET PROCEDURE TO xmlparser.prg additive
|
||
SET PROCEDURE TO filebringer.prg additive
|
||
SET PROCEDURE TO wwcodeupdate.prg additive
|
||
SET PROCEDURE TO wwhttp.prg ADDITIVE
|
||
|
||
*!* 19.06.2006
|
||
*!* marius.mutu
|
||
SET PROCEDURE TO wwxmlhttp.prg ADDITIVE
|
||
SET PROCEDURE TO ini.prg ADDITIVE
|
||
SET PROCEDURE TO wwconfig.prg ADDITIVE
|
||
*!* SET PROCEDURE TO wwutils.prg ADDITIVE
|
||
*!* SET PROCEDURE TO wwapi.prg ADDITIVE
|
||
SET PROCEDURE TO excelxml.prg ADDITIVE
|
||
|
||
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
|
||
*!* v 2.0.17 ^
|
||
*******************************************************************************************
|
||
|
||
IF PCOUNT() = 1 AND TYPE('tparam') = 'C'
|
||
glParametri = .T.
|
||
PRIVATE laParametri
|
||
DECLARE laParametri[1]
|
||
lcParam = ALLTRIM(tparam)
|
||
lnNr = lista2array(lcParam,@laParametri,";")
|
||
IF lnNr < 5
|
||
MESSAGEBOX('Numar incorect de parametri',0+16,'Eroare')
|
||
RETURN
|
||
ENDIF
|
||
lchost = laParametri[1]
|
||
lcUserName = laParametri[2]
|
||
lcPassword = laParametri[3]
|
||
lnIdUtil = ROUND(VAL(laParametri[4]),0)
|
||
lnIdProgram = ROUND(VAL(laParametri[5]),0)
|
||
ELSE
|
||
glParametri = .F.
|
||
lchost = 'JCSSERVER'
|
||
lcUserName = 'CONTAFIN_ORACLE'
|
||
lcPassword = ''
|
||
lnIdUtil = 0
|
||
lnIdProgram = 0
|
||
|
||
ENDIF
|
||
|
||
|
||
PRIVATE gcGeneralIniFile, gcSettingsFile
|
||
gcGeneralIniFile = ADDBS(m.dirgen) + "settings.ini"
|
||
gcSettingsFile = m.gcGeneralIniFile
|
||
IF !FILE(gcGeneralIniFile)
|
||
|
||
TEXT TO lcSettings NOSHOW
|
||
[errors]
|
||
host=
|
||
ENDTEXT
|
||
|
||
STRTOFILE(lcSettings, gcGeneralIniFile)
|
||
ENDIF
|
||
|
||
PRIVATE poLog,goLog && obiect pt logarea mesajelor sistemului
|
||
poLog = NEWOBJECT("Log_Mesaje","Log_Mesaje.prg")
|
||
goLog = poLog
|
||
*!* Locale
|
||
Set Classlib To locale Additive
|
||
Private gcLocalePath, goLocale, gcLocale, glTraducere
|
||
glTraducere = .F.
|
||
gcLocalePath = gcAppPath + "Locale\"
|
||
*!* lcLocaleDb = gcLocalePath + "locale.dbc"
|
||
*!* Open Database (m.lcLocaleDb)
|
||
goLocale=Newobject("Locale","Locale.vcx")
|
||
lcLanguage = getini(gcGeneralIniFile,"locale","lang")
|
||
llLocale= getini(gcGeneralIniFile,"locale","llocale")
|
||
IF !EMPTY(m.llLocale) AND m.llLocale<>'0'
|
||
goLocale.llocale=.T.
|
||
ENDIF
|
||
If Empty(m.lcLanguage)
|
||
gcLocale = 'Romana'
|
||
Else
|
||
gcLocale = m.lcLanguage
|
||
Endif
|
||
goLocale.locale = gcLocale
|
||
*!* Locale ^
|
||
IF verificari()
|
||
_SCREEN.VISIBLE=.T.
|
||
MESSAGEBOX("Se fac verificari programului!"+CRLF+"Va rugam reveniti!",64,"ROA Imobilizari")
|
||
glQuit= .T.
|
||
QUIT
|
||
ENDIF
|
||
|
||
IF !Debug_Start()
|
||
lcParam=tparam
|
||
IF EMPTY(tparam) OR (TYPE('tParam')='C' AND !verific_start(tparam,dirgen,gcAppName))
|
||
_SCREEN.VISIBLE=.T.
|
||
MESSAGEBOX("Programul trebuie pornit doar din START!",64,"ROA Imobilizari")
|
||
QUIT
|
||
ENDIF
|
||
ENDIF
|
||
|
||
*!* PUBLIC tipar,SER_PERM,SER_PERI,VERSIUNE
|
||
*!* STORE .F. TO SER_PERM,SER_PERI
|
||
***************************** VARIABILE ORACLE
|
||
PRIVATE goUtilizator
|
||
PRIVATE gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA,GNDIFZILE, gcUserNameApp, gcPasswordApp
|
||
PRIVATE gnButon && variabila pentru renunt si terminat
|
||
STORE 2 TO gnButon
|
||
STORE '' TO GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, gcNivelUtilizator, gcGrupUtilizator, gcAcces
|
||
gnHandle = -1
|
||
gnidutil = 0
|
||
|
||
PRIVATE gcHost, gcUserName, gcPassword,gofundal, gnIdProgram, gnId_Prg_Owner
|
||
gnIdProgram = 0
|
||
gnId_Prg_Owner = 0
|
||
gofundal=''
|
||
|
||
|
||
PRIVATE goFirma,gnIdFirma,gcFirma,gnAn,gnLuna && ,gnPA,gnPC
|
||
&& STORE 0 TO gnPA,gnPC && nr. de zecimale afisare, calcul
|
||
STORE NULL TO goFirma
|
||
STORE 0 TO gnIdFirma, gnAn, gnLuna
|
||
STORE '' TO gcFirma
|
||
|
||
PRIVATE glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa
|
||
STORE .F. TO glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa
|
||
|
||
***toolbar***
|
||
PRIVATE otool,ohelp
|
||
STORE '' TO otool,ohelp
|
||
***toolbar***
|
||
|
||
PRIVATE gcS && schema firmei
|
||
STORE 'CONTAFIN' TO gcS
|
||
|
||
IF TYPE('laparametri',1)="A"
|
||
IF ALEN(laParametri,1)=10
|
||
gnAn = VAL(laParametri[7])
|
||
gnLuna = VAL(laParametri[8]) &&lansare noua
|
||
gcS = laParametri[9]
|
||
gnIdFirma = Val(laParametri[10])
|
||
ENDIF
|
||
ENDIF
|
||
|
||
PRIVATE gcCopyRight
|
||
gcCopyRight = '<27> ROA Romfast SRL'
|
||
|
||
&& obiect global wrap pentru sqlexec cu text eroare si succes
|
||
PRIVATE goExecutor
|
||
goExecutor = CREATEOBJECT("oExecutor")
|
||
|
||
&& obiect global wrap pentru sqlconnect, sqldisconnect; apeleaza proceduri postconectare pentru setare variabile sesiune
|
||
PRIVATE goConn
|
||
goConn = CREATEOBJECT("oConn")
|
||
|
||
PRIVATE goMyXMLHTTP
|
||
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
|
||
goMyXMLHTTP = CREATEOBJECT("MyXMLHTTP", lcHostErrors)
|
||
|
||
|
||
&& obiect global pentru export : frx, xls
|
||
Private goExport
|
||
goExport = Createobject("oExportConfig")
|
||
|
||
|
||
&& obiect global pt luna aleasa din calendar
|
||
PRIVATE goCalendar
|
||
STORE NULL TO goCalendar
|
||
|
||
|
||
gcHost = lchost
|
||
gcUserName = lcUserName
|
||
gcPassword = lcPassword
|
||
gcUserNameApp = lcUserNameApp
|
||
gcPasswordApp = lcPasswordApp
|
||
gnidutil = lnIdUtil
|
||
gnIdProgram = lnIdProgram
|
||
|
||
IF !glParametri
|
||
lnValid = getcrsSecurity(gcSecurityFile)
|
||
IF lnValid > 0
|
||
IF USED('crsHost')
|
||
SELECT crsHost
|
||
GO TOP
|
||
gcHost = ALLTRIM(HOST)
|
||
gcUserName = ALLTRIM(schema)
|
||
gcPassword = ALLTRIM(pwd)
|
||
USE IN crsHost
|
||
ENDIF
|
||
ENDIF
|
||
ENDIF
|
||
***************************** VARIABILE ORACLE
|
||
&& DECLARARE VARIABILE GLOBALE SPECIFICE APLICATIEI CARE NU SE AFLA IN OPTIUNI_FIRMA
|
||
&& (SE AFLA IN DIRECTORUL PROIECTULUI, NU IN COMUN)
|
||
*!* Do OVARIABILE_GLOBALE.PRG
|
||
*!* USE &gcAppPath\SERIMOB IN 0 ALIAS SER SHARED
|
||
*!* SELECT SER
|
||
*!* GO TOP
|
||
*!* tipar=TIP
|
||
*!* SER_PERM=SER_PERMAN
|
||
*!* SER_PERI=SER_PERIOD
|
||
*!* VERSIUNE=VERcont
|
||
*!* MODEL_PROGRAM=MODEL
|
||
*!* USE IN SER
|
||
*!* parolamea=SUBSTR(tipar,MONTH(DATE()),1)
|
||
*!* parolamea=parolamea+ALLT(STR(DAY(DATE())))+ALLT(STR(MONTH(DATE())))
|
||
|
||
*!* IF !_DEBUG()
|
||
*!* IF SER_PERM AND !verif_ser_perm()
|
||
*!* * daca exista comdir.snr - trec mai departe :) presupun ca s-a instalat kitul de client chiar daca nu s-a verificat seria
|
||
*!* IF !FILE(getCaleWin() + 'comdir.snr')
|
||
*!* QUIT
|
||
*!* ENDIF
|
||
*!* ENDIF
|
||
*!* ENDIF
|
||
|
||
PUBLIC NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM
|
||
MODEL_PROGRAM = 'M'
|
||
NUMEPROGRAM='ROA Imobilizari '+MODEL_PROGRAM
|
||
MENIUPROGRAM=gcAppPath+"meniuri\roaimob.mpr"
|
||
FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
|
||
_program='cont'
|
||
|
||
*-- Configure application object.*****************************
|
||
_SCREEN.WINDOWSTATE=2
|
||
|
||
*!* 20.04.2012
|
||
PRIVATE gcReportPreviewer, gcReportPreviewerPath
|
||
gcReportPreviewer = "FoxyPreview" && oexport.prg
|
||
gcReportPreviewerPath = dirgen + "COMUNROA\"
|
||
*!* 20.04.2012 ^
|
||
|
||
|
||
lcOnShutdown="ShutDown()"
|
||
ON SHUTDOWN &lcOnShutdown
|
||
ON ERROR ErrorHandler(ERROR(),PROGRAM(),LINENO())
|
||
*_SHELL="DO Cleanup IN progs\cont2003"
|
||
|
||
*-- Instantiate application object.***************************
|
||
RELEASE goApp
|
||
PUBLIC goApp
|
||
goApp = CREATEOBJECT("cApplication")
|
||
* 10.06.2020 mod experimental se citeste din optiuni utilizator
|
||
ADDPROPERTY(goApp, 'nExperimental', 0)
|
||
|
||
LOCAL laVersion
|
||
DIMENSION laVersion(12)
|
||
IF AGETFILEVERSION(laVersion, SYS(16,0)) > 0
|
||
NUMEPROGRAM = laVersion(10)
|
||
ENDIF
|
||
RELEASE laVersion
|
||
|
||
|
||
|
||
goApp.SetCaption(NUMEPROGRAM)
|
||
goApp.cStartupMenu=MENIUPROGRAM
|
||
*goApp.cStartupForm=FUNDALPROGRAM
|
||
goApp.cStartupForm = gcAppPath + "COMUN\ferestre\frm_login.scx"
|
||
_SCREEN.WINDOWSTATE=2
|
||
*-- Show application.
|
||
goApp.SHOW
|
||
|
||
*-- Release application.
|
||
RELEASE goApp
|
||
cleanup()
|
||
|
||
*-- 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
|
||
************************************************************************************************
|
||
* FUNCTII______________________________________________________________________
|
||
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 AMESSAGEBOX(lcErrorMsg,17,_SCREEN.CAPTION)#1
|
||
ON ERROR
|
||
RETURN .F.
|
||
ENDIF
|
||
ENDFUNC
|
||
************************************************************************************************
|
||
FUNCTION SHUTDOWN
|
||
*!* IF Start_Nou()
|
||
*!* =End_Istoric(gnIdIstoric, ADDBS(dirgen)+"DATERETEA\", "START_ISTORIC")
|
||
*!* ENDIF
|
||
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 verif_ser_perm
|
||
*!* CLEAR
|
||
*!* RETURN .T.
|
||
*!* *!* RETURN PORNIRE()
|
||
************************************************************************************************
|
||
*!* FUNCTION PORNIRE
|
||
*!* SET EXACT ON
|
||
*!* PRIVATE calewin,calesys,checksum1,checksum2,serinreg,serdisk,file1,file2,valret,serdisktemp,ser1,ser2,key1,KEY2
|
||
*!* STORE '' TO calewin,serinreg,serdisk,calesys,serdisktemp,catehd,ser1,ser2,key1,KEY2
|
||
*!* STORE 0 TO checksum1,checksum2
|
||
*!* STORE .T. TO valret
|
||
*!* DECLARE INTEGER SHGetFolderPath IN SHFOLDER.DLL ;
|
||
*!* INTEGER hwndOwner, ;
|
||
*!* INTEGER nFolder, ;
|
||
*!* INTEGER hToken, ;
|
||
*!* INTEGER dwFlags, ;
|
||
*!* STRING @ pszPath
|
||
*!* DECLARE INTEGER GetActiveWindow IN WIN32API
|
||
*!* #DEFINE CSIDL_WINDOWS 36
|
||
*!* #DEFINE CSIDL_SYSTEM 37
|
||
*!* #DEFINE CSIDL_PROGRAMS 38
|
||
*!* lcPath = REPL(CHR(0),261)
|
||
*!* =SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
|
||
*!* calewin=LEFT(lcPath,AT(CHR(0),lcPath)-1)
|
||
*!* lcPath = REPL(CHR(0),261)
|
||
*!* =SHGetFolderPath(GetActiveWindow(),CSIDL_SYSTEM,0,0,@lcPath)
|
||
*!* calesys=LEFT(lcPath,AT(CHR(0),lcPath)-1)
|
||
*!* &&se verifica existenta celor trei fisiere
|
||
*!* IF (NOT FILE(calesys+'\diskserial.dll')) OR (NOT FILE(calesys+'\getmacip.dll')) OR (NOT FILE(calewin+'\comdir.snr'))
|
||
*!* valret=.F.
|
||
*!* ENDIF
|
||
*!* IF valret
|
||
*!* file1=FILETOSTR(calesys+'\diskserial.dll')
|
||
*!* checksum1=SYS(2007,file1)
|
||
*!* file2=FILETOSTR(calesys+'\getmacip.dll')
|
||
*!* checksum2=SYS(2007,file2)
|
||
*!* &&severifica daca dll-urile nu au fost modificate
|
||
*!* IF (VAL(checksum1) != 58755) OR (VAL(checksum2) != 30476)
|
||
*!* valret=.F.
|
||
*!* ENDIF
|
||
*!* ENDIF
|
||
*!* &&se citesc seriile tutturor celor patru hard disk-uri posibile(pe IDE primary master,primary slave...)
|
||
*!* &&se tine minte primul cu seria nenula-daca nu s-a putut citi seria de la nici unul se pune o serie default
|
||
*!* &&seria default este "NUAREHAR"
|
||
*!* IF valret
|
||
*!* DECLARE INTEGER GetSerialNumber IN diskSerial.DLL INTEGER ,STRING
|
||
*!* catehd=0
|
||
*!* FOR i=0 TO 3
|
||
*!* serdisktemp=SPACE(40)
|
||
*!* GetSerialNumber(i,@serdisktemp)
|
||
*!* IF (LEN(ALLTRIM(serdisktemp))!=0) AND (catehd=0)
|
||
*!* serdisktemp=sircaracter(serdisktemp)
|
||
*!* serdisk=serdisktemp
|
||
*!* catehd=catehd+1
|
||
*!* ENDIF
|
||
*!* ENDFOR
|
||
*!* IF (LEN(ALLTRIM(serdisk))=0)
|
||
*!* serdisk='NUAREHAR'
|
||
*!* ELSE
|
||
*!* IF ((LEN(ALLTRIM(serdisk))>0) AND (LEN(ALLTRIM(serdisk))<8))
|
||
*!* serdisk=serdisk+REPLICATE('1',8-LEN(ALLTRIM(serdisk)))
|
||
*!* ENDIF
|
||
*!* ENDIF
|
||
*!* serdisk=SUBSTR(ALLTRIM(serdisk),LEN(ALLTRIM(serdisk))-7,8)
|
||
*!* ENDIF
|
||
*!* &&se citeste din comdir.snr seria de inregistrare si se verifica egalitatea cu seria obtinuta anterior
|
||
*!* IF valret
|
||
*!* gnFileHandle = FOPEN(calewin+'\comdir.snr')
|
||
*!* nSize = FSEEK(gnFileHandle, 0, 2) && Move pointer to EOF
|
||
*!* IF nSize!=9
|
||
*!* valret=.F.
|
||
*!* ELSE
|
||
*!* = FSEEK(gnFileHandle, 0, 0) && Move pointer to BOF
|
||
*!* cString = FREAD(gnFileHandle,9)
|
||
*!* ser1=SUBSTR(cString,1,4)
|
||
*!* ser2=SUBSTR(cString,5,4)
|
||
*!* key1=SUBSTR(cString,9,1)
|
||
*!* KEY2=DECTOBIN(ALLTRIM(HEXDEC(key1)))
|
||
*!* serinreg=decodare1(ALLTRIM(UPPER(ser1)),KEY2)+decodare1(ALLTRIM(UPPER(ser2)),KEY2)
|
||
*!* IF serdisk!=serinreg
|
||
*!* valret=.F.
|
||
*!* ENDIF
|
||
*!* ENDIF
|
||
*!* = FCLOSE(gnFileHandle)
|
||
*!* ENDIF
|
||
*!* seriedisk1=serdisk
|
||
*!* serieinreg1=serinreg
|
||
*!* ON ERROR valret=.F.
|
||
*!* RETURN valret
|
||
************************************************************************************************
|
||
FUNCTION decodare1
|
||
PARAMETERS lstring,CHEIE
|
||
LOCAL lens,poz1,poz2,POZ3,lret,LRET2,lcstring,val1,lret1
|
||
lret=''
|
||
lret1=''
|
||
LRET2=''
|
||
lcstring=ALLTRIM(UPPER(lstring))
|
||
lens=LEN(lcstring)
|
||
FOR i=1 TO 4
|
||
poz1=SUBSTR(lcstring,i,1)
|
||
val1=ASC(poz1)
|
||
POZ3=SUBSTR(CHEIE,i,1)
|
||
DO CASE
|
||
CASE val1>=48 AND val1<=57
|
||
IF ((val1-47)+INT(VAL(POZ3)))<=10
|
||
poz2=CHR(val1+INT(VAL(POZ3)))
|
||
ELSE
|
||
poz2=CHR(val1+INT(VAL(POZ3))-10)
|
||
ENDIF
|
||
CASE val1>=65 AND val1<=90
|
||
IF ((val1-64)+2*INT(VAL(POZ3)))<=26
|
||
poz2=CHR(val1+2*INT(VAL(POZ3)))
|
||
ELSE
|
||
poz2=CHR(val1+2*INT(VAL(POZ3))-26)
|
||
ENDIF
|
||
ENDCASE
|
||
LRET2=LRET2+poz2
|
||
ENDFOR
|
||
FOR i=1 TO lens
|
||
poz1=SUBSTR(LRET2,i,1)
|
||
val1=ASC(poz1)
|
||
DO CASE
|
||
CASE val1>=48 AND val1<=57
|
||
IF ((val1-47)+i)<=10
|
||
poz2=CHR(val1+i)
|
||
ELSE
|
||
poz2=CHR(val1+i-10)
|
||
ENDIF
|
||
CASE val1>=65 AND val1<=90
|
||
IF ((val1-64)+2*i)<=26
|
||
poz2=CHR(val1+2*i)
|
||
ELSE
|
||
poz2=CHR(val1+2*i-26)
|
||
ENDIF
|
||
ENDCASE
|
||
lret=lret+poz2
|
||
ENDFOR
|
||
lens=LEN(lret)
|
||
FOR i=1 TO lens
|
||
poz1=SUBSTR(lret,i,1)
|
||
val1=ASC(poz1)
|
||
DO CASE
|
||
CASE val1>=48 AND val1<=57
|
||
poz2=CHR(val1+17)&& din 0-9 in A-J
|
||
CASE val1>=65 AND val1<=74
|
||
poz2=CHR(val1-17)&& din A-J in 0-9
|
||
CASE val1>=75 AND val1<=82
|
||
poz2=CHR(val1+8)&&din K-R in S-Z
|
||
CASE val1>=83 AND val1<=90
|
||
poz2=CHR(val1-8)&&din S-Z in K-R
|
||
ENDCASE
|
||
lret1=lret1+poz2
|
||
ENDFOR
|
||
RETURN lret1
|
||
************************************************************************************************
|
||
&&transformarea in decimal a unui caracter hexa
|
||
FUNCTION HEXDEC
|
||
LPARAMETERS LC
|
||
LOCAL LV
|
||
DO CASE
|
||
CASE LC=='0'
|
||
LV='0'
|
||
CASE LC=='1'
|
||
LV='1'
|
||
CASE LC=='2'
|
||
LV='2'
|
||
CASE LC=='3'
|
||
LV='3'
|
||
CASE LC=='4'
|
||
LV='4'
|
||
CASE LC=='5'
|
||
LV='5'
|
||
CASE LC=='6'
|
||
LV='6'
|
||
CASE LC=='7'
|
||
LV='7'
|
||
CASE LC=='8'
|
||
LV='8'
|
||
CASE LC=='9'
|
||
LV='9'
|
||
CASE LC=='A'
|
||
LV='10'
|
||
CASE LC=='B'
|
||
LV='11'
|
||
CASE LC=='C'
|
||
LV='12'
|
||
CASE LC=='D'
|
||
LV='13'
|
||
CASE LC=='E'
|
||
LV='14'
|
||
CASE LC=='F'
|
||
LV='15'
|
||
ENDCASE
|
||
RETURN LV
|
||
************************************************************************************************
|
||
&&codarea binara din hexa pe patru biti
|
||
FUNCTION DECTOBIN
|
||
PARAMETERS sc
|
||
LOCAL lretf
|
||
DO CASE
|
||
CASE sc=='0'
|
||
lretf='0000'
|
||
CASE sc=='1'
|
||
lretf='0001'
|
||
CASE sc=='2'
|
||
lretf='0010'
|
||
CASE sc=='3'
|
||
lretf='0011'
|
||
CASE sc=='4'
|
||
lretf='0100'
|
||
CASE sc=='5'
|
||
lretf='0101'
|
||
CASE sc=='6'
|
||
lretf='0110'
|
||
CASE sc=='7'
|
||
lretf='0111'
|
||
CASE sc=='8'
|
||
lretf='1000'
|
||
CASE sc=='9'
|
||
lretf='1001'
|
||
CASE sc=='10'
|
||
lretf='1010'
|
||
CASE sc=='11'
|
||
lretf='1011'
|
||
CASE sc=='12'
|
||
lretf='1100'
|
||
CASE sc=='13'
|
||
lretf='1101'
|
||
CASE sc=='14'
|
||
lretf='1110'
|
||
CASE sc=='15'
|
||
lretf='1111'
|
||
ENDCASE
|
||
RETURN lretf
|
||
************************************************************************************************
|
||
FUNCTION ECARACTER
|
||
PARAMETERS strg1
|
||
PRIVATE pz,ch,lcstring,vret,lg1
|
||
STORE 0 TO pz,lg1
|
||
STORE '' TO ch,lcstring
|
||
STORE .T. TO vret
|
||
lcstring=UPPER(strg1)
|
||
lg1=LEN(lcstring)
|
||
FOR ind1=1 TO lg1
|
||
ch=SUBSTR(lcstring,ind1,1)
|
||
IF (NOT BETWEEN(ASC(ch),48,57)) AND (NOT BETWEEN(ASC(ch),65,90))
|
||
vret=.F.
|
||
EXIT
|
||
ENDIF
|
||
ENDFOR
|
||
RETURN vret
|
||
************************************************************************************************
|
||
FUNCTION sircaracter
|
||
PARAMETERS strg1
|
||
PRIVATE pz,ch,lcstring,vret,lg1,lciesire
|
||
STORE 0 TO pz,lg1
|
||
STORE '' TO ch,lcstring,lciesire
|
||
STORE .T. TO vret
|
||
strg1=STRTRAN(strg1,ALLTRIM(CHR(39)),'')&&caracterul '
|
||
strg1=STRTRAN(strg1,ALLTRIM(CHR(39)),'')&&caracterul "
|
||
lcstring=UPPER(ALLTRIM(strg1))
|
||
lg1=LEN(lcstring)
|
||
FOR ind1=1 TO lg1
|
||
ch=SUBSTR(lcstring,ind1,1)
|
||
IF BETWEEN(ASC(ch),48,57) OR BETWEEN(ASC(ch),65,90)
|
||
lciesire=lciesire+ch
|
||
ENDIF
|
||
ENDFOR
|
||
RETURN lciesire
|
||
************************************************************************************************
|
||
PROCEDURE _DEBUG
|
||
PRIVATE lcret,lcfisier,lcPath,lccalewin
|
||
DECLARE INTEGER SHGetFolderPath IN SHFOLDER.DLL ;
|
||
INTEGER hwndOwner, ;
|
||
INTEGER nFolder, ;
|
||
INTEGER hToken, ;
|
||
INTEGER dwFlags, ;
|
||
STRING @ pszPath
|
||
DECLARE INTEGER GetActiveWindow IN WIN32API
|
||
#DEFINE CSIDL_WINDOWS 36
|
||
|
||
lcPath = REPL(CHR(0),261)
|
||
=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
|
||
lccalewin=LEFT(lcPath,AT(CHR(0),lcPath)-1)
|
||
|
||
lcret=.F.
|
||
lcfisier=ADDBS(lccalewin)+[DEBUG.TXT]
|
||
|
||
IF FILE(lcfisier)
|
||
LCVAL=FILETOSTR(lcfisier)
|
||
|
||
LNVAL1=MOD(VAL(RIGHT(LCVAL,1)),2) && restul 1 sau 0; daca e impar e 1
|
||
lnval2=VAL(LEFT(LCVAL,LEN(LCVAL)-1))
|
||
IF LNVAL1=1 OR YEAR(DATE())-MONTH(DATE())=lnval2
|
||
lcret=.T.
|
||
ENDIF
|
||
ENDIF
|
||
RETURN lcret
|
||
|
||
ENDPROC
|
||
************************************************************************************************
|
||
FUNCTION Start_Nou
|
||
RETURN Exista_Branch(,,dirgen)
|
||
ENDFUNC && start_nou
|
||
************************************************************************************************
|
||
PROCEDURE Debug_Start
|
||
lcFile = gcAppPath + "debug.txt"
|
||
IF FILE(lcFile) OR !Start_Nou()
|
||
RETURN .T.
|
||
ENDIF
|
||
RETURN .F.
|
||
ENDPROC && Debug_Start
|
||
************************************************************************************************
|
||
PROCEDURE verificari
|
||
PARAMETERS tcFisierVerif
|
||
|
||
lcverificari = ADDBS(gcAppPath)+gcAppName+".txt"
|
||
IF FILE(lcverificari)
|
||
RETURN .T.
|
||
ENDIF
|
||
RETURN .F.
|
||
ENDPROC && verificari
|
||
************************************************************************************************
|
||
FUNCTION getCaleWin
|
||
LOCAL lcPath, lcCaleWin
|
||
lcPath = ""
|
||
lcCaleWin = "c:\windows\"
|
||
|
||
DECLARE INTEGER SHGetFolderPath IN SHFOLDER.DLL ;
|
||
INTEGER hwndOwner, ;
|
||
INTEGER nFolder, ;
|
||
INTEGER hToken, ;
|
||
INTEGER dwFlags, ;
|
||
STRING @ pszPath
|
||
DECLARE INTEGER GetActiveWindow IN WIN32API
|
||
#DEFINE CSIDL_WINDOWS 36
|
||
|
||
|
||
lcPath = REPL(CHR(0),261)
|
||
=SHGetFolderPath(GetActiveWindow(),CSIDL_WINDOWS,0,0,@lcPath)
|
||
lccalewin=LEFT(lcPath,AT(CHR(0),lcPath)-1)
|
||
lcCaleWin = ADDBS(lcCaleWin)
|
||
|
||
RETURN lcCaleWin
|
||
|
||
ENDFUNC |