*/////////////////////////////////////////////////////////////
* coclass downloading exchange rate from CBR 
*/////////////////////////////////////////////////////////////
#DEFINE LOGFILE		 "c:\Temp\Vfpcom.log" 
#DEFINE METHODLEN	 13 
#DEFINE MTXAPPSRV	 "MTxAS.AppServer.1 "

DEFINE CLASS ExchangeRate AS SESSION OLEPUBLIC
	PROTECTED oCtx
	IMPLEMENTS IObjectControl IN  "comsvcs.dll" 
*****************************************************************
	PROTECTED PROCEDURE IObjectControl_Activate() AS VOID;
			HELPSTRING  "Called when this object is Activated" 
*		THIS.GetObjectContext()
*		This.WriteToLog( "Activate()" )
	ENDPROC

	PROTECTED PROCEDURE IObjectControl_Deactivate() AS VOID;
			HELPSTRING  "Called when this object is Deactivated" 
*		This.WriteToLog( "Deactivate()" )
*		THIS.oCtx = NULL
	ENDPROC

	PROTECTED PROCEDURE IObjectControl_CanBePooled() AS Number;
			HELPSTRING  "Called when deactivated to see if this object can be pooled." 
*		This.WriteToLog( "CanBePooled()" )
		RETURN .F.
	ENDPROC

	
************************************************
	PROTECTED FUNCTION GetObjectContext()
		IF VARTYPE(THIS.oCtx) # 'O'
			LOCAL loMtx
			loMtx = CREATEOBJECT(MTXAPPSRV)
			IF VARTYPE(loMtx) = 'O'
				THIS.oCtx = loMtx.GetObjectContext()
			ENDIF
		ENDIF
		RETURN (VARTYPE(THIS.oCtx) = 'O')
	ENDFUNC
****************************************************
	PROTECTED FUNCTION SetComplete(tbResult)
		IF VARTYPE(THIS.oCtx) = 'O'
			IF tbResult
				THIS.oCtx.SetComplete()
			ELSE
				THIS.oCtx.SetAbort()
			ENDIF
			RETURN .T.
		ELSE
			RETURN .F.
		ENDIF
	ENDFUNC
***************************************************
	PROTECTED FUNCTION WriteToLog(tcMethod)
		IF VARTYPE(tcMethod) # 'C'
			tcMethod = '(Unknown)'
		ENDIF
		tcMethod = PADR(tcMethod, METHODLEN)
*
* -- See Q261096 in MSDN
 
		LOCAL lcObjectContextInfo
		IF VARTYPE(THIS.oCtx) = 'O'
			lcObjectContextInfo =  "Yes "  ;
				+ TRANSFORM(THIS.oCtx.ContextInfo.GetContextId())
		ELSE
			lcObjectContextInfo =  "No" 
		ENDIF
		STRTOFILE(TTOC(DATETIME()) ;
			+  " ThreadID: "  + TRANSFORM(THIS.GetThreadID(), '9999') ;
			+  " "  + tcMethod +  " fired! ObjectContext: "  ;
			+ lcObjectContextInfo ;
			+ CHR( 13 ) + CHR( 10 ) , LOGFILE, .T.)
	ENDFUNC


