*!* 12.12.2014 *!* adaugat libraria overificari.vcx pentru frm_verificare_parteneri Parameters tparam &&& roafacturare Public gcNumeProgram Local lchost, lcUserName, lcPassword, lnIdUtil, lnIdProgram, lcUserNameApp,lcPasswordApp Store '' To lchost, lcUserName, lcPassword, lcUserNameApp,lcPasswordApp Store 0 To lnIdUtil, lnIdProgram gcNumeProgram=[ROAFACTURARE] If !Like(gcNumeProgram + '*', Upper(Alltrim(Juststem(Sys(16,0))))) Messagebox("Nu puteti porni acest program!",0+16,"Atentie") Return Endif _Screen.Icon = gcNumeProgram+'.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 Decimals To 6 SET HOURS TO 24 _Screen.Visible=.F. *VARIABILE_______ Local lcMainClassLib Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown *VARIABILE__________________________________________________________________________ Public CRLF Store Chr(13) + Chr(10) To CRLF *!* ************************ *!* ** variabile pentru pmenu,ointroduceri Declare nror[65000] *!* sunt declarate ca private si in ofacturare.vcx > frm_facturi > do_sterge Public pcNl,pcAn,gnTipGest,gcGestPermis Store "" To pcNl,pcAn,gcGestPermis Store 0 To gnTipGest _program='facturare' *!* ************************ Public pcTitlu,pl_verificat Store "" To pcTitlu Store .F. To pl_verificat Public buton,primadata,dirgen,gcBasePath,col_menu,gcDirMare STORE '' TO gcDirMare 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") *!* modificare v 2.0.71 PUBLIC gcUtilizatoriPath, gcAppPath, gcAppName Store '' To gcUtilizatoriPath, gcAppPath, gcAppName Set Procedure To "d:\ROA\ROAFACTURARE\COMUN\UTILE\web\WWUTILS.PRG" Additive Set Procedure To "d:\ROA\ROAFACTURARE\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)))) 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\EMAIL;' + ; gcAppPath + 'COMUN\UTILE\NFJSON;' + ; gcAppPath + 'COMUN\UTILE\NFXML;' + ; Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] SET PATH TO &lcPath ADDITIVE *!* Set Path To ;Date;Include;FERESTRE;GRAFICE;Help;CLASE;MENIURI;PROGRAME;RAPOARTE;PROGS;LIBS *!* PUSH Menu _Msysmenu 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 *!* modificare v 2.0.71 ^ lcLastSetClassLib=Set("CLASSLIB") lcMainClassLib = m.gcAppPath + "comun\clase\appwiz.vcx" *CLASE__________________________________________________________ Set Classlib To (lcMainClassLib) Additive Set Classlib To registry Additive Set Classlib To cauta_alfa_forms Additive SET CLASSLIB TO ofacturare.vcx additive SET CLASSLIB TO ofacturare_comun.vcx additive SET CLASSLIB TO omodificari.vcx additive SET CLASSLIB TO accessibility.vcx 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 *PROCEDURI______________________________________________________ Set Procedure To proceduri_comune Additive Set Procedure To quitapp Additive Set Procedure To init_program Additive Set Procedure To onomenclatoare.prg Additive Set Procedure To onomenclatoare2.prg Additive SET PROCEDURE TO oproceduri_rapoarte_fact.prg ADDITIVE SET PROCEDURE TO email.prg ADDITIVE && CLASE ORACLE Set Classlib To DECABAZA Additive Set Classlib To onomenclatoare Additive Set Classlib To onomenclatoare2 Additive Set Classlib To ofacturare Additive Set Classlib To ofacturare_rapoarte Additive Set Classlib To orapoarte Additive Set Classlib To ferestre_oracle Additive Set Classlib To Messagebox Additive Set Classlib To otoolbar Additive Set Classlib To onom_curs Additive Set Classlib To comun Additive Set Classlib To ferestre_cere_date Additive *** *!* Set Classlib To wwxml Additive Set Classlib To baza Additive Set Classlib To caut Additive Set Classlib To ointroduceri Additive Set Classlib To serii_numere Additive Set Classlib To caut_ora Additive *!* Set Classlib To ferestrebaza Additive *!* modificare v 2.0.70 SET CLASSLIB TO wwdialogs.vcx ADDITIVE *!* modificare v 2.0.70 ^ SET CLASSLIB TO _calendar.vcx Additive && v 2.2.9 Set Classlib To locale Additive && v 2.2.15 SET CLASSLIB TO overificari ADDITIVE *** COMENZI SET CLASSLIB TO ocomenzi 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 OPROCEDURI_aMS.PRG Additive Set Procedure To ocautare Additive Set Procedure To odocumente Additive Set Procedure To osecurity Additive Set Procedure To acces_meniu Additive Set Procedure To wwxmlhttp.prg Additive Set Procedure To wwcodeupdate.prg Additive Set Procedure To ini.prg Additive Set Procedure To cauta_alfa.prg Additive Set Procedure To oHeader.prg Additive Set Procedure To oproceduri_curs.prg Additive Set Procedure To proceduri.prg Additive Set Procedure To oproceduri_facturare.prg Additive Set Procedure To proceduri_rapoarte.prg Additive Set Procedure To ofacturare.prg Additive Set Procedure To oserii_numere.prg Additive Set Procedure To wwutils.prg Additive Set Procedure To wwConfig.prg Additive Set Procedure To wwApi.prg Additive Set Procedure To oexport.prg Additive Set Procedure To validare.prg Additive *** Set Procedure To ofacturare_comun.prg Additive Set Procedure To ofacturare_stoc.prg Additive Set Procedure To ofacturare_editare.prg Additive SET PROCEDURE TO pmenu.prg additive SET PROCEDURE TO ointroduceri.prg additive SET PROCEDURE TO ovariabile_globale.prg additive SET PROCEDURE TO ooperatii_comune.prg additive Set Procedure To oproceduri_util.prg Additive *!* SET PROCEDURE TO oproceduri_listari.prg additive *!* modificare v 2.0.70 SET PROCEDURE TO filebringer.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 wwhttp.prg ADDITIVE SET PROCEDURE TO xmlaccess.prg additive SET PROCEDURE TO xmlparser.prg additive *!* modificare v 2.0.70 ^ *!* modificare v 2.0.71 SET PROCEDURE TO xdate.prg Additive *!* modificare v 2.0.71 ^ SET PROCEDURE TO suma_in_vorbe.prg additive Set Procedure To controllerecr Additive SET PROCEDURE TO regex.prg ADDITIVE ************************************************************************************************ *** COMENZI SET PROCEDURE TO orap_comenzi.prg ADDITIVE SET PROCEDURE TO onom_comenzi.prg ADDITIVE SET PROCEDURE TO update_comenzi.prg ADDITIVE SET PROCEDURE TO xmlefactura.prg ADDITIVE PRIVATE pocomenzi,pocomenzielemente,polucrari,pocomenzi2,polucrarielemente STORE '' TO pocomenzi,pocomenzielemente,polucrari,pocomenzi2,polucrarielemente ************************************************************************************************ If Pcount() = 1 And Type('tparam') = 'C' glParametri = .T. Private laParametri Declare laParametri[1] lcParam = Alltrim(tparam) lnNr = lista2array(lcParam,@laParametri,";") If lnNr < 5 aMessagebox('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 Public gcTempPath, gcCaleServerDate, gcUserNameApp, gcPasswordApp Store '' To gcUserNameApp, gcPasswordApp, gnNivelUtilizator, gnGrupUtilizator, gcAcces Public gcAntet,gcCopyRight Store '' To gcAntet gcCopyRight = '© ROA Romfast SRL' *!* modificare v 2.0.93 : verific daca suporta diacritice PUBLIC glFontCharSet glFontCharSet = AFONT(laFontCharSet,"Arial Narrow",238) *!* modificare v 2.0.93 ^ *!* gcAppPath=Addbs(Justpath(Sys(16,0))) && d:\roa\roafacturare\ *!* modificare v 2.0.71 *!* Public gcAppPath,gcAppName,gcUtilizatoriPath *!* gcAppPath = ADDBS(ShortPath(GetAppStartPath())) && wwutils.prg *!* gcAppName=Allt(Uppe(Juststem(Sys(16,0)))) && "roafacturare" *!* gcUtilizatoriPath = gcAppPath + "UTILIZATORI\" *!* modificare v 2.0.71 ^ Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive Store "" To gcTempPath, gcCaleServerDate *** DIRGEN *!* modificare v 2.0.71 : am inlocuit dirgen cu gcDirMare liat = Rat("\",gcAppPath,2) gcDirMare = Addbs(Left(gcAppPath,liat-1)) dirgen = gcDirMare gcBasePath = gcDirMare *!* modificare v 2.0.93 PRIVATE gcReportPreviewer, gcReportPreviewerPath gcReportPreviewer = "FoxyPreview" && oexport.prg gcReportPreviewerPath = gcDirMare + "COMUNROA\" *!* modificare v 2.0.93 ^ gcSecurityPath = gcDirMare + 'Security\' gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT' Cd &gcDirMare Private gcGeneralIniFile, gcSettingsFile gcGeneralIniFile = m.gcDirMare + "settings.ini" gcSettingsFile = m.gcGeneralIniFile If !File(gcGeneralIniFile) TEXT TO lcSettings NOSHOW [errors] host=http://83.103.197.79: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 Private poLog,goLog && obiect pt logarea mesajelor sistemului poLog = Newobject("Log_Mesaje","Log_Mesaje.prg") goLog = poLog *!* modificare v 2.2.15 Private gcLocalePath, goLocale, gcLocale gcLocalePath = gcAppPath + "Locale\" lcLanguage = getini(gcGeneralIniFile,"locale","lang") llLocale= getini(gcGeneralIniFile,"locale","llocale") If Empty(m.lcLanguage) gcLocale = 'Romana' Else gcLocale = m.lcLanguage Endif 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 goLocale.locale = gcLocale *!* If verificari() *!* _Screen.Visible=.T. *!* aMessagebox("Se fac verificari programului!"+CRLF+"Va rugam reveniti!",64,"ROA FACTURARE") *!* glQuit= .T. *!* Quit *!* Endif *!* If !Debug_Start() *!* lcParam=tparam *!* If Empty(tparam) Or (Type('tParam')='C' And !verific_start(tparam,gcDirMare,gcAppName)) *!* _Screen.Visible=.T. *!* aMessagebox("Programul trebuie pornit doar din START!",64,"ROA FACTURARE") *!* Quit *!* Endif *!* Endif *!* modificare v 2.2.15 ^ ***************************** VARIABILE ORACLE Private gnHandle,gnidutil,GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GNDIFZILE, gcUserNameApp, gcPasswordApp Private gnButon && variabila pentru renunt si terminat Store 2 To gnButon Store '' To GCCODFISCAL,GCADRESA,GCNUMEFIRMA,GCMONEDA, gcUserNameApp, gcPasswordApp, 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 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 Store .F. To glUltimaLuna,glPrimaLuna, glLunaBuna,glLuna_neplatita,glLunaInchisa 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 && obiect global wrap pt sqlexec cu text eroare si succes Private goExecutor, goConn goExecutor = Createobject("oExecutor") goConn = Createobject("oConn") *!* modificare v 2.0.26 Private goExport goExport = CREATEOBJECT("oExportConfig") *!* modificare v 2.0.26 ^ Private goMyXMLHTTP lcHostErrors = getini(gcGeneralIniFile,'errors','host') goMyXMLHTTP = Createobject("MyXMLHTTP", lcHostErrors) && obiect global pt luna aleasa din calendar Private goCalendar Store Null To goCalendar PRIVATE goControllerEcr goControllerEcr = CreateObject('oControllerEcr') gcHost = lchost gcUserName = lcUserName gcPassword = lcPassword gcUserNameApp = lcUserNameApp gcPasswordApp = lcPasswordApp gnidutil = lnIdUtil gnIdProgram = lnIdProgram PRIVATE gnId_sectie,gcNumeSectie STORE 0 TO gnId_sectie,gcNumeSectie && sectia cu care se lucreaza in program PRIVATE gnTipUzualComanda, gnOre_inchidere, gnOre_livrare, gnOre_executie, gnCopiereCantitate, gnIdPoliticaPretC, ; gnIdPoliticaPret, gnId_lista_preturi_PV, gnIdGrupaArtSectie, gnSuprascriePretComanda , gnComenziInitial, gnRF_ORDONARECOMENZI STORE 0 TO gnTipUzualComanda, gnOre_inchidere, gnOre_livrare, gnOre_executie, gnCopiereCantitate, gnIdPoliticaPretC, ; gnIdPoliticaPret, gnId_lista_preturi_PV, gnIdGrupaArtSectie, gnSuprascriePretComanda, gnComenziInitial, gnRF_ORDONARECOMENZI PRIVATE goComanda goComanda = null 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 *!* Public NUMEPROGRAM,FUNDALPROGRAM *!* NUMEPROGRAM='ROA facturare ' *!* MENIUPROGRAM="MENIU\roafacturare.mpr" *!* *!* FUNDALPROGRAM=gcAppPath+"FERESTRE\FUNDAL.scx" *-- Configure application object.***************************** _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 Public goApp goApp=Createobject("wzApplication") Local laVersion Dimension laVersion(12) If Agetfileversion(laVersion, Sys(16,0)) > 0 NUMEPROGRAM = laVersion(10) Endif Release laVersion goApp.SetCaption(gcNumeProgram) goApp.cStartupMenu = m.gcAppPath + 'meniu\roafacturare' goApp.cStartupForm = m.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 (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' lcErrorMsg = Sys(0) + ":" + Iif(Type('GCS')='C'," " + gcS,"") + Chr(13) +Chr(10) + lcErrorMsg lcUserName = gcUserNameApp lcProgram = Juststem(Sys(16,0)) goMyXMLHTTP.postError(lcErrorMsg, lcUserName, lcProgram) Endif If aMessagebox(lcErrorMsg,17,_Screen.Caption)#1 On Error ON SHUTDOWN Return .F. Endif Endfunc ************************************************************************************************ Function Shutdown 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 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(,,gcDirMare) 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 ************************************************************************************************