1368 lines
34 KiB
Plaintext
1368 lines
34 KiB
Plaintext
Define Class oexecutor As Custom
|
|
nHandle = 0
|
|
cSql = ''
|
|
cCursor = ''
|
|
nSucces = 0
|
|
cEroare = ''
|
|
cTime = ''
|
|
lReconnect = .T. && cred ca trebuie setat pe .F. inainte de o serie de proceduri executate cu tranzactie manuala
|
|
lShowError = .F.
|
|
lQuitOnError = .F.
|
|
|
|
cEroare = [] && de la tasks
|
|
|
|
Declare aEroare[1]
|
|
|
|
|
|
* PROCEDURE INIT( tnHandle, tcSql, tcCursor )
|
|
* Date : 06/10/2004, 12:18:21
|
|
* author : marius.mutu
|
|
* description:
|
|
|
|
****** PARAMETER BLOCK **************
|
|
* Parameters : 3
|
|
* Parameter 1:
|
|
* Parameter 2:
|
|
* Parameter 3:
|
|
*
|
|
******************************************* INCEPUT:INIT *******************************************
|
|
Procedure Init
|
|
Lparameters tnHandle, tcSql, tcCursor
|
|
|
|
|
|
If Empty(tnHandle)
|
|
This.nHandle = gnHandle
|
|
Else
|
|
This.nHandle = tnHandle
|
|
Endif
|
|
|
|
Endproc
|
|
******************************************* SFARSIT: INIT *******************************************
|
|
|
|
|
|
* PROCEDURE oExecute( tcSql, tcCursor,tlProgress, tnHandle )
|
|
* Date : 06/10/2004, 12:16:11
|
|
* author : marius.mutu
|
|
* description:
|
|
|
|
****** PARAMETER BLOCK **************
|
|
* Parameters : 3
|
|
* Parameter 1:
|
|
* Parameter 2:
|
|
* Parameter 3:
|
|
*
|
|
******************************************* INCEPUT:oExecute *******************************************
|
|
Procedure oExecute( tcSql, tcCursor, tlProgress, tcTitluProgress, tnHandle, tlShowError, tlQuitOnError, tlReconnect )
|
|
Local lnHandle, lcSql, lcCursor, llProgress, lnSucces, laEroare, lcEroare, llShowError, llQuitOnError, llReconnect
|
|
|
|
|
|
&& tlQuitOnError : Daca face QUIT la eroare (daca vreau QUIT dau .T.) (default .F.)
|
|
&& tlShowError : Daca arata mesajul de eroare (daca vreau sa il tratez in oexecute dau .T.) (default .F.)
|
|
&& tlReconnect : Daca incearca sa se reconecteze (default .T.)
|
|
If .F.
|
|
Local This As oexecutor
|
|
Endif
|
|
This.Oreset()
|
|
|
|
If Type('goLog')='O'
|
|
goLog.Log(tcSql,Program())
|
|
Endif
|
|
|
|
Local lnTip
|
|
lnTip = 0
|
|
|
|
If Empty(tcSql)
|
|
lcSql = Upper(This.cSql)
|
|
Else
|
|
lcSql = Upper(tcSql)
|
|
Endif
|
|
|
|
If Empty(tcCursor)
|
|
lcCursor = This.cCursor
|
|
Else
|
|
lcCursor = tcCursor
|
|
Endif
|
|
|
|
If Empty(tnHandle)
|
|
lnHandle = This.nHandle
|
|
Else
|
|
lnHandle = tnHandle
|
|
Endif
|
|
|
|
&& DACA AM TRANZACTIE MANUALA NU FAC RECONNECT
|
|
If SQLGetprop(lnHandle,"Transactions") = 2 && TRANZACTIE MANUALA
|
|
This.lReconnect = .F.
|
|
Else
|
|
This.lReconnect = .T.
|
|
Endif
|
|
|
|
Do Case
|
|
Case Pcount() < 6
|
|
llQuitOnError = This.lQuitOnError
|
|
llReconnect = This.lReconnect
|
|
llShowError = This.lShowError
|
|
Case Pcount() < 7
|
|
llQuitOnError = This.lQuitOnError
|
|
llReconnect = This.lReconnect
|
|
Otherwise
|
|
llShowError = tlShowError
|
|
llReconnect = tlReconnect
|
|
llQuitOnError = tlQuitOnError
|
|
Endcase
|
|
|
|
lnSucces = This.nSucces
|
|
|
|
llProgress = tlProgress && IIF(tlProgress or 'SELECT'$lcSql,.T.,.F.)
|
|
lcTitluProgress = Iif(Empty(tcTitluProgress),"",Alltrim(tcTitluProgress))
|
|
|
|
Declare laEroare[1]
|
|
lcEroare = ''
|
|
|
|
|
|
lnTip = Iif('ROLLBACK'$lcSql Or 'COMMIT'$lcSql,1,0) && daca ROLLBACK SAU COMMIT TIP = 1, ALTFEL 0
|
|
|
|
Do Case
|
|
Case lnTip = 0
|
|
|
|
If llProgress
|
|
Local loTherm, lcTask, lnPercent, lnSeconds
|
|
If !Empty(lcTitluProgress)
|
|
lcTask = lcTitluProgress
|
|
Else
|
|
lcTask = "Se executa ... "
|
|
Endif
|
|
loTherm = Newobject("_thermometer","_therm","",lcTask)
|
|
|
|
lnPercent = 15
|
|
|
|
|
|
loTherm.Show()
|
|
Endif
|
|
|
|
lnSucces = -1
|
|
Do While .T.
|
|
Do While .T.
|
|
|
|
If llProgress
|
|
lnPercent = lnPercent + 5
|
|
If lnPercent > 90
|
|
lnPercent = 15
|
|
Endif
|
|
|
|
loTherm.Update(lnPercent, lcTask+" "+Trans(lnPercent))
|
|
Endif
|
|
|
|
|
|
lnSucces = SQLExec(lnHandle,lcSql,lcCursor)
|
|
If lnSucces = 0
|
|
*
|
|
Else
|
|
Exit
|
|
Endif
|
|
Enddo
|
|
|
|
If lnSucces > 0
|
|
If Used(lcCursor)
|
|
lcTempCursor = Sys(2015)
|
|
Use Dbf(lcCursor) In 0 Again Shared Alias (lcTempCursor)
|
|
Use In (lcCursor)
|
|
Use Dbf(lcTempCursor) In 0 Again Alias (lcCursor)
|
|
Use In (lcTempCursor)
|
|
Endif
|
|
Exit
|
|
Endif
|
|
|
|
If lnSucces < 0
|
|
Release laEroare
|
|
Declare laEroare(1)
|
|
lnEroare1 = 0
|
|
lnEroare2 = 0
|
|
lcTextEroare = []
|
|
lnHandle = 0
|
|
llEroare = .F.
|
|
|
|
Aerror(laEroare)
|
|
If Alen(laEroare) > 1
|
|
lnEroare1 = laEroare[1]
|
|
lnEroare2 = laEroare[5]
|
|
lcTextEroare = laEroare[3]
|
|
lnHandle = laEroare[6]
|
|
llEroare = .T.
|
|
Endif
|
|
Do Case
|
|
Case lnEroare1 <>1526 && eroare <> ODBC
|
|
lcTextEroare = Program() + Chr(13) + Alltrim(Str(lnEroare1)) + ' ' + laEroare[2]
|
|
If Type('goLog')='O'
|
|
goLog.Log(lcTextEroare,Program())
|
|
Endif
|
|
If llShowError
|
|
Messagebox(lcTextEroare,0,"Eroare")
|
|
Endif
|
|
If llQuitOnError
|
|
Quit
|
|
Retry
|
|
Else
|
|
Exit
|
|
Endif
|
|
|
|
Case lnEroare1 = 1526 && eroare ODBC
|
|
Do Case
|
|
Case llReconnect And Inlist(lnEroare2,12152,3114,12560) && 12512 = TNS: UNABLE TO SEND BREAK MESSAGE; 3114 = NOT CONNECTED TO ORACLE; 12560 = PROTOCOL ADAPTER ERROR
|
|
If Type('goLog')='O'
|
|
lcLog = laEroare(3) + Chr(13)
|
|
goLog.Log(lcLog,Program())
|
|
Endif
|
|
|
|
Do While .T.
|
|
lnRaspuns = Messagebox('Eroare de conectare.' + Chr(13) + lcTextEroare + Chr(13) + 'Doriti reconectare?',4+32,'Eroare') && retry = 4; cancel = 2
|
|
If lnRaspuns = 6
|
|
|
|
lnHandle = goConn.Connect(goConn.cHost, goConn.cUser, goConn.cPassword, llReconnect)
|
|
|
|
*!* gnHandle = SQLConnect(gcHost,gcUserName,gcPassword)
|
|
|
|
If lnHandle < 0
|
|
Declare laEroare2(1)
|
|
Aerror(laEroare2)
|
|
lcTextEroare = laEroare2(3)
|
|
If Type('goLog')='O'
|
|
goLog.Log(lcTextEroare,Program())
|
|
Endif
|
|
|
|
Release laEroare2
|
|
Loop
|
|
Else
|
|
*!* goExecutor.nHandle = gnHandle
|
|
Exit
|
|
Endif
|
|
Else
|
|
Quit
|
|
Retry
|
|
Endif && lnRaspuns = 6
|
|
Enddo && .T.
|
|
Loop && daca am iesit cu un handle valid intru din nou in loop si fac cursorfill
|
|
Otherwise
|
|
lcTextEroare = Program() + Chr(13) + Alltrim(Str(lnEroare1)) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3]) + Chr(13) + lcSql
|
|
If llShowError
|
|
lnRaspuns = Messagebox('Eroare necunoscuta' + Chr(13) + lcTextEroare,0,'Eroare') && ok = 0
|
|
Endif
|
|
If Type('goLog')='O'
|
|
goLog.Log(lcTextEroare,Program())
|
|
Endif
|
|
If llQuitOnError
|
|
Quit
|
|
Retry
|
|
Else
|
|
Exit
|
|
Endif
|
|
Endcase && INLIST(lnEroare2,12152,3114)
|
|
Endcase
|
|
Endif && lnSucces < 0
|
|
|
|
Enddo && .T.
|
|
|
|
If llProgress
|
|
loTherm.Complete()
|
|
Release loTherm
|
|
Endif
|
|
|
|
Case lnTip = 1
|
|
If 'ROLLBACK'$lcSql
|
|
lnSucces = Sqlrollback(lnHandle)
|
|
Else
|
|
lnSucces = Sqlcommit(lnHandle)
|
|
Endif
|
|
Endcase
|
|
|
|
If lnSucces < 0
|
|
Aerror(laEroare)
|
|
|
|
If laEroare[1] <> 1526
|
|
lcEroare = laEroare[2]
|
|
Else
|
|
lcEroare = Alltrim(Str(lnEroare1)) + ' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3]) + Chr(13) + lcSql
|
|
Endif
|
|
|
|
If llShowError
|
|
Messagebox(lcEroare,0,"Eroare")
|
|
Endif
|
|
If llQuitOnError
|
|
Quit
|
|
Retry
|
|
Endif
|
|
|
|
Endif
|
|
|
|
|
|
|
|
This.aEroare = laEroare
|
|
This.nSucces = lnSucces
|
|
This.cEroare = lcEroare
|
|
|
|
Return lnSucces
|
|
|
|
Endproc
|
|
******************************************* SFARSIT: oExecute *******************************************
|
|
|
|
|
|
|
|
* PROCEDURE oReset( )
|
|
* Date : 06/10/2004, 12:21:06
|
|
* author : marius.mutu
|
|
* description:
|
|
|
|
****** PARAMETER BLOCK **************
|
|
* Parameters : 0
|
|
*
|
|
******************************************* INCEPUT:oReset *******************************************
|
|
Procedure Oreset( )
|
|
With This
|
|
.aEroare = .F.
|
|
.nSucces = 0
|
|
.cSql = ''
|
|
.cCursor = ''
|
|
Endwith
|
|
Endproc
|
|
******************************************* SFARSIT: oReset *******************************************
|
|
Enddefine && oExecutor
|
|
|
|
|
|
|
|
|
|
*** oConn ===========================================================================================
|
|
Define Class oConn As Custom
|
|
|
|
cHost = ''
|
|
cUser = ''
|
|
cPassword = ''
|
|
cIdUtilizator = ''
|
|
nHandle = 0
|
|
cEroare = ''
|
|
Declare aEroare[7]
|
|
lShowError = .F.
|
|
lReconnect = .F. && Daca llReconnect = .T. se apeleaza InitSesiune din oInit_Optiuni.prg
|
|
|
|
|
|
*** Connect ===========================================================================================
|
|
Procedure Connect
|
|
Lparameters tcHost, tcUser, tcPassword, tcIdUtilizator, tlReconnect
|
|
|
|
*!* tlReconnect = .T. daca se apeleaza connect la reconectare (atunci se apeleaza si InitSesiune())
|
|
Local lnSucces, laEroare, lcString, lcHost, lcUser, lcPassword, lcSql
|
|
|
|
If Pcount() < 4 Or Type('tcHost') # 'C' Or Type('tcUser') # 'C' ;
|
|
OR Type('tcPassword') # 'C' Or Type('tcIdUtilizator') # 'C'
|
|
*
|
|
Else
|
|
This.cHost = tcHost
|
|
This.cUser = tcUser
|
|
This.cPassword = tcPassword
|
|
This.cIdUtilizator = tcIdUtilizator
|
|
Endif
|
|
|
|
lcHost = This.cHost
|
|
lcUser = This.cUser
|
|
lcPassword = This.cPassword
|
|
|
|
If Pcount() < 5 Or Type('tlReconnect') # 'L'
|
|
llReconnect = This.lReconnect
|
|
Else
|
|
llReconnect = tlReconnect
|
|
Endif
|
|
|
|
SQLSetprop(0,"DispLogin",3)
|
|
lcString = "dsn=" + Alltrim(lcHost) + ";Uid=" + Alltrim(lcUser) + ";Pwd=" + Alltrim(lcPassword) + ";"
|
|
|
|
This.nHandle = Sqlstringconnect(lcString)
|
|
|
|
If Type('gnHandle') = 'N'
|
|
gnHandle = This.nHandle
|
|
Endif
|
|
|
|
If Type('goExecutor') = 'O'
|
|
goExecutor.nHandle = This.nHandle
|
|
Endif
|
|
|
|
If This.nHandle > 0
|
|
lnSucces = 1
|
|
|
|
*** SETARI SESIUNE DUPA CONECTARE
|
|
This.postConn()
|
|
|
|
If llReconnect
|
|
lnSucces = InitSesiune() && IN oInit_Optiuni.prg
|
|
Endif
|
|
Else
|
|
lnSucces = -1
|
|
This.ProcessError()
|
|
Endif
|
|
|
|
Return This.nHandle
|
|
|
|
Endproc && Connect
|
|
*** END Connect ===========================================================================================
|
|
|
|
*** Disconnect ===========================================================================================
|
|
Procedure Disconnect
|
|
Lparameters tnHandle
|
|
|
|
Local lnSucces, lnHandle
|
|
|
|
lnHandle = Iif(Empty(tnHandle) Or Type('tnHandle') # 'N', 0 , tnHandle)
|
|
|
|
lnSucces = SQLDisconnect(lnHandle)
|
|
|
|
If lnSucces < 0
|
|
This.ProcessError()
|
|
Endif
|
|
|
|
Return lnSucces
|
|
|
|
Endproc &&
|
|
*** END Disconnect ===========================================================================================
|
|
|
|
*** ProcessError ===========================================================================================
|
|
Procedure ProcessError
|
|
|
|
Local laEroare, lnEroare1, lnEroare2, lcTextEroare, lcEroareConectare
|
|
lcTextEroare = ''
|
|
lcEroareConectare = ''
|
|
Dimension laEroare[1]
|
|
|
|
Aerror(laEroare)
|
|
If Alen(laEroare) > 1
|
|
lnEroare1 = laEroare[1]
|
|
lnEroare2 = laEroare[5]
|
|
lcTextEroare = laEroare[3]
|
|
lnHandle = laEroare[6]
|
|
llEroare = .T.
|
|
|
|
lcTextEroare = 'Conectarea nu a reusit ' + Chr(13) + Chr(10) + Alltrim(Transform(laEroare[1])) + ;
|
|
' ' + Chr(13) + Transform(laEroare[2]) + Chr(13) + Transform(laEroare[3])
|
|
This.cEroare = lcTextEroare
|
|
This.aEroare = laEroare
|
|
|
|
goLog.Log(lcTextEroare,Program())
|
|
|
|
If laEroare[1] = 1526 And Like('*ORA-20???:*',laEroare[2])
|
|
lnPozi = At("ORA-20",laEroare[2])+11
|
|
lnPozf = At("ORA",laEroare[2],3)
|
|
lcEroareConectare = Substr(laEroare[2],lnPozi,lnPozf-lnPozi)
|
|
Else
|
|
lcEroareConectare = lcTextEroare
|
|
Endif
|
|
If Empty(lcEroareConectare)
|
|
lcEroareConectare = "Conectarea nu a reusit!"
|
|
Endif
|
|
|
|
Messagebox(lcEroareConectare, 0 + 48,"Atentie")
|
|
Endif
|
|
|
|
Return lcTextEroare
|
|
|
|
Endproc && ProcessError
|
|
*** END ProcessError ===========================================================================================
|
|
|
|
*** postConn ===========================================================================================
|
|
Procedure postConn
|
|
*** PUNCT ZECIMAL
|
|
lcSql=[ALTER SESSION SET NLS_NUMERIC_CHARACTERS = ".,"]
|
|
lnSucces = goExecutor.oExecute(lcSql)
|
|
If lnSucces < 0
|
|
Messagebox(goExecutor.cEroare, 0 + 16,'Eroare')
|
|
Endif
|
|
|
|
Endproc && postConn
|
|
*** END postConn ===========================================================================================
|
|
|
|
|
|
Enddefine && oConn
|
|
*** END oConn ===========================================================================================
|
|
|
|
|
|
|
|
* PROCEDURE Get_Ora( tnTip )
|
|
* Date : 16/11/2004, 08:58:45
|
|
* author : marius.mutu
|
|
* description:
|
|
|
|
****** PARAMETER BLOCK **************
|
|
* Parameters : 1
|
|
* Parameter 1:
|
|
*
|
|
******************************************* INCEPUT:Get_Ora *******************************************
|
|
Procedure Get_Ora( tnTip )
|
|
* tnTip: 1 sau nimic = DATETIME ; 2 = CHARACTER
|
|
|
|
Local lcRetVal
|
|
|
|
If Pcount() = 0 Or Type('tnTip') <> 'N'
|
|
lnTip = 1
|
|
Else
|
|
lnTip = tnTip
|
|
Endif
|
|
|
|
&&preluare ora de pe oracle server:
|
|
Store 0 To pnsucces
|
|
pcexec = [select to_char(SYSdate,'dd/mm/yyyy hh:mi:ss AM') as dataora from dual]
|
|
pcCursor = [dataora_cursor]
|
|
pnsucces = goExecutor.oExecute(pcexec,pcCursor)
|
|
If (pnsucces != 0)
|
|
Select dataora_cursor
|
|
lcRetVal = dataora_cursor.dataora
|
|
Use In dataora_cursor
|
|
Endif
|
|
|
|
If lnTip = 1
|
|
lcRetVal = Ctot(lcRetVal)
|
|
Endif
|
|
Return lcRetVal
|
|
Endproc
|
|
******************************************* SFARSIT: Get_Ora *******************************************
|
|
|
|
Function Lista_Campuri
|
|
Lparameters tcAlias
|
|
|
|
Local lcSelect, i, lcAlias, lcLista
|
|
lcLista = []
|
|
lcSelect = Select()
|
|
lcAlias = tcAlias
|
|
|
|
Select (lcAlias)
|
|
lnFields = Fcount()
|
|
For i = 1 To lnFields
|
|
lcField = Field(i)
|
|
lcLista = lcLista + [,] + lcField
|
|
Endfor
|
|
If !Empty(lcLista)
|
|
lcLista = Substr(lcLista,2)
|
|
Endif
|
|
|
|
Select (lcSelect)
|
|
Return lcLista
|
|
|
|
Endfunc && Lista_Campuri
|
|
|
|
|
|
***---------------------------------------------------------------------
|
|
Procedure OPEN_DEFAULT_APP
|
|
Parameters tcfilename
|
|
|
|
Declare Integer ShellExecute In shell32.Dll ;
|
|
INTEGER hndWin, ;
|
|
STRING cAction, ;
|
|
STRING cFileName, ;
|
|
STRING cParams, ;
|
|
STRING cDir, ;
|
|
INTEGER nShowWin
|
|
cFileName = tcfilename
|
|
cAction = "open"
|
|
ShellExecute(0,cAction,cFileName,"","",1)
|
|
|
|
Endproc && OPEN_DEFAULT_APP
|
|
|
|
|
|
***---------------------------------------------------------------------
|
|
Procedure GET_SCHEMA_GRID
|
|
Lparameters toGrid, tcColumnList, tcHeaderList, tcSchema, tlSelect, tnType, tcFrom, tcWhere, tcOrder, tcOutputName
|
|
|
|
Local lcSelect, llSelect, lcAlias, lcWhere, lcOrder, lcColumn, lcHeader
|
|
Local lnType, lcInto
|
|
&& tnType : 0 CURSOR, 1 TABLE, 2 ARRAY
|
|
|
|
If Type('tnType') # 'N'
|
|
lnType = 0
|
|
Else
|
|
If !Between(tnType,0,2)
|
|
lnType = 0
|
|
Else
|
|
lnType = tnType
|
|
Endif
|
|
Endif
|
|
Do Case
|
|
Case lnType = 0
|
|
lcInto = ' INTO CURSOR '
|
|
Case lnType = 1
|
|
lcInto = ' INTO TABLE '
|
|
Other lnType = 1
|
|
lcInto = ' INTO ARRAY '
|
|
Endcase
|
|
|
|
|
|
tcColumnList = ''
|
|
tcHeaderList = ''
|
|
tcSchema = ''
|
|
|
|
lnNrCol = toGrid.ColumnCount
|
|
Dimension myArray[lnNrCol,3]
|
|
|
|
With toGrid
|
|
For lnCol = 1 To .ColumnCount
|
|
lnColumn = .Columns(lnCol).ColumnOrder
|
|
lcColumn = .Columns(lnCol).ControlSource
|
|
llVisible = .Columns(lnCol).Visible
|
|
lnWidth = .Columns(lnCol).Width
|
|
If !llVisible Or lnWidth = 0
|
|
Adel(myArray,lnCol)
|
|
Loop
|
|
Endif
|
|
lnPos = At('.',lcColumn)
|
|
If lnPos > 0
|
|
lcColumn = Substr(lcColumn, lnPos + 1)
|
|
Endif
|
|
*tcColumnList = tcColumnList + lcColumn + ','
|
|
myArray[lnCol,1] = lnColumn
|
|
|
|
For lnobjcol = 1 To .Columns(lnCol).Objects.Count
|
|
If Upper(.Columns(lnCol).Objects(lnobjcol).BaseClass)='HEADER'
|
|
lcHeader = .Columns(lnCol).Objects(lnobjcol).Caption
|
|
lcHeader = Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(Strtran(lcHeader,Chr(32),'_'),'.','_'),'/','_'),'\','_'),"&","_"),"%",""),"(","_"),")","_"),"-","_")
|
|
*tcHeaderList = tcHeaderList + lcHeader + ','
|
|
*tcSchema = tcSchema + lcColumn + [ as ] + lcHeader + [,]
|
|
myArray[lnCol,2] = lcColumn
|
|
myArray[lnCol,3] = lcHeader
|
|
Exit
|
|
Endif
|
|
Endfor
|
|
Endfor
|
|
*!* tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList)-1)
|
|
*!* tcHeaderList = Substr(tcHeaderList , 1, Len(tcHeaderList)-1)
|
|
*!* tcSchema = Substr(tcSchema , 1, Len(tcSchema)-1)
|
|
Endwith
|
|
For i = 1 To Alen(myArray,1)
|
|
l1 = myArray[i,1]
|
|
If Type('l1') # 'N'
|
|
myArray[i,1] = -1
|
|
Endif
|
|
Endfor
|
|
|
|
Asort(myArray)
|
|
For i = 1 To Alen(myArray,1)
|
|
If myArray[i,1] <> -1
|
|
tcColumnList = tcColumnList + Alltrim(myArray[i,2]) + [,]
|
|
tcHeaderList = tcHeaderList + Alltrim(myArray[i,3]) + [,]
|
|
tcSchema = tcSchema + Alltrim(myArray[i,2]) + [ as ] + Alltrim(myArray[i,3]) + [,]
|
|
Endif
|
|
Endfor
|
|
|
|
tcColumnList = Substr(tcColumnList, 1, Len(tcColumnList)-1)
|
|
tcHeaderList = Substr(tcHeaderList , 1, Len(tcHeaderList)-1)
|
|
tcSchema = Substr(tcSchema , 1, Len(tcSchema)-1)
|
|
|
|
|
|
If tlSelect
|
|
tcSchema = 'SELECT ' + tcSchema
|
|
Endif
|
|
If !Empty(tcFrom)
|
|
tcSchema = tcSchema + ' FROM ' + Alltrim(tcFrom)
|
|
Endif
|
|
If !Empty(tcWhere)
|
|
tcSchema = tcSchema + ' WHERE ' + Alltrim(tcWhere)
|
|
Endif
|
|
|
|
If !Empty(tcOrder)
|
|
tcSchema = tcSchema + ' ORDER BY ' + Alltrim(tcOrder)
|
|
Endif
|
|
|
|
If !Empty(tcOutputName)
|
|
tcSchema = tcSchema + lcInto + tcOutputName
|
|
Endif
|
|
|
|
Endproc && GET_SCHEMA_GRID
|
|
|
|
***---------------------------------
|
|
Procedure amessage
|
|
Lparameters tcMessage, tnDialogBoxType, tcTitleBarText, tnTimeOut
|
|
Local lnResponse
|
|
lnResponse = 0
|
|
lcMessage = Iif(Empty(tcMessage),[],tcMessage)
|
|
lnDialogBoxType = Iif(Empty(tnDialogBoxType),0,tnDialogBoxType)
|
|
lcTitleBarText = Iif(Empty(tcTitleBarText),[],tcTitleBarText)
|
|
lnTimeOut = Iif(Empty(tnTimeOut),0,tnTimeOut)
|
|
If lnTimeOut # 0
|
|
lnResponse = Messagebox(lcMessage,lnDialogBoxType,lcTitleBarText,lnTimeOut)
|
|
Else
|
|
lnResponse = Messagebox(lcMessage,lnDialogBoxType,lcTitleBarText)
|
|
Endif
|
|
|
|
Return lnResponse
|
|
|
|
Endproc && amessage
|
|
***---------------------------------
|
|
|
|
***---------------------------------
|
|
Function amessagebox
|
|
Lparameters tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut ,tnTimeoutValue
|
|
|
|
Local loMessage, lnReturn
|
|
loMessage = Newobject("messagebox_form", "MessageBox.vcx", "", tcMessage, tnDialogBoxType, tcTitle, tcFont, tnTimeOut ,tnTimeoutValue)
|
|
loMessage.Show(1)
|
|
lnReturn = loMessage.IDOpcion
|
|
Return lnReturn
|
|
|
|
Endfunc && amessagebox
|
|
***---------------------------------
|
|
|
|
Procedure export_xls
|
|
Lparameters tcAlias
|
|
|
|
If Used(tcAlias)
|
|
lcDir = Addbs(gcTempPath)
|
|
|
|
lcFile = Putfile('Nume fisier:', 'Foaie_Excel', 'XLS')
|
|
If Empty(lcFile) && Esc pressed
|
|
Return
|
|
Endif
|
|
|
|
|
|
Select (tcAlias)
|
|
Export To (lcFile) Type Xl5
|
|
|
|
OPEN_DEFAULT_APP(lcFile)
|
|
|
|
Endif
|
|
Endproc && export_xls
|
|
|
|
* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
|
|
Procedure SAVE_GRID_COMMENT
|
|
Param toGrid
|
|
*wait wind 'save_grid'
|
|
Private pogrid
|
|
If Param()=0 Or Type('togrid')!="O"
|
|
Return .F.
|
|
Endif
|
|
|
|
pogrid=toGrid
|
|
|
|
* remember control sources in the column's comment field
|
|
With pogrid
|
|
Local nColumnIndex
|
|
For m.nColumnIndex = 1 To .ColumnCount
|
|
.Columns(m.nColumnIndex).Comment = .Columns(m.nColumnIndex).ControlSource
|
|
Endfor
|
|
.ToolTipText=.RecordSource
|
|
.RecordSource=""
|
|
Endwith
|
|
|
|
Return .T.
|
|
Endproc && SAVE_GRID_COMMENT
|
|
***--------------------------------------------------------------
|
|
Procedure RESTORE_GRID_COMMENT
|
|
Param toGrid
|
|
|
|
*wait wind 'restore_grid'
|
|
Private pogrid
|
|
If Param()=0 Or Type('togrid')!="O"
|
|
Return .F.
|
|
Endif
|
|
|
|
pogrid=toGrid
|
|
|
|
|
|
With pogrid
|
|
* restore record source
|
|
.RecordSource = .ToolTipText
|
|
* restore control sources
|
|
For m.nColumnIndex = 1 To .ColumnCount
|
|
.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Comment
|
|
Endfor
|
|
.ToolTipText=""
|
|
Endwith
|
|
Return .T.
|
|
Endproc && RESTORE_GRID_COMMENT
|
|
|
|
|
|
* Foloseste comment de la coloane si tooltiptext de la grid pt a salva recordsource si controlsource din grid inainte de reconstructie
|
|
Procedure SAVE_GRID_TAG
|
|
Param toGrid
|
|
*wait wind 'save_grid'
|
|
Private pogrid
|
|
If Param()=0 Or Type('togrid')!="O"
|
|
Return .F.
|
|
Endif
|
|
|
|
pogrid=toGrid
|
|
|
|
* remember control sources in the column's comment field
|
|
With pogrid
|
|
Local nColumnIndex
|
|
For m.nColumnIndex = 1 To .ColumnCount
|
|
.Columns(m.nColumnIndex).Tag = .Columns(m.nColumnIndex).ControlSource
|
|
Endfor
|
|
.ToolTipText=.RecordSource
|
|
.RecordSource=""
|
|
Endwith
|
|
|
|
Return .T.
|
|
Endproc && SAVE_GRID_TAG
|
|
***--------------------------------------------------------------
|
|
Procedure RESTORE_GRID_TAG
|
|
Param toGrid
|
|
|
|
*wait wind 'restore_grid'
|
|
Private pogrid
|
|
If Param()=0 Or Type('togrid')!="O"
|
|
Return .F.
|
|
Endif
|
|
|
|
pogrid=toGrid
|
|
|
|
|
|
With pogrid
|
|
* restore record source
|
|
.RecordSource = .ToolTipText
|
|
* restore control sources
|
|
For m.nColumnIndex = 1 To .ColumnCount
|
|
.Columns(m.nColumnIndex).ControlSource = .Columns(m.nColumnIndex).Tag
|
|
Endfor
|
|
.ToolTipText=""
|
|
Endwith
|
|
Return .T.
|
|
Endproc && RESTORE_GRID_TAG
|
|
|
|
|
|
*-------------------------------------------
|
|
* 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]
|
|
*
|
|
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 )
|
|
|
|
Return
|
|
&&&&&&&&&&&&&&&&&&&&&&&&&&&&&& MENIU &&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&&
|
|
|
|
Procedure lista2array
|
|
Parameters tcLISTA,taArray,tcSeparator
|
|
&& tcLista este un sir de caractere care contine elementele separate prin <;> default
|
|
&& tarray este vectorul care se completeaza - trebuie dat prin referinta
|
|
&& tcSeparator separatorul de elemente din tcLista - default este ";" - este optional
|
|
&& intoarce numarul de elemente gasite
|
|
|
|
&& ex: lnNr = lista2array("ana;are;mere",@alista,";")
|
|
External Array taArray
|
|
Local lcLista,lcSeparator,lnNRF,lcF1,i
|
|
|
|
lnNRF = 0
|
|
|
|
lcLista=Upper(Allt(tcLISTA))
|
|
If Parameters()<3 Or Empty(tcSeparator)
|
|
lcSeparator=";"
|
|
Else
|
|
lcSeparator=Alltrim(tcSeparator)
|
|
Endif
|
|
|
|
If Right(lcLista,1)!=lcSeparator
|
|
lcLista=lcLista+lcSeparator
|
|
Endif
|
|
|
|
lnNRF=Occurs(lcSeparator,lcLista)
|
|
|
|
If lnNRF>0
|
|
Dimension taArray[lnNrf,1]
|
|
|
|
For i=1 To lnNRF
|
|
lcF1=Left(lcLista,At(lcSeparator,lcLista)-1)
|
|
|
|
If i!=lnNRF
|
|
lcLista=Substr(lcLista,At(lcSeparator,lcLista)+1)
|
|
Endif
|
|
|
|
taArray[i]=lcF1
|
|
Endfor
|
|
Else
|
|
lnNRF = 0
|
|
Endif
|
|
|
|
Return lnNRF
|
|
|
|
Endproc && lista2array
|
|
|
|
|
|
***-------------------------------------------------------------------------------------------
|
|
Procedure get_mask
|
|
Parameters tnint, tndec
|
|
|
|
Local lnint, lndec
|
|
lnint = tnint
|
|
lndec = tndec
|
|
lnrest = Mod(lnint,3)
|
|
|
|
lcString = Replicate("9",lnrest)
|
|
lnint_ramas = lnint - lnrest
|
|
Do While lnint_ramas > 0
|
|
lcString = lcString + " "+ Replicate("9",3)
|
|
lnint_ramas = lnint_ramas - 3
|
|
Enddo
|
|
If lndec > 0
|
|
lcString = lcString +"."+Replicate("9",tndec)
|
|
Endif
|
|
|
|
Return lcString
|
|
|
|
Endproc && get_mask
|
|
***-----------------------------------------------------------
|
|
|
|
|
|
*******************************************************************
|
|
* PROCEDURE Get_Version( )
|
|
* Date : 17/11/2004, 16:34:20
|
|
* author : marius.mutu
|
|
* description:
|
|
|
|
****** PARAMETER BLOCK **************
|
|
* Parameters : 0
|
|
*
|
|
******************************************* INCEPUT:Get_Version *******************************************
|
|
Procedure Get_Version(tlNoRevision,tlInfo,tcfilename)
|
|
Local laVersion,lcVersion,lcFileName
|
|
|
|
*-- Get Version Information
|
|
*-- Added 4-1-98 BDC
|
|
Local lcVersionText, lcFileName,llNoRevision,llInfo
|
|
|
|
Dimension aVersion(12)
|
|
|
|
If Empty(tcfilename)
|
|
lcFileName = Sys(16,0)
|
|
Else
|
|
lcFileName = tcfilename
|
|
Endif
|
|
llNoRevision = tlNoRevision
|
|
llInfo = tlInfo
|
|
|
|
|
|
|
|
*** EGL: 2002.1.2 17:06 - switched to AGETFILEVERSION().
|
|
If Val(Substr(Version(), 15)) >= 6
|
|
* The AGETFILEVERSION() function was introduced in VFP 6
|
|
|
|
*!* DECLARE STRING GetCommandLine IN Kernel32
|
|
*!* lcFileName = GetCommandLine()
|
|
lcVersionText = ""
|
|
|
|
*!* IF GetFileVersion(&lcFileName,@aVersion) = 0
|
|
If Agetfileversion(aVersion, lcFileName) > 0
|
|
If !llInfo
|
|
* daca vreau doar numarul versiunii
|
|
lcVersion = Allt(aVersion(4))
|
|
If llNoRevision
|
|
* daca nu vreau si revizia
|
|
lnPos = Rat('.',lcVersion,1)
|
|
Else
|
|
lnPos = Len(lcVersion)
|
|
Endif
|
|
lcVersionText = Left(lcVersion,lnPos)
|
|
Else
|
|
* vreau toata informatia despre fisier
|
|
If Not Empty(aVersion(1))
|
|
lcVersionText = Allt(aVersion(1))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(2))
|
|
lcVersionText = lcVersionText+Chr(10)+"Produs de: "+ Allt(aVersion(2))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(3))
|
|
lcVersionText = lcVersionText+Chr(10)+"Descriere: "+ Allt(aVersion(3))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(4))
|
|
lcVersionText = lcVersionText+Chr(10)+"Versiune fisier: "+ Allt(aVersion(4))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(5))
|
|
lcVersionText = lcVersionText+Chr(10)+"Nume intern: "+ Allt(aVersion(5))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(6))
|
|
lcVersionText = lcVersionText+Chr(10)+"Copyright: "+ Allt(aVersion(6))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(7))
|
|
lcVersionText = lcVersionText+Chr(10)+"Marca inregistrata: "+ Allt(aVersion(7))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(8))
|
|
lcVersionText = lcVersionText+Chr(10)+"Nume fisier: "+ Allt(aVersion(8))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(9))
|
|
lcVersionText = lcVersionText+Chr(10)+"Private Build: "+ Allt(aVersion(9))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(10))
|
|
lcVersionText = lcVersionText+Chr(10)+"Nume produs: "+ Allt(aVersion(10))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(11))
|
|
lcVersionText = lcVersionText+Chr(10)+"Versiune produs: "+ Allt(aVersion(11))
|
|
Endif
|
|
|
|
If Not Empty(aVersion(12))
|
|
lcVersionText = lcVersionText+Chr(10)+"Special Build: "+ Allt(aVersion(12))
|
|
Endif
|
|
|
|
If Empty(lcVersionText)
|
|
lcVersionText = "Versiune necunoscuta."
|
|
Endif
|
|
Endif
|
|
Else
|
|
|
|
lcVersionText = "Versiune necunoscuta."
|
|
|
|
Endif
|
|
|
|
Else
|
|
lcVersionText = "Versiune necunoscuta."
|
|
Endif
|
|
Return lcVersionText
|
|
|
|
Endproc
|
|
******************************************* SFARSIT: Get_Version *******************************************
|
|
|
|
|
|
* PROCEDURE Get_Hexa( tnDeca )
|
|
* Date : 18/11/2004, 17:56:48
|
|
* author : marius.mutu
|
|
* description: transforma un Deca in Hexa
|
|
|
|
****** PARAMETER BLOCK **************
|
|
* Parameters : 1
|
|
* Parameter 1: Numarul in Deca
|
|
*
|
|
******************************************* INCEPUT:Get_Hexa *******************************************
|
|
Procedure Get_Hexa( tnDeca )
|
|
Local laHexa,lnHexa,lnDeca
|
|
|
|
|
|
If Empty(tnDeca)
|
|
lnDeca = 0
|
|
Else
|
|
lnDeca = tnDeca
|
|
Endif
|
|
|
|
Dimension laHexa[16]
|
|
laHexa[1] = '0'
|
|
laHexa[2] = '1'
|
|
laHexa[3] = '2'
|
|
laHexa[4] = '3'
|
|
laHexa[5] = '4'
|
|
laHexa[6] = '5'
|
|
laHexa[7] = '6'
|
|
laHexa[8] = '7'
|
|
laHexa[9] = '8'
|
|
laHexa[10] = '9'
|
|
laHexa[11] = 'A'
|
|
laHexa[12] = 'B'
|
|
laHexa[13] = 'C'
|
|
laHexa[14] = 'D'
|
|
laHexa[15] = 'E'
|
|
laHexa[16] = 'F'
|
|
|
|
lnHexa = ''
|
|
|
|
Do While lnDeca > 0
|
|
lnrest = Mod(lnDeca,16)
|
|
lcHexa = laHexa[lnRest+1]
|
|
lnDeca = Int(lnDeca/16)
|
|
|
|
lnHexa = lcHexa + lnHexa
|
|
lnrest = Mod(lnDeca,16)
|
|
|
|
Enddo
|
|
|
|
Return lnHexa
|
|
|
|
Endproc
|
|
******************************************* SFARSIT: Get_Hexa *******************************************
|
|
&& completeaza cu spatii si CRLF un mesaj a.i. pe fiecare linie sa fie lnLength caractere
|
|
Function format_msg
|
|
Parameters tcErrMsg,tnLength
|
|
Local lnLength,lcLinie,lcMesaj,lnPoz,lnCate,i,j
|
|
lcMesaj=""
|
|
If Empty(tnLength)
|
|
lnLength=50 && numarul de caractere pe linie
|
|
Else
|
|
lnLength=tnLength
|
|
Endif
|
|
i=1
|
|
If At(Chr(13)+Chr(10),tcErrMsg,i)>0
|
|
lnCate=At(Chr(13)+Chr(10),tcErrMsg,i)+1
|
|
i=i+1
|
|
Else
|
|
lnCate=Min(lnLength,Rat(' ',Substr(tcErrMsg,1,lnLength))-1)
|
|
Endif
|
|
lnPoz=1
|
|
*!* lcLinie=Substr(tcErrMsg,1,lnCate)
|
|
|
|
Do While lnPoz<Len(tcErrMsg)
|
|
lcLinie=Substr(tcErrMsg,lnPoz,lnCate)
|
|
|
|
If Right(lcLinie,2)=Chr(13)+Chr(10)
|
|
lcLinie=Alltrim(Substr(lcLinie,1,Len(lcLinie)-2))
|
|
Else
|
|
lcLinie=Alltrim(lcLinie)
|
|
Endif
|
|
|
|
j=Int((lnLength-Len(lcLinie))/2)
|
|
lcLinie=Iif(!Empty(lcLinie),Space(j)+lcLinie+Space(j),"")
|
|
lcMesaj=lcMesaj+lcLinie+Chr(13)+Chr(10)
|
|
|
|
lnPoz=lnPoz+lnCate
|
|
|
|
If At(Chr(13)+Chr(10),tcErrMsg,i)>0
|
|
lnCate=At(Chr(13)+Chr(10),tcErrMsg,i)+2-lnPoz
|
|
i=i+1
|
|
Else
|
|
lcNextChar=Substr(tcErrMsg,lnPoz+lnLength,1)
|
|
lcLinieNoua=Substr(tcErrMsg,lnPoz,lnLength)
|
|
If lcNextChar!=' ' And Len(lcLinieNoua)>=lnLength
|
|
lnCate=Min(lnLength,Rat(' ',lcLinieNoua)-1)
|
|
Else
|
|
lnCate=lnLength
|
|
Endif
|
|
Endif
|
|
Enddo
|
|
Return lcMesaj
|
|
Endfunc && format_msg
|
|
***--------------------------------------------------------------------------------------
|
|
Function Lista_Campuri
|
|
Lparameters tcAlias
|
|
|
|
Local lcSelect, i, lcAlias, lcLista
|
|
lcLista = []
|
|
lcSelect = Select()
|
|
lcAlias = tcAlias
|
|
|
|
Select (lcAlias)
|
|
lnFields = Fcount()
|
|
For i = 1 To lnFields
|
|
lcField = Field(i)
|
|
lcLista = lcLista + [,] + lcField
|
|
Endfor
|
|
If !Empty(lcLista)
|
|
lcLista = Substr(lcLista,2)
|
|
Endif
|
|
|
|
Select (lcSelect)
|
|
Return lcLista
|
|
|
|
Endfunc && Lista_Campuri
|
|
***------------------------- CLASS oSysTray -------------------------
|
|
|
|
|
|
Define Class oSysTray As Custom
|
|
oobjsystray = Null
|
|
|
|
Procedure minimizeaza
|
|
|
|
Local lcIcon
|
|
lcIcon = [news1.ico]
|
|
|
|
If _Screen.WindowState = 1
|
|
This.oobjsystray= Newobject('systray')
|
|
With This.oobjsystray
|
|
.iconFile = lcIcon
|
|
.TipText = [Tasks]
|
|
IF WEXIST("frm_luc")
|
|
frm_lucrare_noua.release()
|
|
endif
|
|
.AddIconToSystray()
|
|
.icondblclickevent()
|
|
Endwith
|
|
_Screen.Hide()
|
|
Endif
|
|
Endproc
|
|
|
|
Procedure clickDreapta
|
|
|
|
Local lcIcon
|
|
lcIcon = [news1.ico]
|
|
|
|
If _Screen.WindowState = 1
|
|
This.oobjsystray= Newobject('systray')
|
|
With This.oobjsystray
|
|
.iconFile = lcIcon
|
|
.TipText = [Tasks]
|
|
.iconrightclickevent()
|
|
Endwith
|
|
* _Screen.Hide()
|
|
Endif
|
|
ENDPROC
|
|
|
|
|
|
Procedure iconrightclickevent
|
|
|
|
Local lcIcon
|
|
lcIcon = [news1.ico]
|
|
|
|
If _Screen.WindowState = 1
|
|
This.oobjsystray= Newobject('systray')
|
|
With This.oobjsystray
|
|
.iconFile = lcIcon
|
|
.TipText = [Tasks]
|
|
.AddIconToSystray()
|
|
Endwith
|
|
Do meniu.mpr
|
|
* _Screen.Hide()
|
|
Endif
|
|
ENDPROC
|
|
|
|
Enddefine
|
|
**----------------------- CLASS oSysTray ---------------------------------
|
|
|
|
|
|
|
|
FUNCTION HTMLFix(tcString)
|
|
* This code ASSUMES the incoming string is ANSI,
|
|
* CHR(32) to (127) and has not already had the
|
|
* characters converted - it will make a mess of a
|
|
* string that already has strings like — in it.
|
|
LOCAL lcString as string
|
|
lcString = STRTRAN(tcString,"&","&")
|
|
lcString = STRTRAN(lcString,"<","<")
|
|
lcString = STRTRAN(lcString,">",">")
|
|
RETURN ALLTRIM(lcString)
|
|
ENDFUNC && HTMLFix
|
|
|
|
|
|
FUNCTION RFC822Date(tDateTime AS DATETIME) AS STRING
|
|
* Returns "Thu, 27 Feb 2003 14:11:12 GMT"
|
|
LOCAL lcReturn AS STRING, lcTime AS STRING
|
|
lcReturn = LEFT(PROPER(CDOW(tDateTime)),3) +", "
|
|
lcReturn = lcReturn + PADL(DAY(tDateTime),2,'0') + SPACE(1)
|
|
lcReturn = lcReturn + LEFT(PROPER(CMONTH(tDateTime)),3) + SPACE(1)
|
|
lcReturn = lcReturn + STR(YEAR(tDateTime),4)+SPACE(1)
|
|
|
|
lcTime = TTOC(tDateTime,2) && HH:MM:SS PM
|
|
* Compensate for PM
|
|
IF RIGHT(lcTime,2) = "PM" AND LEFT(lcTime,2) # "12"
|
|
lcTime = STR(12+VAL(lcTime),2)+SUBSTR(lcTime, 3, 6)
|
|
ELSE
|
|
lcTime = LEFT(lcTime, 8)
|
|
ENDIF
|
|
* Fake the time zone
|
|
lcTime = lcTime + " EST"
|
|
|
|
lcReturn = lcReturn + lcTime
|
|
|
|
RETURN lcReturn
|
|
ENDFUNC && RFC822Date
|
|
|
|
|
|
*===============================================
|
|
Procedure COPYFILEAPI
|
|
Lparameters tcSourceFile, tcDestinationFile
|
|
|
|
&& WIN API
|
|
&& Copy file
|
|
&& NOTE: the file name case will not be changed for the existing destination file.
|
|
Declare Long CopyFile In WIN32API ;
|
|
String SourceFileName, String DestFileName, Long bFailIfExists
|
|
Local llSucces
|
|
llSucces = .T.
|
|
If COPYFILE(tcSourceFile, tcDestinationFile, 0) = 0
|
|
llSucces = .F.
|
|
ENDIF
|
|
|
|
CLEAR DLLS "WIN32API"
|
|
|
|
Return llSucces
|
|
Endproc && COPYFILE
|
|
|
|
*===============================================
|
|
Procedure MOVERENAMEFILEAPI
|
|
Lparameters tcSourceFile, tcDestinationFile
|
|
Local llSucces
|
|
llSucces = .T.
|
|
&& Move/Rename file
|
|
Declare Long MoveFile In WIN32API ;
|
|
String SourceFileName, String DestFileName
|
|
If MOVEFILE(tcSourceFile, tcDestinationFile) = 0
|
|
llSucces = .F.
|
|
Endif
|
|
|
|
CLEAR DLLS "WIN32API"
|
|
|
|
Return llSucces
|
|
Endproc && MOVEFILE
|