1218 lines
32 KiB
Plaintext
1218 lines
32 KiB
Plaintext
*!* 11.05.2015
|
||
*!* marius.mutu
|
||
*!* gcArticolBonFiscalCont: numele articolului care se va lista pe bonul fiscal. daca nu este completat se listeaza (Fact. Nr.)
|
||
|
||
*!* 26.06.2015
|
||
*!* marius.mutu
|
||
*!* goKeepAlive: Tin conexiunea deschisa. La wert??? apare eroarea odbc "timeout occured" daca se lasa peste 1 minut programul fara sa se lucreze
|
||
|
||
Parameters tparam
|
||
|
||
Private gcParameters
|
||
If !Empty(tparam) And Type('tparam') = 'C'
|
||
gcParameters = tparam
|
||
Else
|
||
gcParameters = ""
|
||
Endif
|
||
&&& cont2003
|
||
|
||
* messagebox(sys(2019,2)) && locatia config.fpw
|
||
|
||
Public gnewcryptfll
|
||
Public gnewcryptxml
|
||
PUBLIC gTransferTotal
|
||
STORE -1 TO gTransferTotal
|
||
gnewcryptfll=.F.
|
||
gnewcryptxml=.F.
|
||
|
||
Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp
|
||
Public gcNumeProgram,gcAntet,gfiltru,gfiltruro
|
||
Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp, gcAntet
|
||
Store 0 To lnIdUtil, lnIdProgram
|
||
gcNumeProgram=[ROACONT]
|
||
_Screen.Icon=gcNumeProgram+'.ico'
|
||
If !Like(gcNumeProgram + '*', Upper(Alltrim(Juststem(Sys(16,0)))))
|
||
Messagebox("Nu puteti porni acest program!",0+16,"Atentie")
|
||
Return
|
||
Endif
|
||
*!* _screen.Icon = 'D:\CONTAFIN_ORACLE\COMUN\GRAFICE\ICONITE\CONT2003.ICO'
|
||
|
||
|
||
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 '.'
|
||
|
||
*!* 06.06.2007
|
||
*!* mutu.marius
|
||
Set SQLBUFFERING On
|
||
|
||
_Screen.Visible=.T.
|
||
|
||
|
||
|
||
|
||
*VARIABILE_______
|
||
Local lcMainClassLib
|
||
Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
|
||
|
||
*VARIABILE__________________________________________________________________________
|
||
Declare nror[65000]
|
||
Declare RTVA[22,2]
|
||
err1=.F.
|
||
|
||
Public CRLF
|
||
Store Chr(13) + Chr(10) To CRLF
|
||
Public pcNl,pcAn
|
||
Store "" To pcNl,pcAn && se initializeaza in start00
|
||
|
||
Public pcTitlu,pl_verificat
|
||
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 OStart,OSETVIZ,OSETTULBAR,OSETINSTRUM,orm,OTEXT,OJUR,osetgest,tlbr_INSTR,tlbr_VIZ,oprinc,DIRGEN
|
||
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")
|
||
|
||
*!* Set Path To ;Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS
|
||
|
||
Public gcAppPath,gcAppName, gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp, gcSettingsFile
|
||
Store '' To gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces
|
||
PUBLIC gcBasePath
|
||
|
||
*!* PUBLIC gcSchemaPath
|
||
*!* STORE '' TO gcSchemaPath
|
||
|
||
*!* gcAppPath=ADDBS(JUSTPATH(SYS(16,0))) && d:\contafin\cont2003\
|
||
Set Procedure To "D:\ROA\ROACONT\COMUN\UTILE\web\WWUTILS.PRG" Additive
|
||
Set Procedure To "D:\ROA\ROACONT\COMUN\UTILE\web\WWAPI.PRG" Additive
|
||
|
||
gcAppPath = Addbs(ShortPath(GetAppStartPath()))
|
||
If Right(gcAppPath ,9)="PROGRAME\"
|
||
gcAppPath = Substr(gcAppPath ,1,Len(gcAppPath )-9)
|
||
Endif
|
||
gcAppName=Allt(Uppe(Juststem(Sys(16,0)))) && "cont2003"
|
||
*!*Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive && modificare v 2.0.59
|
||
|
||
|
||
*gcAppDataPath=gcAppPath+"Date_"+gcAppName+"\" && D:\CONTAFIN\TRANS\DATE_TRANS && PT OPTIUNI , FISIERE SPECIFICE PROGRAMULUI SI
|
||
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\CLASE;' + ;
|
||
gcAppPath + 'COMUN\FERESTRE;' + ;
|
||
gcAppPath + 'COMUN\PROGRAME;' + ;
|
||
gcAppPath + 'COMUN\GRAFICE;' + ;
|
||
gcAppPath + 'COMUN\RAPOARTE;' + ;
|
||
gcAppPath + 'COMUN\UTILE\CALENDAR;' + ;
|
||
gcAppPath + 'COMUN\UTILE\CTL32;' + ;
|
||
gcAppPath + 'COMUN\UTILE\HPDF;' + ;
|
||
gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
|
||
gcAppPath + 'COMUN\UTILE\WEB;' + ;
|
||
gcAppPath + 'COMUN\UTILE\NFJSON;' + ;
|
||
gcAppPath + 'COMUN\UTILE\NFXML;' + ;
|
||
gcAppPath + 'COMUN\UTILE\EXCEL;' + ;
|
||
gcAppPath + 'COMUN\UTILE\GridExtras ;' + ;
|
||
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="clase\cont2000"
|
||
|
||
|
||
|
||
*CLASE__________________________________________________________
|
||
Set Classlib To (lcMainClassLib) Additive
|
||
Set Classlib To CAUT Additive
|
||
* SET CLASSLIB TO FERESTREBAZA ADDITIVE
|
||
Set Classlib To BAZA Additive
|
||
Set Classlib To contab Additive
|
||
Set Classlib To comun Additive
|
||
Set Classlib To registry Additive
|
||
Set Classlib To cauta_alfa_forms.vcx Additive
|
||
Set Classlib To obalanta Additive
|
||
Set Classlib To ocriterii.vcx Additive
|
||
Set Classlib To ctl32_statusbar.vcx Additive
|
||
Set Classlib To ctl32_common.vcx Additive
|
||
Set Classlib To ctl32_structs.vcx Additive
|
||
Set Classlib To ctl32_progressbar.vcx Additive
|
||
*!* SET CLASSLIB TO ctl32_scontainer.vcx additive
|
||
|
||
|
||
*PROCEDURI______________________________________________________
|
||
Set Procedure To PROCEDURI Additive
|
||
Set Procedure To pmenu Additive
|
||
Set Procedure To proceduri_comune Additive
|
||
Set Procedure To mesaje Additive
|
||
Set Procedure To acces_meniu Additive
|
||
Set Procedure To quitapp Additive
|
||
Set Procedure To init_program Additive
|
||
Set Procedure To oproceduri_maintenance.PRG Additive
|
||
Set Procedure To gridproc Additive
|
||
Set Procedure To proceduri_excel Additive
|
||
Set Procedure To oserii_numere.PRG Additive
|
||
Set Procedure To cauta_alfa Additive
|
||
Set Procedure To oproceduri_parteneri Additive
|
||
Set Procedure To oproceduri_incasari Additive
|
||
Set Procedure To oserii_numere Additive
|
||
Set Procedure To wwconfig Additive
|
||
Set Procedure To oexport Additive
|
||
SET PROCEDURE TO ocasabanca ADDITIVE
|
||
SET PROCEDURE TO importfromxlsx ADDITIVE
|
||
SET PROCEDURE TO appendfromxlsx.prg ADDITIVE
|
||
SET PROCEDURE TO excelxml.prg ADDITIVE
|
||
SET PROCEDURE TO overificari.prg ADDITIVE
|
||
SET PROCEDURE TO onomenclatoare.prg ADDITIVE
|
||
|
||
SET PROCEDURE TO saft_d406.prg ADDITIVE
|
||
SET PROCEDURE TO ofacturare.prg ADDITIVE
|
||
SET PROCEDURE TO ofacturare_comun.prg ADDITIVE
|
||
SET PROCEDURE TO oproceduri_facturare.prg ADDITIVE
|
||
SET PROCEDURE TO anaf_efactura.prg ADDITIVE
|
||
SET PROCEDURE TO import_efactura.prg ADDITIVE
|
||
SET PROCEDURE TO xmlefactura.prg ADDITIVE
|
||
|
||
SET PROCEDURE TO oscrie_in_fisiere.prg ADDITIVE
|
||
SET PROCEDURE TO chatbot.prg ADDITIVE
|
||
|
||
SET PROCEDURE TO oproceduri_listari.prg ADDITIVE && listare NIR gestiune din import eFactuar
|
||
|
||
&& CLASE ORACLE
|
||
Set Classlib To DECABAZA Additive
|
||
Set Classlib To onomenclatoare Additive
|
||
Set Classlib To oparteneri Additive
|
||
Set Classlib To OCASABANCA Additive
|
||
Set Classlib To OVANZCUMP Additive
|
||
Set Classlib To oCompensari Additive
|
||
Set Classlib To oRapoarte_cont Additive
|
||
Set Classlib To oSit_Op Additive
|
||
Set Classlib To overificari Additive
|
||
Set Classlib To oteste Additive
|
||
Set Classlib To omodificari Additive
|
||
Set Classlib To ooptiuni Additive
|
||
Set Classlib To ointroduceri_cont Additive
|
||
Set Classlib To onote_contabile Additive
|
||
Set Classlib To odebcred Additive
|
||
Set Classlib To ferestre_oracle Additive
|
||
Set Classlib To caut_ora Additive
|
||
Set Classlib To otoolbar Additive
|
||
Set Classlib To inchideri_sal Additive
|
||
Set Classlib To serii_numere Additive
|
||
***19.10.2015
|
||
***liana.neagu
|
||
Set Classlib To contabilitate_rapoarte Additive
|
||
*** 02.08.2006
|
||
*** marius.mutu
|
||
Set Classlib To oconversii Additive
|
||
|
||
*!* 16.01.2007
|
||
*!* marius.mutu
|
||
Set Classlib To oactualizari Additive
|
||
SET CLASSLIB TO onom_articole ADDITIVE
|
||
|
||
&& CLASE UTILITARE
|
||
Set Classlib To Messagebox Additive
|
||
SET CLASSLIB TO wwdialogs ADDITIVE
|
||
*!* modificare v 2.0.140
|
||
SET CLASSLIB TO orapoarte.vcx additive
|
||
SET CLASSLIB TO orapoarte_contabilitate.vcx additive
|
||
*!* modificare v 2.0.140 ^
|
||
|
||
SET CLASSLIB TO accessibility.vcx ADDITIVE
|
||
SET CLASSLIB TO _calendar.vcx ADDITIVE
|
||
|
||
SET CLASSLIB TO orapoarte_comun.vcx ADDITIVE
|
||
|
||
SET CLASSLIB TO saft_d406.vcx ADDITIVE
|
||
SET CLASSLIB TO anaf_efactura.vcx ADDITIVE
|
||
|
||
|
||
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
||
|
||
&& PROCEDURI ORACLE
|
||
Set Procedure To GENCURSOR.PRG Additive
|
||
Set Procedure To OPROCEDURI_COMUNE.PRG Additive
|
||
Set Procedure To OINIT_OPTIUNI.PRG Additive
|
||
Set Procedure To updateserver.PRG Additive
|
||
Set Procedure To oCompensari.PRG Additive
|
||
Set Procedure To oSituatii_Operative.PRG Additive
|
||
Set Procedure To oOperatii_comune.PRG Additive
|
||
|
||
Set Procedure To OCONT2003.PRG Additive
|
||
Set Procedure To OPROCEDURI_aMS.PRG Additive
|
||
Set Procedure To oparteneri.PRG Additive
|
||
Set Procedure To orapoarte.PRG Additive
|
||
Set Procedure To orap_trezorerie Additive
|
||
Set Procedure To ocautare Additive
|
||
Set Procedure To omeniu_initializari Additive
|
||
Set Procedure To osecurity Additive
|
||
Set Procedure To oheader Additive
|
||
Set Procedure To orefaceri Additive
|
||
Set Procedure To oproceduri_casademarcat Additive
|
||
*!* modificare v 2.0.74
|
||
*!* Set Procedure To oproceduri_casa_marcat_e500 Additive
|
||
Set Procedure To controllerecr Additive
|
||
*!* modificare v 2.0.74 ^
|
||
*!* 12.07.2006
|
||
*!* marius.mutu
|
||
Set Procedure To oproceduri_comune_imob.PRG Additive
|
||
*!* 02.08.2006
|
||
*!* marius.mutu
|
||
Set Procedure To oproceduri_conversie.PRG Additive
|
||
|
||
*!* 17.08.2006
|
||
*!* marius.mutu
|
||
Set Procedure To odocumente.PRG Additive
|
||
|
||
*!* 16.01.2007
|
||
*!* marius.mutu
|
||
Set Procedure To oproceduri_actualizari.PRG Additive
|
||
|
||
*!* modificare v 2.0.140
|
||
SET PROCEDURE TO orapoarte_dinamice.prg additive
|
||
*!* modificare v 2.0.140 ^
|
||
|
||
SET PROCEDURE TO update_imob.prg ADDITIVE
|
||
|
||
SET PROCEDURE TO oproceduri_import.prg ADDITIVE
|
||
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
||
|
||
*!* 21.06.2006
|
||
*!* marius.mutu
|
||
Set Procedure To wwutils.PRG Additive
|
||
Set Procedure To wwxmlhttp.PRG Additive
|
||
Set Procedure To ini.PRG Additive
|
||
|
||
*!* 28.06.2007
|
||
Set Procedure To regex.PRG Additive
|
||
Set Procedure To validare.PRG Additive && validare cif
|
||
|
||
&& pt. recalculare randuri la decont TVA
|
||
Set Procedure To oproceduri_evolutie Additive
|
||
Set Procedure To oproceduri_decont Additive
|
||
|
||
Set Procedure To proceduri_rapoarte.PRG Additive
|
||
|
||
*!* modificare v 2.0.95
|
||
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
|
||
SET PROCEDURE TO wwapi.prg ADDITIVE
|
||
*!* modificare v 2.0.95^
|
||
|
||
*!* modificare v 2.5.28
|
||
Declare Integer GetPrivateProfileString In WIN32API ;
|
||
string, String, String, String @, Integer, String
|
||
Declare Integer WritePrivateProfileString In Win32Api ;
|
||
string, String, String, String
|
||
Declare Integer CopyFile In WIN32API ;
|
||
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.5.28 ^
|
||
|
||
If Type('goApi') = 'U'
|
||
Public goApi
|
||
goApi = Newobject("wwAPI", "wwAPI.prg")
|
||
ENDIF
|
||
|
||
|
||
*!* modificare v 2.0.74
|
||
Private goControllerEcr
|
||
goControllerEcr = Createobject('oControllerEcr')
|
||
*!* modificare v 2.0.74 ^
|
||
|
||
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
|
||
|
||
Public glVerificTabel && daca se verifica structura tabelelor in totv.prg
|
||
glVerificTabel=.T.
|
||
|
||
Public glQuit
|
||
glQuit = .F.
|
||
|
||
Public gnIdIstoric
|
||
gnIdIstoric = 0
|
||
|
||
|
||
|
||
Store "" To gcTempPath, gcCaleServerDate
|
||
liat=Rat("\",gcAppPath,2)
|
||
gcDirMare=Left(gcAppPath,liat)
|
||
|
||
|
||
|
||
|
||
*!* IF !DIRECTORY(gcAppDataPath)
|
||
*!* MD (gcAppDataPath)
|
||
*!* ENDIF
|
||
|
||
|
||
|
||
*** DIRGEN
|
||
liat = Rat("\",gcAppPath,2)
|
||
DIRGEN = Addbs(Left(gcAppPath,liat-1))
|
||
|
||
|
||
gcSecurityPath = DIRGEN + 'Security\'
|
||
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
|
||
|
||
Cd &DIRGEN
|
||
gcBasePath = DIRGEN
|
||
|
||
*!* 21.06.2006
|
||
*!* marius.mutu
|
||
Private gcGeneralIniFile
|
||
gcGeneralIniFile = DIRGEN + "settings.ini"
|
||
gcSettingsFile = m.gcGeneralIniFile
|
||
If !File(gcGeneralIniFile)
|
||
|
||
TEXT TO lcSettings NOSHOW
|
||
[errors]
|
||
host=http://romfast.dnsalias.com: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","utility.vcx")
|
||
goKeepAlive.interval = m.lnKeepAlive * 1000
|
||
goKeepAlive.enabled = .T.
|
||
ENDIF
|
||
|
||
PUBLIC 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
|
||
gcLocalePath = gcAppPath + "Locale\"
|
||
glTraducere = .F.
|
||
*!* lcLocaleDb = gcLocalePath + "locale.dbc"
|
||
*!* Open Database (m.lcLocaleDb)
|
||
*!* modificare v 2.0.85
|
||
*!* 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
|
||
*!* modificare v 2.0.85 ^
|
||
If Empty(m.lcLanguage)
|
||
gcLocale = 'Romana'
|
||
Else
|
||
gcLocale = m.lcLanguage
|
||
ENDIF
|
||
*!* modificare v 2.0.85
|
||
Local lcObjLocale
|
||
If gcLocale = 'Romana'
|
||
lcObjLocale = [Locale_dummy]
|
||
Else
|
||
lcObjLocale = [Locale]
|
||
Endif
|
||
goLocale=Newobject(lcObjLocale,"Locale.vcx")
|
||
If !Empty(m.llLocale) And m.llLocale<>'0'
|
||
goLocale.llocale=.T.
|
||
Endif
|
||
Release lcObjLocale
|
||
*!* modificare v 2.0.85 ^
|
||
goLocale.locale = gcLocale
|
||
*!* Locale ^
|
||
|
||
If verificari()
|
||
_Screen.Visible=.T.
|
||
Do mesaj With "Se fac verificari programului","Va rugam reveniti"
|
||
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.
|
||
Do mesaj With "Programul trebuie pornit doar din START",""
|
||
Quit
|
||
Endif
|
||
Endif
|
||
|
||
|
||
|
||
|
||
*!* modificare v 2.0.140
|
||
*!* Public tipar,SER_PERM,SER_PERI,VERSIUNE
|
||
*!* Store .F. To SER_PERM,SER_PERI
|
||
*!* modificare v 2.0.140 ^
|
||
***************************** VARIABILE ORACLE
|
||
Private goUtilizator
|
||
Private gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA,GNDIFZILE, gcUserNameApp, gcPasswordApp, gcAcces
|
||
Private gnButon && variabila pentru renunt si terminat
|
||
Store 2 To gnButon
|
||
Store '' To GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, gcNivelUtilizator, gcGrupUtilizator, gcAcces
|
||
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
|
||
|
||
***toolbar***
|
||
Private otool,ohelp
|
||
Store '' To otool,ohelp
|
||
***toolbar***
|
||
|
||
Private glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa,glListareBonFiscalCont, gcArticolBonFiscalCont
|
||
|
||
Store .F. To glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa,glListareBonFiscalCont
|
||
gcArticolBonFiscalCont = "" && numele articolului care se va lista pe bonul fiscal. daca nu este completat se listeaza (Fact. Nr.)
|
||
|
||
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")
|
||
|
||
&& obiect global pentru export : frx, xls
|
||
Private goExport
|
||
goExport = Createobject("oExportConfig")
|
||
|
||
*!* 21.06.2006
|
||
*!* marius.mutu
|
||
Private goMyXMLHTTP
|
||
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
|
||
goMyXMLHTTP = Createobject("MyXMLHTTP", lcHostErrors)
|
||
|
||
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
|
||
|
||
*!* modificare v 2.0.140
|
||
MODEL_PROGRAM = [M]
|
||
*!* Use &gcAppPath\SERCONT 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
|
||
*!* modificare v 2.0.140 ^
|
||
Public NUMEPROGRAM,MENIUPROGRAM,FUNDALPROGRAM
|
||
|
||
|
||
|
||
m.contab = 'TOTAL'
|
||
Do Case
|
||
Case M.contab='CASA'
|
||
NUMEPROGRAM='CONTAFIN CASA'
|
||
MENIUPROGRAM=gcAppPath+"meniuri\contORICEcasa.mpr"
|
||
FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDALORICE.scx"
|
||
_program='cont'
|
||
Case M.contab='COMERT'
|
||
NUMEPROGRAM='CONTAFIN COMERCIAL'
|
||
MENIUPROGRAM=gcAppPath+"meniuri\contCOMERT.mpr"
|
||
FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDALORICE.scx"
|
||
_program='cont'
|
||
Otherwise
|
||
NUMEPROGRAM='ROA Financiar Contabilitate '+MODEL_PROGRAM
|
||
MENIUPROGRAM=gcAppPath+"meniuri\cont2000.mpr"
|
||
FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx"
|
||
_program='cont'
|
||
|
||
Endcase
|
||
|
||
*-- Configure application object.*****************************
|
||
|
||
|
||
*!* 08.12.2010
|
||
PRIVATE gcReportPreviewer, gcReportPreviewerPath
|
||
gcReportPreviewer = "FoxyPreview" && oexport.prg && "FoxyPreview" && foloseste apelarea simpla a comunroa\foxypreviewer.app
|
||
gcReportPreviewerPath = dirgen + "COMUNROA\"
|
||
*!* 08.12.2010 ^
|
||
|
||
|
||
_Screen.WindowState=2
|
||
|
||
|
||
lcOnShutdown="ShutDown()"
|
||
On Shutdown &lcOnShutdown
|
||
On Error ErrorHandler(Error(),Program(),Lineno())
|
||
*_Shell="DO Cleanup IN progs\cont2003"
|
||
|
||
*-- Instantiate application object.***************************
|
||
Release goApp
|
||
private goApp
|
||
goApp=Createobject("cApplication")
|
||
|
||
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
|
||
|
||
*-- Restore default menu.
|
||
*!* Pop Menu _Msysmenu
|
||
|
||
*-- Restore environment.
|
||
On Error
|
||
On Shutdown
|
||
If Not lcLastSetClassLib==Set("classlib")
|
||
Release Classlib gcAppPath + 'clase\cont2000.vcx'
|
||
Endif
|
||
If Empty(lcLastSetPath)
|
||
Set Path To
|
||
Else
|
||
Set Path To &lcLastSetPath
|
||
Endif
|
||
If lcLastSetTalk=="ON"
|
||
Set Talk On
|
||
Else
|
||
Set Talk Off
|
||
Endif
|
||
cleanup()
|
||
|
||
Return
|
||
|
||
|
||
|
||
|
||
* FUNCTII______________________________________________________________________
|
||
Function ErrorHandler(nError,cMethod,nLine)
|
||
Local lcErrorMsg,lcCodeLineMsg
|
||
local loEx as Exception
|
||
|
||
goLog.Log('1','ErrorHandler')
|
||
Wait Clear
|
||
lcErrorMsg = 'nErrror: ' + transform(m.nError) + ' cMethod: ' + transform(m.cMethod) + ' line: ' + transform(m.nLine) + chr(13) + GETCALLSTACK()
|
||
goLog.Log(m.lcErrorMsg,'ErrorHandler')
|
||
|
||
lcErrorMsg = ""
|
||
lcCodeLineMsg = ""
|
||
|
||
try
|
||
goLog.Log('2','ErrorHandler')
|
||
lcErrorMsg=Message()+Chr(13)+Chr(13)
|
||
lcErrorMsg=lcErrorMsg+"Method: "+cMethod
|
||
lcCodeLineMsg=Message(1)
|
||
goLog.Log('3','ErrorHandler')
|
||
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
|
||
goLog.Log('4','ErrorHandler')
|
||
lcErrorMsg = lcErrorMsg + Chr(13) + Chr(10) + Chr(13) + Chr(10) + GETCALLSTACK()
|
||
goLog.Log('5','ErrorHandler')
|
||
catch to loEx
|
||
lcErrorMsg = 'Error ' + loEx.Message + Chr(13)+"Line: " + loEx.LineNo + Chr(13) + Chr(13) + loEx.Procedure
|
||
goLog.Log('6','ErrorHandler')
|
||
endtry
|
||
|
||
goLog.Log(lcErrorMsg,'ErrorHandler')
|
||
try
|
||
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
|
||
lcUserName = gcUserNameApp
|
||
lcProgram = Juststem(Sys(16,0))
|
||
goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
|
||
endif
|
||
catch to loEx
|
||
*
|
||
endtry
|
||
goLog.Log('7','ErrorHandler')
|
||
|
||
If AMESSAGEBOX(lcErrorMsg,17,_Screen.Caption)#1
|
||
On Error
|
||
On Shutdown
|
||
If _vfp.StartMode = 0
|
||
Debug
|
||
Suspend
|
||
Else
|
||
Quit
|
||
Endif
|
||
*!* RETURN .F.
|
||
endif
|
||
goLog.Log('8','ErrorHandler')
|
||
Endfunc
|
||
|
||
|
||
|
||
Function Shutdown
|
||
If Type("goApp")=="O" And Not Isnull(goApp)
|
||
RETURN goApp.OnShutDown()
|
||
Endif
|
||
On Shutdown
|
||
ON ERROR
|
||
CLEAR events
|
||
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 PORNIRE()
|
||
********
|
||
*?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
|
||
lcTextEroare = ""
|
||
If (Not File(calesys+'\diskserial.dll')) Or (Not File(calesys+'\getmacip.dll')) Or (Not File(calewin+'\comdir.snr'))
|
||
valret=.F.
|
||
lcTextEroare = lcTextEroare + calesys + '\diskserial.dll ' + Transform(File(calesys+'\diskserial.dll')) + ;
|
||
' ' + calesys+'\getmacip.dll' + Transform(File(calesys+'\getmacip.dll')) + ' ' + calewin+'\comdir.snr' + Transform(File(calewin+'\comdir.snr')) + Chr(13) + Chr(10)
|
||
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.
|
||
lcTextEroare = lcTextEroare + 'checksum1 ' + checksum1 + ' checksum2 ' + checksum2 + Chr(13) + Chr(10)
|
||
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.
|
||
lcTextEroare = lcTextEroare + 'nSize ' + Transform(nSize) + Chr(13) + Chr(10)
|
||
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.
|
||
lcTextEroare = lcTextEroare + 'serdisk ' + serdisk + ' serinreg ' + serinreg + Chr(13) + Chr(10)
|
||
Endif
|
||
Endif
|
||
= Fclose(gnFileHandle)
|
||
Endif
|
||
seriedisk1=serdisk
|
||
serieinreg1=serinreg
|
||
On Error valret=.F.
|
||
poLog.Log('Eroare verificare serie ' + Chr(13) + Chr(10) + lcTextEroare, Program())
|
||
If Type('goMyXMLHTTP') = 'O'
|
||
If !Empty(lcTextEroare)
|
||
goMyXMLHTTP.postError('Eroare verificare serie ' + Chr(13) + Chr(10) + lcTextEroare, gcUserNameApp, Juststem(Sys(16,0)))
|
||
Endif
|
||
Endif
|
||
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
|