Files
tasks/programe/main.prg
2026-04-21 15:46:20 +03:00

546 lines
16 KiB
Plaintext

Lparameters tcSilent, tcCommand
* tcSilent (optional): s (silentios) pentru rularea unei comenzi fara afisarea formularului
* tcCommand (optional): xml_roa_auto pentru generarea automata a xml-urilor ROA cu programe
*!* 25.01.2011
*!* marius.mutu
*!* settings.ini - hostserii, usernameserii, passwordserii
Local lcHost, lcHostSerii, lcPassword, lcPasswordSerii, lcText, lcUserName, lcUserNameSerii
Local lnSucces
Store "" To lcHost, lcHostSerii, lcPassword, lcPasswordSerii, lcText, lcUserName, lcUserNameSerii
lnSucces = 0
LOCAL llSilent, lcCommand
llSilent = IIF(PCOUNT() > 0, LOWER(tcSilent) = 's', .F.)
lcCommand = IIF(PCOUNT() > 1, LOWER(m.tcCommand), '') && xml_roa_auto
*:Global gcProgrameChangeLogsFile
*!* IF TooManyInstances(1) &&Too many instance already running?
*!* QUIT
*!* ENDIF
Set Talk Off
Set Deleted On
Set Century On
Set Date Dmy SHORT
Set Safety Off
Set Console Off
Set Seconds Off
Set Exclusive Off
Set Status Off
Set Status Bar Off
Set Hours To 24
Set Exact On
Set Ansi On
_Screen.Caption = 'TASKS'
_Screen.WindowState= 2
Set NullDisplay To ""
*!* =================================================================
Public gnIdProgram, gnIdUtilizator, ;
gnIdClient, gbSpecial, gdData, gcAppName, gcAppPath, gcDataPath, gcTempPath, gnhandle, gcIcon
Local lcPath, liat
gnhandle = -1
gnIdUtilizator = 0
gnIdProgram = 0
gnIdClient = 0
gbSpecial = .F.
gdData = Date()
gcAppPath = Addbs(Justpath(Sys(16,0)))
gcAppPath = Strtran(Upper(gcAppPath),"PROGRAME\","")
gcAppName = Juststem(Sys(16,0))
Set Default To (gcAppPath)
gcDataPath = Addbs(gcAppPath) + [clase\test.vcx]
Set Classlib To (gcDataPath)
gcTempPath = Addbs(Sys(2023))
On Shutdown Shutdown()
On Error ErrorHandler(Error(),Program(),Lineno())
Push Menu _Msysmenu
*!* PROGRAME_CHANGELOGS
gcProgrameChangeLogsFile = gcAppPath + 'programe_changelogs.xml'
If !File(gcProgrameChangeLogsFile)
Create Cursor programe_changelogs (id_program i, Program v(100), changelog v(200))
Else
Xmltocursor(gcProgrameChangeLogsFile,"programe_changelogs",512)
Endif
*!* PROGRAME_CHANGELOGS ^
Set Default To (gcAppPath) && generare script
lcPath = gcAppPath + ";" + ;
gcAppPath + "ferestre;" + ;
gcAppPath + "ferestre;" + ;
gcAppPath + "clase;" + ;
gcAppPath + "programe;" + ;
gcAppPath + "meniuri;" + ;
gcAppPath + "rapoarte;" + ;
gcAppPath + "grafice;" + ;
gcAppPath + "clase\GridExtras;"
Set Path To (lcPath) Additive
Set Procedure To proceduri.prg Additive && tasks, soft clienti
Set Procedure To proceduri_sql.prg Additive
Set Procedure To utile.prg Additive
Set Procedure To rapoarte.prg Additive
Set Procedure To htmlmerge.prg Additive
Set Classlib To appwiz Additive && generare script
Set Classlib To comun Additive
Set Classlib To Start Additive
Set Classlib To execute_script Additive
Set Classlib To systray Additive
Set Classlib To generare_script Additive
Set Classlib To gridextras Additive
Set Procedure To oproceduri_comune.prg Additive
Set Procedure To ini.prg Additive
Set Procedure To "rbInputBox.prg" Additive
Set Procedure To regex.prg Additive
Set Library To gcAppPath + 'biblioteci\vfpcompression.fll' && v 1.0.39
*!* 30.08.2010
Private gcReportPreviewer, gcReportPreviewerPath
gcReportPreviewer = "FoxyPreview" && rapoarte.prg
gcReportPreviewerPath = gcAppPath + 'utile\'
*!* 30.08.2010 ^
Private lcIniFile
Local lcidutilizator
gcIcon = [news1.ico]
If File(Addbs(gcAppPath) + [grafice\] + gcIcon)
Private goSystray
goSystray = Createobject("osystray")
*!* Bindevent(_Screen,[Resize],goSystray,[minimizeaza],1)
Bindevent(_Screen,[rightclick],goSystray,[clickdreapta],1)
Else
Messagebox([Nu s-a gasit icoana cu adresa:] + Chr(13) + Chr(10) +;
ADDBS(gcAppPath) + [grafice\] + gcIcon,0 + 48)
Endif
lcIniFile = gcAppPath + 'settings.ini'
*goExecutor = Createobject("oExecutor")
*Do (gcAppPath + "meniu.mpr")
If !File(lcIniFile)
Set Textmerge On To Memvar lcTextIni
\[connection]
\host=ROA_ROMFAST
\username=SOFT
\password=SOFT
\host_serii=ROA_CENTRAL
\username_serii=SOFT_SERII
\password_serii=123
\host_database=ROA_CENTRAL
\username_database=CONTAFIN_ORACLE
\password_database=ROMFASTSOFT
\idutilizator=
Set Textmerge To
Strtofile(lcTextIni, lcIniFile)
Endif
lcHost = ReadINI(lcIniFile, "connection", "host")
lcUserName = ReadINI(lcIniFile, "connection", "username")
lcPassword = ReadINI(lcIniFile, "connection", "password")
lcidutilizator = ReadINI(lcIniFile, "connection", "idutilizator")
*!* 25.01.2011
lcHostSerii = ReadINI(lcIniFile, "connection", "host_serii")
lcUserNameSerii = ReadINI(lcIniFile, "connection", "username_serii")
lcPasswordSerii = ReadINI(lcIniFile, "connection", "password_serii")
*!* 25.01.2011 ^
*!* 27.05.2013
lcHostDatabase = ReadINI(lcIniFile, "connection", "host_database")
lcUserNameDatabase = ReadINI(lcIniFile, "connection", "username_database")
lcPasswordDatabase = ReadINI(lcIniFile, "connection", "password_database")
*!* 27.05.2013 ^
If Empty(lcHost) Or Empty(lcUserName) Or Empty(lcPassword) Or ;
EMPTY(lcHostSerii) Or Empty(lcUserNameSerii) Or Empty(lcPasswordSerii) Or ;
EMPTY(lcHostDatabase) Or Empty(lcHostDatabase) Or Empty(lcHostDatabase)
Messagebox('Completati detaliile de login pentru SOFT@ROA_ROMFAST, SOFT_SERII@ROA_CENTRAL, CONTAFIN_ORACLE@ROA_CENTRAL' + lcIniFile, 0+48, _Screen.Caption)
Else
Private poLog,goLog && obiect pt logarea mesajelor sistemului
goLog = Newobject("Log_Mesaje","Log_Mesaje.prg")
Private goExecutor, goConn
goExecutor = Createobject("oExecutor")
goConn = Createobject("oConn")
Local lcMenu
lcMenu = "meniu.mpr"
Release goApp
Public goApp
goApp = Createobject("cApplication")
goApp.AddProperty("cIniFile", lcIniFile)
goApp.AddProperty("cHost", lcHost)
goApp.AddProperty("cUserName", lcUserName)
goApp.AddProperty("cPassword", lcPassword)
goApp.AddProperty("cIdUtilizator", Alltrim(lcidutilizator))
goApp.AddProperty("IdUtilizator", Val(Alltrim(lcidutilizator)))
goApp.AddProperty("cUtilizator", '')
goApp.AddProperty("cHostSerii", lcHostSerii)
goApp.AddProperty("cUserNameSerii", lcUserNameSerii)
goApp.AddProperty("cPasswordSerii", lcPasswordSerii)
goApp.AddProperty("cHostDatabase", lcHostDatabase)
goApp.AddProperty("cUserNameDatabase", lcUserNameDatabase)
goApp.AddProperty("cPasswordDatabase", lcPasswordDatabase)
goApp.AddProperty("cMenu",lcMenu)
goApp.AddProperty("nhandle", 0)
*!* completez inifile cu prefixele scripturilor pe scheme
lcText = Filetostr(goApp.cIniFile)
If Atc("[script]",lcText) = 0
lcText = ''
TEXT TO m.lcText NOSHOW
[script]
CONTAFIN_ORACLE=CO_
SCHEMAROA=FF_
SOFT_SERII=RF_
SYS=SYS_
CONTABILITATE=JCS_
ENDTEXT
Strtofile(Chr(13) + Chr(10) + m.lcText,goApp.cIniFile,1)
Endif
Create Cursor dual (Info c(10))
Insert Into dual (Info) Values ("dummy")
Set Step On
*!* completez inifile cu prefixele scripturilor pe scheme ^
*!* conectare
conectare(lcHost, lcUserName, lcPassword, lcidutilizator)
*!* conectare ^
If gnhandle > 0
Local llReturn
llReturn = .F.
lnSucces = goExecutor.oexecute([select users.login, users.id from users ] + ;
[inner join roles_users on user_id=users.id inner join roles on role_id=roles.id ] + ;
[where roles.id=2 order by 1],"crsUtilizatori")
goLog.Log('silent: ' + TRANSFORM(m.llSilent) + ' command: ' + m.lcCommand, PROGRAM())
IF m.llSilent AND !EMPTY(m.lcCommand)
IF m.lcCommand = "xml_roa_auto"
goLog.Log('genereaza_xml_roa_tot', PROGRAM())
DO genereaza_xml_roa_tot IN proceduri.prg
ENDIF
ELSE
Do Form ("frm_connect.scx") To llReturn
If llReturn
WriteINI(goApp.cIniFile, "connection", "idutilizator", Alltrim(Transform(goApp.idutilizator)))
goApp.cUtilizator = Alltrim(crsUtilizatori.login)
Private goConfig
goConfig = Createobject("Config")
Do (lcMenu)
*goApp.cStartupMenu = gcAppPath + "meniu.mpx"
*!* 29.08.2011
*** TEST MENUHIT
If File(gcAppPath + "FOXCODE.DBF")
* _FOXCODE = gcAppPath + "foxcode.dbf"
Endif
*!* 29.08.2011 ^
editLucrare()
Read Events
On Error
On Shutdown
Do deconectare
cleanup()
Endif && llReturn
ENDIF && m.llSilent
Endif && gnHandle
Endif
cleanup()
*!* =================================================================
*!* =================================================================
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:" + Space(5) + Alltrim(Str(nLine))
If Not Empty(lcCodeLineMsg)
lcErrorMsg = lcErrorMsg + Chr(13) + Chr(13) + lcCodeLineMsg
Endif
Endif
If Messagebox(lcErrorMsg, 17, _Screen.Caption) # 1
On Error
On Shutdown
Quit
Endif
Endfunc
**=============================================
Function Shutdown
*!* If Type("goAppTask")=="O" And Not Isnull(goApp)
*!* Return goAppTask.OnShutDown()
*!* Endif
Do salveazaSetari
If Type('goApp') = 'O'
Return goApp.onShutDown()
Endif
Do deconectare
*!* cleanup()
*!* If _vfp.StartMode !=0
*!* Quit
*!* Endif
Endfunc
**=============================================
Function cleanup
*!* If Cntbar("_msysmenu") = 7
*!* Return
*!* ENDIF
On Error
On Shutdown
Set Classlib To
Set Path To
Clear All
*Close All
_Screen.MaxButton=.T.
_Screen.BorderStyle= 3
_Screen.WindowState= 2
Pop Menu _Msysmenu
Clear Events
Return
Endfunc
***************************** inceput conectare
Procedure conectare
Lparameters tcHost, tcUserName, tcPassword, tcIdUtilizator
Local lnHandle, lcHost, lcUserName, lcPassword, lcCaption, lcidutilizator
If Pcount() = 3
goApp.cHost = tcHost
goApp.cUserName = tcUserName
goApp.cPassword = tcPassword
* goapp.cidutilizator = goapptask.idutilizator
goApp.cidutilizator = tcIdUtilizator
Endif
lcHost = Upper(tcHost)
lcUserName = Upper(tcUserName)
lcPassword = tcPassword
lcidutilizator = tcIdUtilizator
If Type('goApp') = 'O' And goApp.nhandle > 0
Do deconectare
Endif
lnHandle = goConn.Connect(lcHost, lcUserName, lcPassword, lcidutilizator)
goApp.nhandle = lnHandle
*!* goExecutor.nhandle = lnHandle
If lnHandle > 0
lcCaption = "Conectat " + lcHost + " " + lcUserName
Else
lcCaption = "Neconectat"
Endif
If Type('goApp') = 'O'
goApp.SetCaption(lcCaption)
Endif
Return lnHandle
Endproc && conectare
****************************************
Procedure deconectare
Local lcCaption, lnSucces
lnSucces = goConn.Disconnect()
goApp.nhandle = -1
goExecutor.nhandle = -1
lcCaption = "Neconectat"
goApp.SetCaption(lcCaption)
Endproc && deconectare
************************* inceput salveazaSetari ********************
Procedure salveazaSetari
Try
If Used('settings')
Replace settings.idutilizator With goApp.idutilizator In settings
Cursortoxml("SETTINGS",gcSettingsFile,1,512,0,"1")
Endif
If Used('programe_changelogs')
Cursortoxml("programe_changelogs", gcProgrameChangeLogsFile,1,512,0,"1")
Endif
Catch
Endtry
Endproc
**======================================
** actualizeaza programe_changelogs cu calea catre fisierul ;
changelog pentru un id_program
Procedure UpdateProgrameChangeLogs
Lparameters tnIdProgram, tcProgram, tcChangeLog
Local lcSelect
lcSelect = Select()
If Used('programe_changelogs') And !Empty(tcChangeLog)
Select programe_changelogs
Locate For id_program = tnIdProgram
If Found()
Replace changelog With Alltrim(tcChangeLog)
Else
Insert Into programe_changelogs(id_program, Program, changelog) Values (tnIdProgram, Alltrim(tcProgram), Alltrim(tcChangeLog))
Endif
Endif
Select (lcSelect)
Endproc && UpdateProgrameChangeLogs ^
**======================================
** intoarce calea catre fisierul changelog in functie de id_program
Function GetChangeLogByIdProgram
Lparameters tnIdProgram
Local lcSelect, lcChangelog
lcSelect = Select()
lcChangelog = ""
If Used('programe_changelogs')
Select programe_changelogs
Locate For id_program = tnIdProgram
If Found()
lcChangelog = Alltrim(changelog)
Endif
Endif
Select (lcSelect)
Return lcChangelog
Endfunc
**======================================
********************** inceput TooManyInstances *************************
Function TooManyInstances(lnInstancesAllowed)
***************************
#Define GW_CHILD 5 && 0x00000005
#Define GW_HWNDNEXT 2 && 0x00000002
#Define SW_MAXIMIZE 3 && 0x00000003
#Define SW_NORMAL 1 && 0x00000001
#Define WAIT_OBJECT_0 0 && 0x00000000
#Define RF_MESAJ 0xA123
Local lcUniqueProperty, lcUniqueSemaphore, lnhSemaphore, lnHwnd, llReturn
If Pcount() = 0
lnInstancesAllowed = 1 && default
Else
lnInstancesAllowed = Max(lnInstancesAllowed,1) &&At least one
Endif
Do DeclareAPIs
lcUniqueSemaphore = Strtran(Justpath(Sys(16,0)),"\","")
*!* lcUniqueSemaphore = "968360BF-C7AD-4B62-A045-0A06D597EF18"
lcUniqueProperty = "E2429959-D873-4733-8182-7A3F14780A27"
&&&
*!* oTypeLib = CreateObject("scriptlet.typelib")
*!* lcUniqueSemaphore = substr(oTypeLib.GUID, 2, 36)
*!* oTypeLib1 = CreateObject("scriptlet.typelib")
*!* lcUniqueProperty = substr(oTypeLib1.GUID, 2, 36)
&&&
lnhSemaphore = CreateSemaphore(0,lnInstancesAllowed,lnInstancesAllowed,lcUniqueSemaphore)
If lnhSemaphore != 0 And WaitForSingleObject(lnhSemaphore, 0) != WAIT_OBJECT_0
Do DeclareMoreAPIs
llReturn = .T.
lnHwnd = GetWindow(GetDesktopWindow(), GW_CHILD)
Do While lnHwnd != 0 && loop through all windows
If GetProp(lnHwnd, lcUniqueProperty) = 1 && does window have our unique property?
BringWindowToTop(lnHwnd)
*!* modificare v 2.0.23
If IsIconic(lnHwnd) <> 0
SendMessage(lnHwnd, RF_MESAJ, 0, 0)
Else
*!* modificare v 2.0.23 ^
ShowWindow(lnHwnd,SW_NORMAL)
*!* modificare v 2.0.23
Endif
*!* modificare v 2.0.23 ^
llReturn = .T.
Exit
Endif
lnHwnd = GetWindow(lnHwnd, GW_HWNDNEXT)
Enddo
CloseHandle(lnHwnd)
CloseHandle(lnhSemaphore)
Clear Dlls "BringWindowToTop", "GetDesktopWindow", ;
"GetProp", "GetWindow", "ShowWindow", ;
"CloseHandle", "SendMessage", "IsIconic"
Else
=SetProp(_vfp.HWnd, lcUniqueProperty, 1)
_Screen.AddProperty("SemaphoreHandle",lnhSemaphore)
llReturn = .F.
Endif
Clear Dlls "CreateSemaphore", "GetLastError", ;
"SetProp"
Return (llReturn)
Endfunc &&&&&&&&&&&&&&&&&&&&&& TooManyInstances ^^ &&&&&&&&&&&&&&&&&&&&&&&&&&
*************************************************************************************************************************
***************************
Procedure DeclareAPIs()
***************************
Declare Integer CloseHandle In Kernel32 Integer hObject
Declare Integer CreateSemaphore In Kernel32 Integer lpSemaphoreAttributes, Integer lInitialCount, Integer lMaximumCount, String lpName
Declare Integer SetProp In User32 Integer HWnd, String lpString, Integer hData
Declare Integer WaitForSingleObject In kernel32 Integer hHandle, Integer dwMilliseconds
Endproc
*************************************************************************************************************************
***************************
Procedure DeclareMoreAPIs()
***************************
Declare Integer BringWindowToTop In Win32API Integer HWnd
Declare Integer GetDesktopWindow In User32
Declare Integer GetProp In User32 Integer HWnd, String lpString
Declare Integer GetWindow In User32 Integer HWnd, Integer uCmd
Declare Integer ShowWindow In Win32API Integer HWnd, Integer nCmdShow
*!* modificare v 2.0.23
Declare Integer SendMessage In user32 Integer HWnd,Integer Msg,Integer wParam, Integer Lparam
Declare Integer IsIconic In user32 Integer HWnd
*!* modificare v 2.0.23 ^
Endproc