*********************
*** get currency from CBR
	FUNCTION GetRateValueFromRBC(CurrencyCode as String,cYMDDate as String) as String 
		
	    SET DATE TO YMD 
	    SET CENTURY ON 
		lcData =this.ReadUrl([http://cbrates.rbc.ru/tsv/]+;
			ALLTRIM(CurrencyCode)+ "/" +;
			IIF(TYPE( "cYMDDate" ) <> [C],DTOC(DATE()),ALLTRIM(cYMDDate))+ ".tsv" )
		
		LOCAL ARRAY laWords[ 1 ]
		lnaCount = ALINES(laWords,lcData,.T.,CHR( 9 ))

		IF lnaCount <>  2  OR VAL(laWords[ 2 ]) =  0 
			RETURN  "0 " 
		ELSE 
			RETURN TRANSFORM(VAL(laWords[ 2 ])/VAL(laWords[ 1 ])) 
		ENDIF 
	ENDPROC
*********************
*** get currency from CBR
	FUNCTION GetXMLDataFromCBR() as String 
		
	    SET DATE TO BRITISH
	    SET CENTURY ON 
		RETURN STRTRAN(this.ReadUrl(;
			[http://www.cbr.ru/scripts/XML_daily.asp?date_req=]+DTOC(DATE())), "," , "." ) 
	ENDPROC

****************************
	PROTECTED FUNCTION ReadUrl
		LPARAMETERS UrlName

		DECLARE INTEGER InternetOpen IN wininet.DLL STRING sAgent, ;
			INTEGER lAccessType, STRING sProxyName, ;
			STRING sProxyBypass, INTEGER lFlags

		DECLARE INTEGER InternetOpenUrl IN wininet.DLL ;
			INTEGER hInternetSession, STRING sUrl, STRING sHeaders, ;
			INTEGER lHeadersLength, INTEGER lFlags, INTEGER lContext

		DECLARE INTEGER InternetReadFile IN wininet.DLL INTEGER hfile, ;
			STRING @sBuffer, INTEGER lNumberofBytesToRead, INTEGER @lBytesRead

		DECLARE short InternetCloseHandle IN wininet.DLL INTEGER hInst

		#DEFINE INTERNET_OPEN_TYPE_PRECONFIG  0 
		#DEFINE INTERNET_OPEN_TYPE_DIRECT  1 
		#DEFINE INTERNET_OPEN_TYPE_PROXY  3 
		#DEFINE SYNCHRONOUS  0 
		#DEFINE INTERNET_FLAG_RELOAD  2147483648 

		sAgent =  "VFP 8 . 0 "

		hInternetSession = InternetOpen(sAgent, INTERNET_OPEN_TYPE_PRECONFIG, ;
			'', '', SYNCHRONOUS)

		IF hInternetSession =  0 
			RETURN ''
		ENDIF

		hUrlFile = InternetOpenUrl(hInternetSession, UrlName, '', ;
			 0 , INTERNET_FLAG_RELOAD,  0 )


		IF hUrlFile =  0 
			RETURN ''
		ENDIF

		LOCAL lcFile
		lcFile = ""
		DO WHILE .T.
* set aside a big buffer
			sReadBuffer = SPACE( 32767 )
			lBytesRead =  0 
			m.OK = InternetReadFile(hUrlFile, @sReadBuffer, ;
				LEN(sReadBuffer), @lBytesRead)

			
* error trap - either a read failure or read past eof()
			lcFile = lcFile + sReadBuffer
			IF m.OK =  0  OR lBytesRead =  0 
				EXIT
			ENDIF

		ENDDO

* close all the handles we opened
		=InternetCloseHandle(hUrlFile)
		=InternetCloseHandle(hInternetSession)
		RETURN ALLTRIM(lcFile)

	ENDFUNC
*******************
    PROTECTED FUNCTION SystemMessage
    	LPARAMETERS  lcTitle,lcMes
    	DECLARE INTEGER MessageBox IN WIN32API as mgb integer,string,string,integer
		mgb( 0 ,lcTitle,lcMes, 0 )

    ENDFUNC 	
ENDDEFINE

ALTER        PROCEDURE dbo.GetCurrencyFromRBC
AS
DECLARE @object int
DECLARE @hr int
declare @nValue varchar( 100 ) 
declare @cDate varchar( 10 ) ,@cCurCode varchar( 10 ),
 @iCurID int

EXEC @hr = sp_OACreate 's_components.exchangerate', @object OUT

if @hr <>  0  
begin
	raiserror  99999  'no creation'
	return 
end	

declare curValut cursor local static
for select ID,Curr_Code from CurrencyMain where Curr_Code != ''

open curValut


while ( 1 =  1 )
begin
fetch next from curValut into @iCurID,@cCurCode

if @@fetch_status <>  0  
	break
set @cDate = convert(varchar( 10 ),getdate()+ 1 , 111 )
EXEC @hr = sp_OAMethod @object, 'GetRateValueFromRBC', @nValue OUT,@cCurCode,@cDate

if @hr <>  0  
begin
	raiserror  99999  'no execution'
	EXEC @hr = sp_OADestroy @object
	return 
end	

set @cDate = convert(varchar( 10 ),getdate()+ 1 , 112 )

if cast(@nValue as numeric( 10 , 4 )) =  0  
        continue 

if   not exists (select * from Currency where Curr_ID = @iCurID  
		and Start_date = @cDate)
  insert Currency( Curr_ID,Start_time,Curr_value) 
  select @iCurID,@cDate,cast(@nValue as numeric( 10 , 4 ))

else 
  Update  Currency 
  set Curr_value = cast(@nValue as numeric( 10 , 4 ))
  where  Curr_ID=@iCurID and Start_date= @cDate

end

EXEC @hr = sp_OADestroy @object