romfast/roastart
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
b241a639b162df8c4ddd8d8e4680ac1ee5c4707e
roastart/Programe/roastart.prg
Marius Mutu b241a639b1 Import initial: surse ROASTART + text FoxBin2Prg in arbore 
Binarele VFP raman pe SVN si sunt git-ignored; COMUN e gestionat separat.

Co-Authored-By: Claude Opus 5 (1M context) <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01A5okKjUKMM5Xk1egq2w81P
2026-08-03 09:34:12 +03:00

752 lines
22 KiB
Plaintext
Raw Blame History

*!* 24.06.2015
*!* marius.mutu
*!* Obiect KeepAlive Tin conexiunea deschisa. La wert??? apare eroarea odbc "timeout occured" daca se lasa peste 1 minut programul fara sa se lucreze
Public gnhandle
Public gTransferTotal
Public gcmdCancelDownload
Public gnewcryptfll
Public gnewcryptxml
gnewcryptfll=.F.
gnewcryptxml=.F.
Store -1 To gTransferTotal
Store -1 To gnhandle
gcmdCancelDownload=.F.
_Screen.Visible = (_VFP.StartMode <> 2)
_Screen.AutoCenter = .T.
_Screen.Caption = "ROA Romfast Applications"
_Screen.MaxButton=.F.
_Screen.BorderStyle=2
_Screen.Closable=.T.
_Screen.Icon=[ROASTART.ICO]
Public gcNumeProgram
gcNumeProgram = 'ROASTART'
Private gcCopyRight
gcCopyRight = '© ROA Romfast SRL'
*tparam=myinstance(JUSTPATH(SYS(16,0)))
Set Deleted On
Set Century On
Set Date Dmy
Set Safety Off
Set Console Off
Set NullDisplay To '*'
Set Seconds Off
Set Excl Off
Set Status Off
Set Status Bar Off
Set Exact On
Set Ansi On
Set Hours To 24
Set Sysmenu Off
Local lcMainClassLib
Local lcLastSetTalk,lcLastSetPath,lcLastSetClassLib,lcOnShutdown
*-- Save and configure environment.
lcLastSetTalk=Set("TALK")
Set Talk Off
lcLastSetPath=Set("PATH")
*** variabile publice
*!* Public gcAppPath,gcDatePath,buton,gctemppath,gcDirMare,gcDateRetea, gcSecurityPath, gcSecurityFile
*!* Store 2 To buton
*!* Store "" To gctemppath
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.23
Declare ExitProcess In WIN32API Integer
*!* modificare v 2.0.23 ^
Push Menu _Msysmenu
***************************************************************
Public gcAppPath,gcAppName,gcDirMare,gcSecurityFile,gcTempPath
Public plEroare
Store .F. To plEroare
Public goApi
SET PROCEDURE TO "D:\ROA\ROASTART\COMUN\utile\web\wwAPI.prg" ADDITIVE
SET PROCEDURE TO "D:\ROA\ROASTART\COMUN\utile\web\wwUtils.prg" ADDITIVE
goApi = CREATEOBJECT("wwAPI")
gcTempPath = Addbs(shortpath(goApi.GetTempPath())) && WWAPI.PRG
gcAppPath = Addbs(shortpath(STRTRAN(GetAppStartPath(),'PROGRAME\','',1,1,1)))
gcAppName=Juststem(Sys(16,0))
liat=Rat("\",gcAppPath,2)
gcDirMare=Left(gcAppPath,liat)
*!* gcDateRetea=gcDirMare+"DateRetea\"
DIRGEN = gcDirMare
gcDatePath=gcAppPath+"\Data\"
*!* modificare v 2.0.14
*!* gcComunPath=Addbs(gcDirMare)+"comun\"
gcComunPath=Addbs(gcDirMare)+"COMUNROA\"
*!* modificare v 2.0.14 ^
gcSecurityPath = gcDirMare + 'Security\'
gcSecurityFile = gcSecurityPath + 'ROA_SECURITY.TXT'
SET DEFAULT TO (m.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\INCLUDE;' + ;
gcAppPath + 'COMUN\RAPOARTE;' + ;
gcAppPath + 'COMUN\UTILE\CTL32;' + ;
gcAppPath + 'COMUN\UTILE\HPDF;' + ;
gcAppPath + 'COMUN\UTILE\HPDF\REPORTOUTPUT;' + ;
gcAppPath + 'COMUN\UTILE\WEB;' + ;
Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\]
SET PATH TO &lcPath ADDITIVE
*!* Set Path To Addbs(Substr(gcAppPath,1,Rat([\],gcAppPath,2)))+[COMUNROA\] Additive && modificare v 2.0.14
***************************************************************
lcLastSetClassLib=Set("CLASSLIB")
*!* lcMainClassLib="libs\"+gcAppName
lcMainClassLib = gcAppPath + "clase\ostart.vcx"
Set Classlib To (lcMainClassLib) Additive
Set Classlib To registry Additive
Set Classlib To decabaza Additive
Set Classlib To ofundal Additive
Set Classlib To ofundal_start Additive
Set Classlib To ostart_init Additive
Set Classlib To ostart_grup Additive
Set Classlib To ostart_util Additive
Set Classlib To ostart_admin Additive
Set Classlib To scrollcontainer Additive
Set Classlib To Messagebox Additive
Set Classlib To crypto Additive
Set Classlib To wwdialogs Additive
Set Classlib To ofirma Additive
*!* modificare v 2.0.23
Set Classlib To systray Additive
*!* modificare v 2.0.23 ^
SET CLASSLIB TO ctl32.vcx ADDITIVE
SET CLASSLIB TO appwiz_start.vcx ADDITIVE && modificare v 2.1.5
SET CLASSLIB TO accessibility.vcx ADDITIVE && modificare v 2.1.5
Set Procedure To wwcodeupdate Additive
Set Procedure To oproceduri_start Additive
Set Procedure To log_mesaje Additive
Set Procedure To oproceduri_ams Additive
Set Procedure To oproceduri_comune Additive
Set Procedure To proceduri_comune Additive
Set Procedure To gencursor Additive
Set Procedure To update_start Additive
Set Procedure To osecurity Additive
*!* 25.09.2006
*!* marius.mutu
Set Procedure To wwxmlhttp.prg Additive
*!* Set Procedure To wwutils.prg Additive
Set Procedure To WWHTTP.prg Additive
Set Procedure To ini.prg Additive
*!* 05.09.2007
*!* Vasile Cristian
Set Procedure To iniacces.prg Additive
Set Procedure To xmlaccess.prg Additive
Set Procedure To xmlparser.prg Additive
Set Procedure To Version.prg Additive
Set Procedure To filebringer.prg Additive
Set Procedure To procese.prg Additive
Set Procedure To updatecheck.prg Additive
Set Procedure To wwconfig.prg Additive
Set Procedure To oexport.prg Additive
Set Procedure To oupdate.prg Additive
If TooManyInstances(1) &&Too many instance already running?
Quit
Endif
*!* PRIVATE gcInstructiuniPath, gcRaportPath,gcAlfaPath
*!* modificare v 2.0.31
PUBLIC glFontCharSet
glFontCharSet = AFONT(laFontCharSet,"Arial Narrow",238)
*!* modificare v 2.0.31 ^
*!* Locale
Set Classlib To locale Additive
Private gcLocalePath, goLocale, glTraducere
gcLocalePath = gcAppPath + "Locale\"
glTraducere = .F.
lcLocaleDb = gcLocalePath + "locale.dbc"
Open Database (m.lcLocaleDb)
goLocale=Newobject("Locale","Locale.vcx")
lcFisierIni = shortpath(GetIniPath())
lcBuffer=Space(255)
*!* 16.01.2009
lcBuffer2=Space(255)
GetPrivateProfileString( "locale","llocale","", @m.lcBuffer2, Len(m.lcBuffer2), m.lcFisierIni)
lcBuffer2 = Strtran(m.lcBuffer2,Chr(0),"")
lcBuffer2 = Alltrim(m.lcBuffer2)
If Empty(lcBuffer2)
WritePrivateProfileString( "locale","llocale", '0' , m.lcFisierIni)
m.lcBuffer2='0'
Endif
If m.lcBuffer2<>'0'
goLocale.llocale=.T.
Endif
*!* 16.01.2009 ^
GetPrivateProfileString( "locale","lang","", @m.lcBuffer, Len(m.lcBuffer), m.lcFisierIni)
lcBuffer = Strtran(m.lcBuffer,Chr(0),"")
lcBuffer = Alltrim(m.lcBuffer)
If Empty(lcBuffer)
WritePrivateProfileString( "locale","lang", 'Romana' , m.lcFisierIni)
lcBuffer='Romana'
Endif
goLocale.locale = m.lcBuffer
*!* Locale ^
*!* modificare v 2.0.14
*!* Local loex17 As Exception
*!* Try
*!* gnewcryptfll=.T.
*!* Set Default To (gcComunPath)
*!* Set Library To vfpencryption.fll Additive
*!* Catch To loex17
*!* gnewcryptfll=.F.
*!* *MESSAGEBOX(loex17.Message)
*!* Endtry
*!* modificare v 2.0.14 ^
*set library to bbDownLoadURL.fll additive
#include registry.h
*!* **variabile publice care imi folosesc in start pentru nivelele de acces
*!* Public id_utilizator,nivel_acces
*!* Store 0 To id_utilizator
*!* Store .F. To nivel_acces
Public poLog, goLog && obiect pt logarea mesajelor sistemului ; modificare v 2.1.2 : am adaugat goLog
Local lcLog
poLog = Newobject("Log_Mesaje","Log_Mesaje.prg")
lcLog = [0]
goLog = poLog && modificare v 2.1.2
poLog.Log(lcLog,Program())
Public gcHost,gnIdUtil,gcUtil,gcuserName,gcPassword,glIntrat,gcUserNameApp,gnButon,glSupervizor,glAdministrator,gcAcces,gcS
gcAcces="1;2;3;4;"
glSupervizor = .F.
glAdministrator = .F.
gnButon=1
glIntrat=.F.
gcHost = "jcsserver"
gcuserName = "contafin_ORACLE"
gcPassword = "123"
**variabile publice care imi folosesc in start pentru nivelele de acces
*!* gcInstructiuniPath = gcAppPath + 'Instructiuni\'
*!* gcRaportPath = gcAppPath + 'Raport\'
*!* gcAlfaPath = gcAppPath + 'Alfa\'
*!* If !Directory(gcRaportPath)
*!* Md (gcRaportPath)
*!* Endif
*!* If !Directory(gcAlfaPath)
*!* Md (gcAlfaPath)
*!* Endif
*!* If !Directory(gcInstructiuniPath)
*!* Md (gcInstructiuniPath)
*!* Endif
Private goExecutor,goExport
goExecutor = Createobject("oExecutor")
goExport = Createobject("oExportConfig")
&& obiect global wrap pentru sqlconnect, sqldisconnect; apeleaza proceduri postconectare pentru setare variabile sesiune
Private goConn
goConn = Createobject("oConn")
*!* modificare v 2.0.29
PRIVATE gnIdFirma
gnIdFirma = 0
*!* modificare v 2.0.29 ^
*!* 25.09.2006
*!* marius.mutu
Private gcGeneralIniFile, gcSettingsFile
gcGeneralIniFile = DIRGEN + "settings.ini"
gcSettingsFile = gcGeneralIniFile
If !File(gcGeneralIniFile)
TEXT TO lcSettings NOSHOW
[errors]
host=http://roa.romfast.ro: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","ostart.vcx")
goKeepAlive.interval = m.lnKeepAlive * 1000
goKeepAlive.enabled = .T.
ENDIF
Private goMyXMLHTTP
lcHostErrors = getini(gcGeneralIniFile,'errors','host')
goMyXMLHTTP = Createobject("MyXMLHTTP", lcHostErrors)
*************************
* Modificare IP: roa.romfast.ro in loc de 83.103.197.79
* settings.ini si tnsnames.ora
UpdateIniROA()
*************************
*!* lcLog = [1']
*!* poLog.Log(lcLog,Program())
lcOnShutdown="ShutDown()"
On Shutdown &lcOnShutdown
On Error ErrorHandler(Error(),Program(),Lineno())
*ON ERROR SUSPEND
_Shell="DO Cleanup IN progs\start"
*!* lap=Create("registry")
*!* *** verific cale temporare
*!* If lap.iskey("Contafin\temporare",-2147483647)=.T.
*!* lap.openkey("Contafin\temporare",-2147483647,.F.)
*!* gctemppath=lap.getkeyvalue("temp",)
*!* Else
*!* lap.openkey("Contafin\temporare",-2147483647,.T.)
*!* lcTempPath =[c:\contafin\temp\]
*!* gctemppath = lcTempPath
*!* If Directory(lcTempPath)
*!* lap.setregkey("temp",gctemppath,"Contafin\temporare",,.T.)
*!* Else
*!* lcError = On('error')
*!* On Error Teroare()
*!* Md (lcTempPath)
*!* On Error &lcError
*!* lap.setregkey("temp",gctemppath,"Contafin\temporare",,.T.)
*!* Endif
*!* Endif
*!* If !Directory(gctemppath)
*!* lcError = On('error')
*!* On Error Teroare()
*!* Md (gctemppath)
*!* On Error &lcError
*!* lap.setregkey("temp",gctemppath,"Contafin\temporare",,.T.)
*!* Endif
*!* gctemppath= Addbs(gctemppath)
**** verific cale_server_date
*!* lcCaleServerDate = []
*!* gcserver = "serverdate_"+Strtran(gcDirMare,"\","")
*!* *!* WAIT WINDOW gcserver
*!* If lap.iskey("contafin\"+gcserver,-2147483647)
*!* lap.openkey("contafin\"+gcserver,-2147483647,.F.)
*!* lcCaleServerDate=lap.getkeyvalue("cale",)
*!* If Empty(lcCaleServerDate) Or Type('lcCaleServerDate')!="C"
*!* lap.deletekey(-2147483647,"cale")
*!* lcCaleServerDate= gcDirMare
*!* lap.setregkey("cale",lcCaleServerDate,"contafin\"+gcserver,,.T.)
*!* Endif
*!* Else
*!* lcCaleServerDate= gcDirMare
*!* lap.setregkey("cale",lcCaleServerDate,"contafin\"+gcserver,,.T.)
*!* Endif
*!* gcCaleServerDate = lcCaleServerDate
**** verific numestatie
*!* lcNumeStatie = []
*!* If lap.iskey("contafin\"+gcserver,-2147483647)=.T.
*!* lap.openkey("contafin\"+gcserver,-2147483647,.F.)
*!* gcnumestatie=lap.getkeyvalue("numestatie",)
*!* If Empty(gcnumestatie) Or Type('gcNumeStatie')!="C"
*!* lap.deletekey(-2147483647,"numestatie")
*!* lcSys0 = Sys(0)
*!* gcnumestatie = Alltrim(Left(lcSys0,At("#",lcSys0)-1))
*!* lap.setregkey("numestatie",gcnumestatie ,"contafin\"+gcserver,,.T.)
*!* Endif
*!* Else
*!* lcSys0 = Sys(0)
*!* gcnumestatie = Alltrim(Left(lcSys0,At("#",lcSys0)-1))
*!* lap.setregkey("numestatie",gcnumestatie ,"contafin\"+gcserver,,.T.)
*!* Endif
*!* lcLog = [2]
*!* poLog.Log(lcLog,Program())
*!* Release lap
*!* Do totv
*!* Select cai
*!* lccaledir=Upper(Alltrim(gcDirMare))
*!* Locate For Strtran(Strtran(Upper(Alltrim(caleserver)),"\",""),":","")=Strtran(Strtran(lccaledir,"\",""),":","")
*!* If !Found()
*!* If Flock()
*!* Append Blank
*!* Replace caleserver With gcDirMare
*!* Replace numecale With "Contafin"
*!* Endif
*!* Endif
*!* ENDIF
*!* lcLog = [3]
*!* poLog.Log(lcLog,Program())
*!* Do v_util
*!* lcLog = [4]
*!* poLog.Log(lcLog,Program())
Local loex17 As Exception
Try
gnewcryptfll=.T.
Set Default To (gcComunPath)
Set Library To vfpencryption.fll Additive
Set Library To vfpcompression.fll Additive
Catch To loex17
gnewcryptfll=.F.
*MESSAGEBOX(loex17.Message)
Endtry
UpdateRoastart()
*!* modificare v 2.0.14 ^
*!* idstring=""
*!* Try
*!* idstring=Filetostr(gcDirMare+"USERREPORTS\Userreports_id.txt")
*!* Catch
*!* *MESSAGEBOX(gcDirMare)
*!* idstring="userreports"
*!* Endtry
*!* If idstring#""
*!* loUpdate = createobject("oUpdate")
*!* loUpdate.updatecheck(idstring,lotemp)
*!* Endif
*!* Release lotemp
*-- Instantiate application object.
Release goApp
Public goApp
goApp=Createobject("wzApplication")
*-- Configure application object.
*!* modificare v 2.0.29
*!* goApp.SetCaption("ROA Romfast Applications")
*!* goApp.cStartupMenu=gcAppPath+"menus\start.mpr"
*!* modificare v 2.0.29 ^
goApp.cStartupForm=gcAppPath+"ferestre\frm_fundal.scx"
goApp.SetCaption("ROA Romfast Applications")
*-- 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
*************************************************************************************************************************
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'
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 + ;
CHR(13) +Chr(10) + Chr(13) + Chr(10) + GETCALLSTACK()
lcUserName = gcUserNameApp
lcProgram = Juststem(Sys(16,0))
goMyXMLHTTP.postError(lcErrorMsgHTTP, lcUserName, lcProgram)
Endif
If _vfp.StartMode=0
Debug
Suspend
Endif
If AMESSAGEBOX(lcErrorMsg,17,_Screen.Caption)#1
On Error
Return .F.
Endif
Endfunc
*************************************************************************************************************************
Function Shutdown
&&&&
If Pemstatus(_Screen,"SemaphoreHandle",5)
Declare Integer ReleaseSemaphore In kernel32 Integer hSemaphore, Integer lReleaseCount, Integer @lpPreviousCount
Declare Integer CloseHandle In Kernel32 Integer hObject
ReleaseSemaphore(_Screen.SemaphoreHandle,1,0)
CloseHandle(_Screen.SemaphoreHandle)
Clear Dlls "ReleaseSemaphore", "CloseHandle"
Endif
&&&&
If plEroare=.T.
Quit
Endif
*!* ldel=Create("registry")
*!* ldel.openkey("contafin\"+gcserver,-2147483647,.F.)
*!* ldel.deletekey(-2147483647,"contafin\"+gcserver+"\util")
*!* Select programe
*!* Scan For Id#0
*!* ldel.deletekey(-2147483647,"contafin\"+gcserver+"\prog\"+Alltrim(Juststem(nume)))
*!* Endscan
*!* ldel.deletekey(-2147483647,"contafin\"+gcserver+"\prog")
*!* Release ldel
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 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
*!* *************************************************************************************************************************
*!* ***************************
*!* 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
*************************************************************************************************************************
Function Teroare()
gcTempPath=Getdir("c:","Alegeti calea fisierelor temporare!","Alegeti directorul!",64)
Do While Empty(gcTempPath)
gcTempPath=Getdir("c:","Alegeti calea fisierelor temporare!","Alegeti directorul!",64)
Enddo
Endfunc
*** pentru goconn.connect
Procedure InitSesiune
ENDPROC
* --------------------------------------
* Modificare IP: roa.romfast.ro in loc de 83.103.197.79
* settings.ini si tnsnames.ora
* --------------------------------------
PROCEDURE UpdateIniROA
Local laDirs[1], lcDir, lcFile, lcInternetPath, lcIsURLROA, lcSkeletonDir, lcSuportVersionURL
Local lcText, lnDir, lnDirs, lnIsURLROA, lcErrorsHost, lcBaseDir
lcIsURLROA = NVL(getini(m.gcGeneralIniFile,'update','is_url_roa'), '')
lnIsURLROA = IIF(EMPTY(NVL(m.lcIsURLROA,'0')), 0, INT(VAL(m.lcIsURLROA)))
* Daca am modificat deja fisierul settings.ini si tnsnames.ora
IF m.lnIsURLROA = 1
RETURN
ENDIF
* settings.ini
lcErrorsHost = NVL(getini(m.gcGeneralIniFile,'errors','host'), '')
IF 'http://83.103.197.79'$m.lcErrorsHost
lcErrorsHost = STRTRAN(m.lcErrorsHost, 'http://83.103.197.79','https://roa.romfast.ro',1,1,1)
setini(m.gcGeneralIniFile,'errors','host', m.lcErrorsHost)
ENDIF
*!* lcInternetPath = NVL(getini(m.gcGeneralIniFile,'update','InternetPath'), '')
*!* IF '83.103.197.79'$m.lcInternetPath
*!* lcInternetPath = STRTRAN(m.lcInternetPath, '83.103.197.79','roa.romfast.ro',1,1,1)
*!* setini(m.gcGeneralIniFile,'update','InternetPath', m.lcInternetPath)
*!* ENDIF
lcSuportVersionURL = NVL(getini(m.gcGeneralIniFile,'update','suportversionurl'), '')
IF '83.103.197.79'$m.lcSuportVersionURL
lcSuportVersionURL = STRTRAN(m.lcSuportVersionURL , 'http://83.103.197.79:3002','https://roa.romfast.ro',1,1,1)
setini(m.gcGeneralIniFile,'update','suportversionurl', m.lcSuportVersionURL)
ENDIF
* tnsnames.ora
lcBaseDir = ADDBS(JUSTPATH(m.gcGeneralIniFile))
lcSkeletonDir = m.lcBaseDir + 'instantclient*'
lnDirs =ADIR(laDirs, m.lcSkeletonDir, "D")
FOR lnDir = 1 TO m.lnDirs
lcDir = m.lcBaseDir + laDirs[lnDir,1] + '\'
lcFile = m.lcDir + 'tnsnames.ora'
IF FILE(m.lcFile)
lcText = FILETOSTR(m.lcFile)
lcText = STRTRAN(m.lcText, '83.103.197.79','roa.romfast.ro',1,100,1)
STRTOFILE(m.lcText, m.lcFile)
ENDIF
ENDFOR
* am facut modificarile
setini(m.gcGeneralIniFile,'update','is_url_roa', '1')
ENDPROC && UpdateIniROA
Reference in New Issue View Git Blame Copy Permalink