Well...
Be careful, since I've modified certain BOS Taurus functions to use handles instead window names.
Maybe you must rename some of such functions.
Code: Select all
<...>
DEFINE TIMER Timer_1 ;
INTERVAL 30000 ;
ACTION CaptureSystem()
<...>
Code: Select all
*------------------------------------------------------------------------------*
FUNCTION CaptureSystem()
*------------------------------------------------------------------------------*
LOCAL cFileName
cBaseDir := ''
dDate := DATE()
cAnio := ALLTRIM( STR( YEAR( dDate ) ) )
cMes := ALLTRIM( STRZERO(MONTH( dDate ) , 2 ) )
cDia := ALLTRIM( STRZERO(DAY ( dDate ) , 2 ) )
cTime := TIME()
cHora := LEFT ( cTime , 2 )
cMinutos := SUBSTR( cTime , 4 , 2 )
cSegundos := RIGHT ( cTime , 2)
cFileName := cBaseDir + cAnio + '-' + cMes + '-' + cDia + '-' + cHora + '-' + cMinutos + '-' + cSegundos
xSAVEWINDOWBYHANDLE ( BT_SCR_GETDESKTOPHANDLE() , cFileName + '.' + 'jpg' , 0 , 0 , 1366 , 768 )
FTPUP(cFileName + '.jpg' )
DELETE FILE (cFileName + '.jpg' )
RETURN NIL
Code: Select all
PROCEDURE FTPUP(cFileName)
#pragma TEXTHIDDEN(1)
cNetServer := 'your server addres here'
cServer := cNetServer + ':your server port here'
cUser := "your username"
cPassword := "your password"
#pragma TEXTHIDDEN(0)
cUrl := "ftp://" + cUser + ":" + cPassword + "@" + cServer
oUrl := tUrl():New( cUrl )
oFTP := tIPClientFtp():New( oUrl, .F. )
oFTP:nConnTimeout := 20000
oFTP:bUsePasv := .T.
/* Comprobamos si el usuario contiene una @ para forzar el userid */
IF At( "@", cUser ) > 0
oFTP:oUrl:cServer := cServer
oFTP:oUrl:cUserID := cUser
oFTP:oUrl:cPassword := cPassword
ENDIF
IF oFTP:Open( cUrl )
oFtp:UploadFile( cFileName )
oFTP:Close()
ELSE
cStr := "No se ha podido conectar con el servidor FTP" + " " + oURL:cServer
IF oFTP:SocketCon == NIL
cStr += Chr( 13 ) + Chr( 10 ) + "Conexión no inicializada"
ELSEIF hb_InetErrorCode( oFTP:SocketCon ) == 0
cStr += Chr( 13 ) + Chr( 10 ) + "Respuesta del servidor:" + " " + oFTP:cReply
ELSE
cStr += Chr( 13 ) + Chr( 10 ) + "Error en la conexión:" + " " + hb_InetErrorDesc( oFTP:SocketCon )
ENDIF
*MSGSTOP(cStr)
ENDIF
RETURN
Code: Select all
*------------------------------------------------------------------------------*
FUNCTION XSAVEWINDOWBYHANDLE ( nHandle , cFileName , nRow , nCol , nWidth , nHeight )
*------------------------------------------------------------------------------*
LOCAL hBitmap
hBitmap := BT_BitmapCaptureClientArea ( nHandle , nRow, nCol, nWidth, nHeight)
IF hBitmap <> 0
IF UPPER(RIGHT( cFileName , 4 ) ) == '.GIF'
BT_BitmapSaveFile (hBitmap, cFileName , BT_FILEFORMAT_GIF )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.JPG'
BT_BitmapSaveFile (hBitmap, cFileName , BT_FILEFORMAT_JPG )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.PNG'
BT_BitmapSaveFile (hBitmap, cFileName , BT_FILEFORMAT_PNG )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.BMP'
BT_BitmapSaveFile (hBitmap, cFileName , BT_FILEFORMAT_BMP )
ENDIF
BT_BitmapRelease (hBitmap)
ENDIF
RETURN hBitmap
Function BT_BitmapCaptureClientArea ( nHandle , Row, Col, Width, Height)
LOCAL New_hBitmap
LOCAL Max_Width := BT_ClientAreaWidth( nHandle )
LOCAL Max_Height := BT_ClientAreaHeight( nHandle )
bt_FillRectIsNIL (@Row, @Col, @Width, @Height, 0, 0, Max_Width, Max_Height)
bt_AdjustWidthHeightRect (Row, Col, @Width, @Height, Max_Width, Max_Height)
New_hBitmap := BT_BMP_CAPTURESCR ( nHandle , Col, Row, Width, Height, BT_BITMAP_CAPTURE_DESKTOP)
Return New_hBitmap
Function BT_BitmapSaveFile (hBitmap, cFileName, nTypePicture)
LOCAL lRet
nTypePicture := IF (Valtype(nTypePicture) == "U", BT_FILEFORMAT_BMP, nTypePicture)
lRet := BT_BMP_SAVEFILE (hBitmap, cFileName, nTypePicture)
Return lRet
Function BT_BitmapRelease (hBitmap)
BT_BMP_RELEASE (hBitmap)
Return Nil
Function BT_ClientAreaWidth ( nHandle )
LOCAL Width := BT_SCR_GETINFO ( nHandle , BT_SCR_CLIENTAREA, BT_SCR_INFO_WIDTH)
Return Width
Function BT_ClientAreaHeight ( nHandle )
LOCAL Height := BT_SCR_GETINFO ( nHandle , BT_SCR_CLIENTAREA, BT_SCR_INFO_HEIGHT)
Return Height
Function bt_FillRectIsNIL (Row, Col, Width, Height, Row_value, Col_value, Width_value, Height_value)
Row := IF (Valtype(Row) =="U", Row_value, Row)
Col := IF (Valtype(Col) =="U", Col_value, Col)
Width := IF (Valtype(Width) =="U", Width_value, Width)
Height := IF (Valtype(Height) =="U", Height_value, Height)
Return Nil
Function bt_AdjustWidthHeightRect (Row, Col, Width, Height, Max_Width, Max_Height)
Width := IF ((Col + Width > Max_Width), (Max_Width - Col), Width)
Height := IF ((Row + Height > Max_Height), (Max_Height - Row), Height)
Return Nil
Function bt_WinHandle (Win)
LOCAL hWnd := IF (ValType(Win)=="N", Win, GetFormHandle(Win))
Return hWnd
Happy Capturing!!!
Enjoy!