FoxPro Club

. Visual FoxPro 9.0 Help Visual FoxPro
: 9145
www.cbr.ru

FPD2.6


 
: urfin   :  ( .)


  
 *        WWW.CBR.RU  
 *  : http://www.cbr.ru/scripts/Root.asp?Prtid=SXML  
 *  : http://www.cbr.ru/scripts/XML_daily.asp?date_req=02/03/2002  
 *  XML        ;)  
    
  LPARAMETERS tuBeg AS Variant, tuEnd AS Variant, tuPath AS Variant,;  
  	tuStub1 AS Variant, tuStub2 AS Variant, tuStub3 AS Variant, tuStub4 AS Variant, tuStub5 AS Variant  
  LOCAL loException AS Exception, ldBeg AS Datetime, ldEnd AS Datetime, ldCur AS Date, lnDay AS Integer,;  
  	lcAddress AS String, lcXMLFile AS String, lnSuccess AS Integer, lnSum AS Decimal, lcPath AS String  
  #DEFINE APP_NAME	'     WWW.CBR.RU'  
  #DEFINE CHR_CR		CHR(13)  
  #DEFINE CHR_CR2		CHR(13) + CHR(13)  
  #DEFINE CHR_TAB		CHR(09)  
  lnSuccess = 0  
  TRY  
  	ON SHUTDOWN QUIT  
  	*      
  	Application.DefaultFilePath = ADDBS(JUSTPATH(SYS(16, PROGRAM(-1))))  
  	tuBeg = TRANSFORM(tuBeg)  
  	tuEnd = TRANSFORM(tuEnd)  
  	ldBeg = TTOD(CTOT(LEFT(tuBeg, 4) + '-' + SUBSTR(tuBeg, 5, 2) + '-' + SUBSTR(tuBeg, 7, 2)+'T'))  
  	ldEnd = TTOD(CTOT(LEFT(tuEnd, 4) + '-' + SUBSTR(tuEnd, 5, 2) + '-' + SUBSTR(tuEnd, 7, 2)+'T'))  
  	lcPath = IIF(VARTYPE(tuPath) = 'C' AND !EMPTY(tuPath), ADDBS(ALLTRIM(tuPath)), '')  
  	DO CASE  
  	CASE PCOUNT() = 0  
  		MESSAGEBOX(' :       ' + CHR_CR2 +;  
  			'  : currency.exe ' + DTOS(DATE() - DAY(DATE()) + 1) + ' ' +;  
  			DTOS(GOMO(DATE() - DAY(DATE()) + 1, 1) - 1), 64, APP_NAME)  
  	CASE !IsInternetConnected()  
  		MESSAGEBOX('    ', 48, APP_NAME)  
  	CASE PCOUNT() = 1  
  		MESSAGEBOX('    ', 48, APP_NAME)  
  	CASE EMPTY(ldBeg) AND EMPTY(ldEnd)  
  		MESSAGEBOX('    : ' + tuBeg + ' ' + tuEnd, 48, APP_NAME)  
  	CASE EMPTY(ldBeg)  
  		MESSAGEBOX('    : ' + tuBeg, 48, APP_NAME)  
  	CASE EMPTY(ldEnd)  
  		MESSAGEBOX('    : ' + tuEnd, 48, APP_NAME)  
  	CASE ldBeg > ldEnd  
  		MESSAGEBOX('     ', 48, APP_NAME)  
  	CASE !EMPTY(lcPath) AND !DIRECTORY(lcPath)  
  		MESSAGEBOX('  ' + CHR_CR2 + lcPath, 48, APP_NAME)  
  	OTHERWISE  
  		IF USED('Currency')  
  			*    
  			SELECT Currency  
  			SET ORDER TO Date  
  		ELSE  
  			IF !FILE(lcPath + 'Currency.dbf')  
  				*    
  				CREATE CURSOR Currency (Date D, Code N(3), Quant N(9), Sum N(11,4))  
  				INDEX ON Date TAG Date  
  			ELSE  
  				*    
  				USE (lcPath + 'Currency') ORDER Date IN 0  
  			ENDIF  
  		ENDIF  
  		*       
  		FOR lnDay = 0 TO ldEnd - ldBeg  
  			*    
  			ldCur = ldBeg + lnDay  
  			lcAddress = 'http://www.cbr.ru/scripts/XML_daily.asp?date_req=' +;  
  				TRANSFORM(DAY(ldCur), '@L 99') + '/' +;  
  				TRANSFORM(MONTH(ldCur), '@L 99') + '/' +;  
  				TRANSFORM(YEAR(ldCur), '@L 9999')  
  			lcXMLFile = ADDBS(SYS(2023)) + SYS(2015) + '.TMP'  
  			*        
  			IF IsFileDownloaded(lcAddress, lcXMLFile)  
  				SET KEY TO ldCur  
  				IF XMLTOCURSOR(lcXMLFile, 'Temp', 512) > 0  
  					IF VARTYPE(Value) = 'C' AND VARTYPE(NumCode) = 'N' AND VARTYPE(Nominal) = 'N'  
  						*       
  						* MESSAGEBOX('    ' + DTOS(ldCur), 64, APP_NAME, 1)  
  						SCAN  
  							lnSum = EVAL(CHRTRAN(CHRTRAN(Value, ',', '.'), CHR(160), ''))  
  							SELECT Currency  
  							LOCATE FOR Code = Temp.NumCode  
  							IF FOUND()  
  								REPLACE Code WITH Temp.NumCode, Quant WITH Temp.Nominal, Sum WITH lnSum  
  							ELSE  
  								INSERT INTO Currency (Date, Code, Quant, Sum) VALUES;  
  									(ldCur, Temp.NumCode, Temp.Nominal, lnSum)  
  							ENDIF  
  							lnSuccess = lnSuccess + 1  
  						ENDSCAN  
  					ELSE  
  						MESSAGEBOX('  XML     ' + DTOS(ldCur) +;  
  							CHR_CR2 + FILETOSTR(lcXMLFile), 64, APP_NAME)  
  					ENDIF  
  				ENDIF  
  				USE  
  				SELECT Currency  
  				SET KEY TO  
  				ERASE (lcXMLFile)  
  			ELSE  
  				MESSAGEBOX('   XML      ' + DTOS(ldCur), 64, APP_NAME)  
  			ENDIF  
  		ENDFOR  
  		*    FPD DBF  
  		IF !FILE(lcPath + 'Currency.dbf')  
  			COPY TO (lcPath + 'Currency') TYPE FOX2X AS 866  
  			USE Currency EXCLUSIVE  
  			INDEX ON Code TAG Code  
  			INDEX ON Date TAG Date DESCENDING  
  		ENDIF  
  	ENDCASE  
  CATCH TO loException  
  	*      
  	DO ShowError WITH loException  
  ENDTRY  
  RETURN lnSuccess  
    
 *      ?  
  FUNCTION IsInternetConnected  
  LOCAL lnFlags AS Integer  
  DECLARE SHORT InternetGetConnectedState IN WININET LONG @, LONG  
  lnFlags = 0  
  InternetGetConnectedState(@lnFlags, 0)  
  CLEAR DLLS 'InternetGetConnectedState'  
  RETURN !INLIST(lnFlags, 0, 16, 32, 48)  
    
 *     ?  
  FUNCTION IsFileDownloaded  
  LPARAMETERS tcSourceFile AS String, tcTargetFile AS String  
  IF !FILE(tcTargetFile)  
  	DECLARE INTEGER URLDownloadToFile IN URLMON.DLL LONG, STRING, STRING, LONG, LONG  
  	URLDownloadToFile(0, tcSourceFile, tcTargetFile, 0, 0)  
  	CLEAR DLLS 'URLDownloadToFile'  
  	RETURN FILE(tcTargetFile)  
  ENDIF  
  RETURN .F.  
    
 *     
  PROCEDURE ShowError  
  LPARAMETERS toException AS Exception  
  LOCAL lcErrorNo AS String, lcMessage AS String, lcStackLevel AS String,;  
  	lcProcedure AS String, lcLineNo AS String, lcLineContents AS String  
  TRY  
  	lcErrorNo = ' ' + CHR_TAB + ': ' + TRANSFORM(toException.ErrorNo) + CHR_CR  
  	lcMessage = '' + CHR_TAB + ': ' + toException.Message + CHR_CR  
  	lcStackLevel = ' ' + CHR_TAB + ': ' + TRANSFORM(toException.StackLevel) + CHR_CR  
  	lcProcedure = '' + CHR_TAB + ': ' + toException.Procedure + CHR_CR  
  	lcLineNo = ' ' + CHR_TAB + ': ' + TRANSFORM(toException.LineNo)  
  	lcLineContents = IIF(Application.Startmode = 0,;  
  		CHR_CR + '' + CHR_TAB + ': ' + toException.LineContents, '')  
  	MESSAGEBOX(lcErrorNo + lcMessage + lcStackLevel + lcProcedure + lcLineNo + lcLineContents, 16, APP_NAME)  
  CATCH  
  	MESSAGEBOX('      ', 16, APP_NAME)  
  ENDTRY  
  RETURN  
    
 *  USD    
 * http://www.cbr.ru/scripts/XML_dynamic.asp?date_req1=01/11/2009&date_req2=30/11/2009&VAL_NM_RQ=R01235  
  

 
    : (2)

www.cbr.ru
[+][?]
[]



© 2000-2017 Fox Club 
- www.foxclub.ru
.