Screenshot-Captura_Pantallas
Moderator: Rathinagiri
- serge_girard
- Posts: 3165
- Joined: Sun Nov 25, 2012 2:44 pm
- DBs Used: 1 MySQL - MariaDB
2 DBF - Location: Belgium
- Contact:
Re: Screenshot-Captura_Pantallas
To Roberto:
What is : "#pragma TEXTHIDDEN(1) " and what does it do ??
Thx,
Serge
What is : "#pragma TEXTHIDDEN(1) " and what does it do ??
Thx,
Serge
There's nothing you can do that can't be done...
- esgici
- Posts: 4543
- Joined: Wed Jul 30, 2008 9:17 pm
- DBs Used: DBF
- Location: iskenderun / Turkiye
- Contact:
Re: Screenshot-Captura_Pantallas
OK, my two cent:Roberto Lopez wrote:Well...
...
Happy Capturing!!!
Enjoy!
Code: Select all
/*
Re: Screenshot-Captura_Pantallas
Postby Roberto Lopez » 03 Oct 2016 17:14
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.
BT_WINHANDLE
BT_FILLRECTISNIL
BT_ADJUSTWIDTHHEIGHTRECT
BT_CLIENTAREAWIDTH
BT_CLIENTAREAHEIGHT
BT_BITMAPSAVEFILE
BT_BITMAPRELEASE
BT_BITMAPCAPTURECLIENTAREA
( added RL to BTs )
*/
#include <hmg.ch>
PROC Main()
DEFINE WINDOW frmCS_Main ;
AT 0,0 ;
WIDTH 120 HEIGHT 90 ;
TITLE 'Capture Screen' ;
MAIN
ON KEY ESCAPE ACTION ThisWindow.Release
@ 10, 10 BUTTON btnCapture CAPTION "Capture !" ACTION CaptureSystem()
END WINDOW
frmCS_Main.Center
frmCS_Main.Activate
RETU // CaptScrn.Main()
/*
<...>
DEFINE TIMER Timer_1 ;
INTERVAL 30000 ;
ACTION CaptureSystem()
<...>
*/
*------------------------------------------------------------------------------*
FUNCTION CaptureSystem()
*------------------------------------------------------------------------------*
LOCAL cFileName
frmCS_Main.Minimize()
frmCS_Main.Hide
cBaseDir := ''
dDate := DATE()
cYear := ALLTRIM( STR( YEAR( dDate ) ) )
cMonth := ALLTRIM( STRZERO(MONTH( dDate ) , 2 ) )
cDay := ALLTRIM( STRZERO(DAY ( dDate ) , 2 ) )
cTime := TIME()
cHour := LEFT ( cTime , 2 )
cMinutes := SUBSTR( cTime , 4 , 2 )
cSeconds := RIGHT ( cTime , 2)
cFileName := cBaseDir + cYear + '-' + cMonth + '-' + cDay + '-' + cHour + '-' + cMinutes + '-' + cSeconds
xSAVEWINDOWBYHANDLE ( BT_SCR_GETDESKTOPHANDLE() , cFileName + '.' + 'jpg' , 0 , 0 , 1366 , 768 )
frmCS_Main.Restore()
frmCS_Main.Show
MsgDebug( cFileName )
FTPUP(cFileName + '.jpg' )
DELETE FILE (cFileName + '.jpg' )
RETURN NIL
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
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.
/* We check if the user has an @ to force the 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 := "Could not connect to the FTP server" + " " + oURL:cServer
IF oFTP:SocketCon == NIL
cStr += Chr( 13 ) + Chr( 10 ) + "Connection uninitialized"
ELSEIF hb_InetErrorCode( oFTP:SocketCon ) == 0
cStr += Chr( 13 ) + Chr( 10 ) + "Server Response:" + " " + oFTP:cReply
ELSE
cStr += Chr( 13 ) + Chr( 10 ) + "Connection Failed:" + " " + hb_InetErrorDesc( oFTP:SocketCon )
ENDIF
*MSGSTOP(cStr)
ENDIF
RETURN
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
*------------------------------------------------------------------------------*
FUNCTION XSAVEWINDOWBYHANDLE ( nHandle , cFileName , nRow , nCol , nWidth , nHeight )
*------------------------------------------------------------------------------*
LOCAL hBitmap
hBitmap := BTRL_BITMAPCAPTURECLIENTAREA ( nHandle , nRow, nCol, nWidth, nHeight)
IF hBitmap <> 0
IF UPPER(RIGHT( cFileName , 4 ) ) == '.GIF'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_GIF )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.JPG'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_JPG )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.PNG'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_PNG )
ELSEIF UPPER(RIGHT( cFileName , 4 ) ) == '.BMP'
BTRL_BITMAPSAVEFILE (hBitmap, cFileName , BT_FILEFORMAT_BMP )
ENDIF
BTRL_BITMAPRELEASE (hBitmap)
ENDIF
RETURN hBitmap
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_BITMAPCAPTURECLIENTAREA ( nHandle , Row, Col, Width, Height)
LOCAL New_hBitmap
LOCAL Max_Width := BTRL_CLIENTAREAWIDTH( nHandle )
LOCAL Max_Height := BTRL_CLIENTAREAHEIGHT( nHandle )
BTRL_FILLRECTISNIL (@Row, @Col, @Width, @Height, 0, 0, Max_Width, Max_Height)
BTRL_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 BTRL_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 BTRL_BITMAPRELEASE (hBitmap)
BT_BMP_RELEASE (hBitmap)
Return Nil
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_CLIENTAREAWIDTH ( nHandle )
LOCAL Width := BT_SCR_GETINFO ( nHandle , BT_SCR_CLIENTAREA, BT_SCR_INFO_WIDTH)
Return Width
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_CLIENTAREAHEIGHT ( nHandle )
LOCAL Height := BT_SCR_GETINFO ( nHandle , BT_SCR_CLIENTAREA, BT_SCR_INFO_HEIGHT)
Return Height
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
Function BTRL_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 BTRL_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 BTRL_WINHANDLE (Win)
LOCAL hWnd := IF (ValType(Win)=="N", Win, GetFormHandle(Win))
Return hWnd
*._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-._.-
But uploading to ftp failed
No any error message but file not found in the server
Does anyone can test on his own server ?
Viva HMG
Viva INTERNATIONAL HMG
- Roberto Lopez
- HMG Founder
- Posts: 4004
- Joined: Wed Jul 30, 2008 6:43 pm
Re: Screenshot-Captura_Pantallas
Basically, the content between #pragma TEXTHIDDEN(1) and #pragma TEXTHIDDEN(0) are not visible looking at the exe file (ie: with an hex editor).serge_girard wrote:To Roberto:
What is : "#pragma TEXTHIDDEN(1) " and what does it do ??
Thx,
Serge
In my case, the server address, port, username and password are 'hardcoded' inside the prg, so, they must be protected from curious people
Regards/Saludos,
Roberto
(Veritas Filia Temporis)
Roberto
(Veritas Filia Temporis)
- Roberto Lopez
- HMG Founder
- Posts: 4004
- Joined: Wed Jul 30, 2008 6:43 pm
Re: Screenshot-Captura_Pantallas
Meesgici wrote:Does anyone can test on his own server ?
It has been working for about two weeks.
Please, check address, username, port and password.
And... un-comment the error message display line to see what's going on...
Regards/Saludos,
Roberto
(Veritas Filia Temporis)
Roberto
(Veritas Filia Temporis)
- Roberto Lopez
- HMG Founder
- Posts: 4004
- Joined: Wed Jul 30, 2008 6:43 pm
Re: Screenshot-Captura_Pantallas
This is the line to un-comment:Roberto Lopez wrote:And... un-comment the error message display line to see what's going on...
Code: Select all
*MSGSTOP(cStr)
Regards/Saludos,
Roberto
(Veritas Filia Temporis)
Roberto
(Veritas Filia Temporis)
- Roberto Lopez
- HMG Founder
- Posts: 4004
- Joined: Wed Jul 30, 2008 6:43 pm
Re: Screenshot-Captura_Pantallas
OOPS...
In fact I've uploaded a lot of unneeded code.
Since in Mustafa utility, the capture is already saved to a file, the only thing needed is the FtpUp() function.
You can ignore all other code.
Sorry.
In fact I've uploaded a lot of unneeded code.
Since in Mustafa utility, the capture is already saved to a file, the only thing needed is the FtpUp() function.
You can ignore all other code.
Sorry.
Regards/Saludos,
Roberto
(Veritas Filia Temporis)
Roberto
(Veritas Filia Temporis)
- Roberto Lopez
- HMG Founder
- Posts: 4004
- Joined: Wed Jul 30, 2008 6:43 pm
Re: Screenshot-Captura_Pantallas
And... please replace:Roberto Lopez wrote: This is the line to un-comment:Code: Select all
*MSGSTOP(cStr)
Code: Select all
oFtp:UploadFile( cFileName )
Code: Select all
IF ! oFtp:UploadFile( cFileName )
MSGINFO('Upload Error!')
ELSE
MSGINFO('Upload Ok!')
ENDIF
Regards/Saludos,
Roberto
(Veritas Filia Temporis)
Roberto
(Veritas Filia Temporis)
- esgici
- Posts: 4543
- Joined: Wed Jul 30, 2008 9:17 pm
- DBs Used: DBF
- Location: iskenderun / Turkiye
- Contact:
Re: Screenshot-Captura_Pantallas
Thank you very much,Roberto Lopez wrote: This is the line to un-comment:
...
And... please replace:
...
now I can see: my connection info has some problem
( In fact I haven't enough experience on that field )
Tomorrow I hope to find some remedies.
Regards
Viva HMG
Viva INTERNATIONAL HMG
- Roberto Lopez
- HMG Founder
- Posts: 4004
- Joined: Wed Jul 30, 2008 6:43 pm
Re: Screenshot-Captura_Pantallas
If you have not so much experience with FTP, I recommend you: "Quick and Easy FTP Server":esgici wrote:Thank you very much,Roberto Lopez wrote: This is the line to un-comment:
...
And... please replace:
...
now I can see: my connection info has some problem
( In fact I haven't enough experience on that field )
Tomorrow I hope to find some remedies.
Regards
Viva HMG
http://www.pablosoftwaresolutions.com/h ... _lite.html
The lite version supports up to three users, this is enough for testing.
Regards/Saludos,
Roberto
(Veritas Filia Temporis)
Roberto
(Veritas Filia Temporis)
- esgici
- Posts: 4543
- Joined: Wed Jul 30, 2008 9:17 pm
- DBs Used: DBF
- Location: iskenderun / Turkiye
- Contact:
Re: Screenshot-Captura_Pantallas
Thank you very muchRoberto Lopez wrote:...
If you have not so much experience with FTP, I recommend you:...
...
The lite version supports up to three users, this is enough for testing.
Best regards,
Viva HMG
Viva INTERNATIONAL HMG