*!* 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