Initial commit - tasks v1.1.14
Co-Authored-By: Claude Sonnet 4.6 <noreply@anthropic.com>
This commit is contained in:
293
programe/utile.prg
Normal file
293
programe/utile.prg
Normal file
@@ -0,0 +1,293 @@
|
||||
*-------------------------------------------
|
||||
* Function...: Xmenu
|
||||
* Author.....: MARTIN
|
||||
* Date.......: 04/06/1997
|
||||
* Notes......: Based on an idea from Steve Zimmelman for FoxPro 2.x
|
||||
* Parameters.: tcItems = Semicolon-separated String with the various options
|
||||
* ...........: tnBar = Initially selected item (default=1)
|
||||
* Returns....: Selected item number
|
||||
* See Also...: PROMPT() [FoxPro Native]
|
||||
* lnOption = xmenu('\<Listare1;L\<istare2;Li\<stare3')
|
||||
Procedure XMENU
|
||||
Lparameters TCITEMS, TNBAR
|
||||
|
||||
Local NITEMCOUNT, AITEMS, X, NROW, NCOL, CTITLE, NLASTPOS, CCOLOR, AITEMS
|
||||
|
||||
Private CPOPMENU, NSELECT && They flow into the GetChoice internal procedure
|
||||
|
||||
If Pcount() < 2
|
||||
TNBAR = 1
|
||||
Endif
|
||||
|
||||
Activate Screen
|
||||
|
||||
* Parse every item
|
||||
m.NITEMCOUNT = Occurs( ';', TCITEMS ) + 1
|
||||
Dimen AITEMS[ m.nItemCount ]
|
||||
m.NLASTPOS = 1
|
||||
|
||||
For m.X = 1 To m.NITEMCOUNT
|
||||
|
||||
If m.X < m.NITEMCOUNT
|
||||
|
||||
AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
|
||||
( At( ';', m.TCITEMS, m.X ) - 1 ) - m.NLASTPOS + 1 )
|
||||
Else
|
||||
AITEMS[ m.x ] = Subs( m.TCITEMS, m.NLASTPOS, ;
|
||||
( Len( m.TCITEMS ) - m.NLASTPOS ) + 1 )
|
||||
Endif
|
||||
|
||||
If AITEMS[ m.x ] # "\-"
|
||||
|
||||
AITEMS[ m.x ] = Allt( AITEMS[ m.x ] )
|
||||
Endif
|
||||
|
||||
m.NLASTPOS=At( ';', m.TCITEMS, m.X ) + 1
|
||||
Next
|
||||
|
||||
* Calculates the mouse pointer position
|
||||
m.NROW = Iif( Mrow() + m.NITEMCOUNT < Srow(), Mrow() - 1, Srow() - m.NITEMCOUNT )
|
||||
m.NCOL = Iif( Mcol() + 10 < Scol(), Mcol() - 3, Mcol() - 13 )
|
||||
|
||||
* Gets an unique name for the pop-up
|
||||
m.CPOPMENU = 'M' + Sys(3) + "_"
|
||||
|
||||
Define Popup ( m.CPOPMENU ) SHORTCUT Relative From NROW, NCOL
|
||||
|
||||
For m.X = 1 To m.NITEMCOUNT
|
||||
|
||||
Define Bar m.X Of ( m.CPOPMENU ) Prompt AITEMS[ m.x ]
|
||||
Next
|
||||
|
||||
m.CANS = ""
|
||||
m.NSELECT = 0
|
||||
Clear Type
|
||||
|
||||
On Selection Popup ( m.CPOPMENU ) Do GETCHOICE
|
||||
|
||||
Activate Popup ( m.CPOPMENU ) Bar TNBAR
|
||||
|
||||
Pop Key
|
||||
Release Popup ( m.CPOPMENU )
|
||||
|
||||
Return Iif( Lastkey()=27, 0, m.NSELECT )
|
||||
|
||||
Endproc && XMENU
|
||||
|
||||
*--------------------
|
||||
Procedure GETCHOICE
|
||||
|
||||
m.NSELECT = Bar()
|
||||
|
||||
Deactivate Popup ( m.CPOPMENU )
|
||||
|
||||
Endproc
|
||||
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
Define Class Config As Relation
|
||||
cSqlPlusFile = ""
|
||||
cLogDirectory = ""
|
||||
cActualizareDirectory = ""
|
||||
*** ==========================================================
|
||||
Procedure SetLogDirectory
|
||||
Lparameters tcLogDirectory
|
||||
Local lcLogDirectory
|
||||
If Empty(tcLogDirectory)
|
||||
lcLogDirectory = Getdir(Addbs(Justpath(Sys(16,0))), "Alegeti directorul in care se vor genera logurile","Director loguri")
|
||||
Else
|
||||
lcLogDirectory = tcLogDirectory
|
||||
Endif
|
||||
WriteINI(goApp.cIniFile, "folder", "log_folder", lcLogDirectory)
|
||||
Return lcLogDirectory
|
||||
Endproc && SetLogDirectory
|
||||
|
||||
*** ==========================================================
|
||||
Procedure SetActualizareDirectory
|
||||
Lparameters tcActualizareDirectory
|
||||
Local lcActualizareDirectory
|
||||
If Empty(tcActualizareDirectory)
|
||||
lcActualizareDirectory = Getdir(Addbs(Justpath(Sys(16,0))), ;
|
||||
"Alegeti directorul in care se vor genera actualizarile","Director actualizari")
|
||||
Else
|
||||
lcActualizareDirectory = tcActualizareDirectory
|
||||
Endif
|
||||
If !"actualizariaplicatii"$lcActualizareDirectory
|
||||
lcActualizareDirectory = ADDBS(lcActualizareDirectory) + 'actualizariaplicatii\'
|
||||
Endif
|
||||
WriteINI(goApp.cIniFile, "folder", "actualizare", lcActualizareDirectory)
|
||||
Return lcActualizareDirectory
|
||||
Endproc && SetActualizareDirectory
|
||||
*** ==========================================================
|
||||
Procedure SetSqlPlus
|
||||
Local lcSqlPlus
|
||||
lcSqlPlus = Getfile("exe","SQLPLUS.EXE")
|
||||
WriteINI(goApp.cIniFile, "folder", "sqlplus_exe", lcSqlPlus)
|
||||
Return lcSqlPlus
|
||||
Endproc && SetSqlPlus
|
||||
*** ==========================================================
|
||||
Function GetSqlPlus
|
||||
Local lcSqlPlus
|
||||
lcSqlPlus = ReadINI(goApp.cIniFile, "folder", "sqlplus_exe")
|
||||
If Empty(lcSqlPlus) Or !File(lcSqlPlus)
|
||||
lcSqlPlus = This.SetSqlPlus()
|
||||
Endif
|
||||
|
||||
Return lcSqlPlus
|
||||
Endfunc && GetSqlPlus
|
||||
*** ==========================================================
|
||||
Function GetLogDirectory
|
||||
Local lcLogDirectory
|
||||
lcLogDirectory = ReadINI(goApp.cIniFile, "folder", "log_folder")
|
||||
If Empty(lcLogDirectory) Or !Directory(lcLogDirectory)
|
||||
lcLogDirectory = This.SetLogDirectory()
|
||||
Endif
|
||||
lcLogDirectory = Addbs(lcLogDirectory)
|
||||
Return lcLogDirectory
|
||||
Endfunc && GetLogDirectory
|
||||
*** ==========================================================
|
||||
Function GetActualizareDirectory
|
||||
Local lcActualizareDirectory
|
||||
lcActualizareDirectory = ReadINI(goApp.cIniFile, "folder", "roa_output")
|
||||
If !"actualizariaplicatii"$lcActualizareDirectory
|
||||
lcActualizareDirectory = ADDBS(lcActualizareDirectory) + 'actualizariaplicatii\'
|
||||
ENDIF
|
||||
|
||||
If Empty(lcActualizareDirectory) Or !Directory(lcActualizareDirectory)
|
||||
lcActualizareDirectory = This.SetActualizareDirectory()
|
||||
Endif
|
||||
lcActualizareDirectory = Addbs(lcActualizareDirectory)
|
||||
Return lcActualizareDirectory
|
||||
Endfunc && GetActualizareDirectory
|
||||
|
||||
*** ==========================================================
|
||||
|
||||
Function GetDailyLogDirectory
|
||||
lparameters tcHost, tcUserName
|
||||
Local lcDailyLogDirectory, lcHost, lcUserName
|
||||
lcHost = iif(!empty(m.tcHost), alltrim(m.tcHost), Alltrim(goApp.cUserName))
|
||||
lcUserName = iif(!empty(m.tcUserName), alltrim(m.tcUserName), Alltrim(goApp.cUserName))
|
||||
|
||||
lcDailyLogDirectory = ""
|
||||
lcLogDirectory = This.GetLogDirectory()
|
||||
If !Empty(lcLogDirectory) And Directory(lcLogDirectory)
|
||||
lcDailyLogDirectory = lcLogDirectory + m.lcHost + [\] + ;
|
||||
m.lcUserName + [_] + Ttoc(Datetime(),1) + [\]
|
||||
Endif
|
||||
|
||||
Return lcDailyLogDirectory
|
||||
Endfunc && GetDailyLogDirectory
|
||||
*** ==========================================================
|
||||
Function getXMLDirectory
|
||||
Lparameters tcCustomer_name
|
||||
LOCAL lcXMLDirectory
|
||||
lcXMLDirectory = This.GetActualizareDirectory()
|
||||
If Pcount() > 0
|
||||
lcXMLDirectory = lcXMLDirectory + Alltrim(tcCustomer_name) + '\'
|
||||
Endif
|
||||
|
||||
Return lcXMLDirectory
|
||||
|
||||
Endfunc
|
||||
Enddefine && Config
|
||||
|
||||
|
||||
********************** inceput versiune *************************
|
||||
Procedure versiune
|
||||
Lparameters lcvers
|
||||
|
||||
External Array laVers
|
||||
Local lcVersiune, lnNr
|
||||
lcVersiune = []
|
||||
|
||||
lnNr = Alines(laVers,Nvl(lcvers,[]),.T.,".")
|
||||
If lnNr > 1
|
||||
For i =1 To lnNr
|
||||
laVers(i) = Replicate("0",3 - Len(Alltrim(Nvl(laVers(i),[])))) + laVers(i)
|
||||
lcVersiune = lcVersiune + laVers(i) + "."
|
||||
Endfor
|
||||
lcVersiune = Left(lcVersiune,Len(lcVersiune)-1)
|
||||
Else
|
||||
lcVersiune = lcvers
|
||||
Endif
|
||||
Return lcVersiune
|
||||
|
||||
Endproc
|
||||
********************* versiune ^ ********************************
|
||||
|
||||
|
||||
**************************** inceput cmdPagToate **************************
|
||||
Define Class cmdPagToate As CommandButton && Create Command button
|
||||
Left = 50 && Command button column
|
||||
Top = 100 && Command button row
|
||||
Height = 25 && Command button height
|
||||
Visible = .T.
|
||||
ToolTipText = "Toate inregistrarile"
|
||||
Caption = "\<Toate"
|
||||
|
||||
Procedure Click
|
||||
Local lcSql, lnSucces
|
||||
|
||||
If This.Parent.npag2 = 25
|
||||
This.Caption = "\<Reset"
|
||||
This.Parent.npag2 = 1000001
|
||||
Else
|
||||
This.Caption = "\<Toate"
|
||||
This.Parent.npag1 = 0
|
||||
This.Parent.npag2 = 25
|
||||
Endif
|
||||
lcSql = [select * from (] + This.Parent.cSelect + ;
|
||||
[) where rownum < ] + Alltrim(Str(This.Parent.npag2))
|
||||
This.Parent.save_grid(This.Parent.grid1)
|
||||
executasql(lcSql,This.Parent.cCursor,.T.)
|
||||
This.Parent.restore_grid(This.Parent.grid1)
|
||||
Endproc
|
||||
|
||||
Enddefine
|
||||
************************** sfarsit cmdPagToate ^ ******************************
|
||||
|
||||
************************** inceput cmdPagUrmatoare ****************************
|
||||
Define Class cmdPagUrmatoare As CommandButton && Create Command button
|
||||
Left = 50 && Command button column
|
||||
Top = 100 && Command button row
|
||||
Height = 25 && Command button height
|
||||
Visible = .T. && implicit, butonul se adauga cu prop visible = .f.
|
||||
ToolTipText = "Urmatoarele inregistrari"
|
||||
Caption = "\<Urmatoarele"
|
||||
|
||||
Procedure Click
|
||||
Local lcSql, lcSqlBackup, lnSucces, lcSel, lcp1, lcp2
|
||||
|
||||
This.Parent.npag1 = This.Parent.npag1 + 25
|
||||
This.Parent.npag2 = This.Parent.npag2 + 25
|
||||
|
||||
lcSel = This.Parent.cSelect
|
||||
lcp1 = Alltrim(Str(This.Parent.npag1))
|
||||
lcp2 = Alltrim(Str(This.Parent.npag2))
|
||||
|
||||
lcSqlBackup = This.Parent.cSelect && daca nu mai sunt inregistrari pt paginare, se vor afisa toate inreg
|
||||
lcSql = [select * from ] + ;
|
||||
[ ( select a.*, rownum r from ] + ;
|
||||
[ ( select * from ] + ;
|
||||
[ ( ] + lcSel + [) t ) a ] + ;
|
||||
[ where rownum <= ] + lcp2 + [) ] + ;
|
||||
[ where r > ] + lcp1
|
||||
|
||||
This.Parent.save_grid(This.Parent.grid1)
|
||||
executasql(lcSql,This.Parent.cCursor,.T.)
|
||||
Select (This.Parent.cCursor)
|
||||
If Reccount() = 0
|
||||
executasql(lcSqlBackup,This.Parent.cCursor,.T.)
|
||||
This.Parent.npag1 = 0
|
||||
This.Parent.npag2 = 25
|
||||
Endif
|
||||
This.Parent.restore_grid(This.Parent.grid1)
|
||||
Endproc
|
||||
Enddefine
|
||||
************************ sfarsit cmdPagUrmatoare ^ ********************************
|
||||
Reference in New Issue
Block a user