Code: Select all

#include "hmg.ch"

#define COL_RECNO	7

FUNCTION Main()

	public aStru 
	PUBLIC aData := {}

	private abValid := array(6)
	private bValid := {|| UpdateData()}
	
	
	SET LANGUAGE TO POLISH 
	HB_LANGSELECT('PL')
	HB_SETCODEPAGE("PL852") 
	SET DELETED ON
	SET CENTURY ON
	SET DATE TO GERMAN

	// tablica bloków walidacyjnych
	
	aFill(abValid, bValid)
	
	aStru := {;
		{ "NAZWA",     "C", 30, 0 },;
		{ "UZYTKOWNIK","C", 30, 0 },;
		{ "HASLO",     "C", 30, 0 },;
		{ "SCIEZKA",   "C", 80, 0 },;
		{ "FIRMA",     "C", 50, 0 },;
		{ "Link_d",    "C",254, 0 } }

	scr := ""
	if .not.file(scr+"linki.dbf")
		
		DBCREATE( scr+"LINKI.DBF", aStru )
	endif

   USE (scr+"LINKI.DBF") SHARED alias linki
   GO TOP


	// Insert data to an array
	aData:={}
	i=0
	DO WHILE !EOF()
		AADD(aData, { linki->nazwa, linki->uzytkownik, linki->haslo, linki->sciezka,linki->firma,linki->link_d, linki->(recNo()) })
		SKIP
		i+=1
	ENDDO
	
   DEFINE WINDOW Form_1 ;
      AT 0,0 ;
      WIDTH 1500 HEIGHT 800 MAIN ;
      TITLE 'Link view/edit - Alt+A adds empty row to grid, try to edit it'

	@ 10,10 GRID Grid_1 ;
		WIDTH 1400 ;
		HEIGHT 700 ;
		HEADERS { "NAZWA", "UZYTKOWNIK", "HASLO", "SCIEZKA", "FIRMA","Link długi" } ;		
		WIDTHS { 200, 200, 200, 300, 200 ,400} ;
		ITEMS NIL ;
		EDIT ;
		VIRTUAL ;
		ON QUERYDATA Grid_1_OnQueryData();
		JUSTIFY { GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT};
		COLUMNVALID abValid


	@ 720, 10 BUTTON BT_Save ;
		CAPTION 'Zapisz zmiany' ;
		WIDTH 120 HEIGHT 28 ;
		ACTION SaveDBF()

   END WINDOW

	ON KEY ALT+Q OF FORM_1 ACTION FORM_1.RELEASE
	ON KEY ALT+A OF FORM_1 ACTION AddEmptyRowtoArray()
	Form_1.Grid_1.ItemCount := len(aData)
	Form_1.CENTER
   Form_1.ACTIVATE

RETURN NIL
*----------------------
function Grid_1_OnQueryData
	local nRow, nCol
	
	nRow := This.QueryRowIndex
	nCol := This.QueryColIndex
	
	if nRow>0 .and. nCol >0
		This.QueryData := aData[nRow, nCol]
	endif

return
*----------------------
function AddEmptyRowtoArray
	local i
	local aEmptyRow := {}
	
	for i:=1 to len(aStru)
		if aStru[i, 2] == "C"
			aAdd(aEmptyRow, "")
		elseif aStru[i, 2] == "N"
			aAdd(aEmptyRow, 0)
		elseif aStru[i, 2] == "L"
			aAdd(aEmptyRow, .f.)
		elseif aStru[i, 2] == "D"
			aAdd(aEmptyRow, 0d0)
		endif 
	next i
	// and one another clumn for #recno
	aAdd(aEmptyRow, 0)
	aAdd(aData, aEmptyRow)
	Form_1.Grid_1.ItemCount := len(aData)
	Form_1.Grid_1.Value := { len(aData), 1 }
return
*----------------------
FUNCTION UpdateData
	
	local nRow, nCol, xValue
	
	nRow := this.CellRowIndex
	nCol := this.CellColIndex
	xValue := this.CellValue
	
	MsGDebug("Writing to aData[" + hb_ntos(nRow) + ","+ hb_ntos(nCol)+"]", xValue)
	aData[nRow, nCol] := xValue
	
RETURN .t.
*----------------------
FUNCTION SaveDBF
	MsgStop("function in progress...")
RETURN

Code: Select all

Date:08.09.2025 Time: 17:31:26
Error BASE/1132 Błąd zakresu tablicy: Nieprawidłowa liczba argumentów
Called from UPDATEDATA(128) 
Called from (b)MAIN(11) 
Called from _DOCONTROLEVENTPROCEDURE(6033) 
Called from _HMG_GRIDINPLACEEDITOK(1513) 
Called from (b)_HMG_GRIDINPLACEEDIT(1066) 
Called from _DOCONTROLEVENTPROCEDURE(6033) 
Called from EVENTS(821) 
Called from DOMESSAGELOOP(0) 
Called from _ACTIVATEWINDOW(5694) 
Called from _HMG_GRIDINPLACEEDIT(1299) 
Called from _HMG_GRIDINPLACEKBDEDIT(1753) 
Called from EVENTS(2213) 
Called from DOMESSAGELOOP(0) 
Called from _ACTIVATEWINDOW(5694) 
Called from DOMETHOD(9080) 
Called from MAIN(81) 

Code: Select all

#include "hmg.ch"

#define COL_RECNO	7

FUNCTION Main()

	public aStru 
	PUBLIC aData := {}

	private abValid := array(6)
	private bValid := {|| UpdateData()}
	
	
	SET LANGUAGE TO POLISH 
	HB_LANGSELECT('PL')
	HB_SETCODEPAGE("PL852") 
	SET DELETED ON
	SET CENTURY ON
	SET DATE TO GERMAN

	// tablica bloków walidacyjnych
	
	aFill(abValid, bValid)
	
	aStru := {;
		{ "NAZWA",     "C", 30, 0 },;
		{ "UZYTKOWNIK","C", 30, 0 },;
		{ "HASLO",     "C", 30, 0 },;
		{ "SCIEZKA",   "C", 80, 0 },;
		{ "FIRMA",     "C", 50, 0 },;
		{ "Link_d",    "C",254, 0 } }

	scr := ""
	if .not.file(scr+"linki.dbf")
		
		DBCREATE( scr+"LINKI.DBF", aStru )
	endif

   USE (scr+"LINKI.DBF") SHARED alias linki
   GO TOP


	// Insert data to an array
	aData:={}
	i=0
	DO WHILE !EOF()
		AADD(aData, { linki->nazwa, linki->uzytkownik, linki->haslo, linki->sciezka,linki->firma,linki->link_d, linki->(recNo()) })
		SKIP
		i+=1
	ENDDO
	
   DEFINE WINDOW Form_1 ;
      AT 0,0 ;
      WIDTH 1400 HEIGHT 800 MAIN ;
      TITLE 'Link view/edit - Alt+A adds empty row to grid, try to edit it'

	@ 10,10 GRID Grid_1 ;
		WIDTH 1350 ;
		HEIGHT 700 ;
		HEADERS { "NAZWA", "UZYTKOWNIK", "HASLO", "SCIEZKA", "FIRMA","Link długi" } ;		
		WIDTHS { 200, 200, 200, 300, 200 ,400} ;
		ITEMS NIL ;
		EDIT ;
		CELLNAVIGATION ;
		VIRTUAL ;
		ON QUERYDATA Grid_1_OnQueryData();
		JUSTIFY { GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT,GRID_JTFY_LEFT};
		COLUMNVALID abValid


	@ 720, 10 BUTTON BT_Save ;
		CAPTION 'Zapisz zmiany' ;
		WIDTH 120 HEIGHT 28 ;
		ACTION SaveDBF()

   END WINDOW

	ON KEY ALT+Q OF FORM_1 ACTION FORM_1.RELEASE
	ON KEY ALT+A OF FORM_1 ACTION AddEmptyRowtoArray()
	Form_1.Grid_1.ItemCount := len(aData)
	Form_1.Grid_1.ColumnWidth(6) := 230
	Form_1.CENTER
   Form_1.ACTIVATE

RETURN NIL
*----------------------
function Grid_1_OnQueryData
	local nRow, nCol
	
	nRow := This.QueryRowIndex
	nCol := This.QueryColIndex
	
	if nRow>0 .and. nCol >0
		This.QueryData := aData[nRow, nCol]
	endif

return
*----------------------
function AddEmptyRowtoArray
	local i
	local aEmptyRow := {}
	
	for i:=1 to len(aStru)
		if aStru[i, 2] == "C"
			aAdd(aEmptyRow, "")
		elseif aStru[i, 2] == "N"
			aAdd(aEmptyRow, 0)
		elseif aStru[i, 2] == "L"
			aAdd(aEmptyRow, .f.)
		elseif aStru[i, 2] == "D"
			aAdd(aEmptyRow, 0d0)
		endif 
	next i
	// and one another clumn for #recno
	aAdd(aEmptyRow, 0)
	aAdd(aData, aEmptyRow)
	Form_1.Grid_1.ItemCount := len(aData)
	Form_1.Grid_1.Value := { len(aData), 1 }
return
*----------------------
FUNCTION UpdateData
	
	local nRow, nCol, xValue
	
	nRow := this.CellRowIndex
	nCol := this.CellColIndex
	xValue := this.CellValue
	
	MsgDebug("Writing to aData[" + hb_ntos(nRow) + ","+ hb_ntos(nCol)+"]", xValue)
	aData[nRow, nCol] := xValue
	
RETURN .t.
*----------------------
FUNCTION SaveDBF
	MsgStop("function in progress...")
RETURN

Code: Select all

IF SQL_Connect()  == Nil	 
   MSGINFO('No database connection','NOK')
   RETURN
ENDIF

 
cQuery2 := 'SELECT CODE_DESC, CODE_VALUE  '  
cQuery2 += 'FROM CODE_TABLE ' 
cQuery2 += 'WHERE CODE = "KBO_LVC" '
cSQL2   := cQuery2
cQuery2	:= dbo:Query( cQuery2 )
IF cQuery2:NetErr()
   SQL_ERRORS(PROCNAME(), '4', cQuery2:Error(), cSQL2  )
   ? 'SQL ERROR  ' , cQuery2:Error(), cSQL2
   RETURN(FALSE)
ENDIF 
 
FOR nZZ := 1 To cQuery2:LastRec()
   aCurRow2      := cQuery2:GetRow(nZZ)
   cCODE_DESC    := aCurRow2:fieldGet(1)             
   cCODE_VALUE   := aCurRow2:fieldGet(2)   
   // action
   cQuery3 := 'INSERTO INTO ........... '  
   cQuery3	:= dbo:Query( cQuery3 )
   /*
   ETC..
   */
NEXT nZZ 

SQL_DisConnect()
RETURN







FUNCTION SQL_Connect()
/**********************************************/
LOCAL cQuery2, cSQL2  

IF xINP_PARAM == 'T'  // TEST HOST
	xDB_NAME		:= 'SG_TEST'    
	xDB_HOST		:= 'axc.nl'     
	xDB_USER		:= 'TSG_TEST'    
	xDB_PW		:= 'tabracadabra'     
ELSE
	xDB_NAME		:= 'SG_PROD'   
	xDB_HOST		:= 'axc.nl'     
	xDB_USER		:= 'PSG_TEST'    
	xDB_PW		:= 'pabracadabra'     
ENDIF
 
dbo := tmysqlserver():new(STRVALUE(xDB_HOST),STRVALUE(xDB_USER),STRVALUE(xDB_PW))
IF dbo:NetErr()
   MSGINFO('Call me')
   RETURN nil
ENDIF

IF!EMPTY(xDB_NAME) 
   dbo:selectdb(xDB_NAME)
   IF dbo:NetErr()
      MSGINFO('Call me')
      RETURN nil
   ENDIF
ENDIF

cQuery2 := "SET NAMES 'utf8mb4' "
cSQL2   := cQuery2
cQuery2	:= dbo:Query( cQuery2 )
IF cQuery2:NetErr()
   SQL_ERRORS(PROCNAME(), '1', cQuery2:Error(), cSQL2  )   
   RETURN(FALSE)
ENDIF 

RETURN dbo



FUNCTION SQL_Disconnect()
/************************/
dbo:Destroy()
RETURN

Code: Select all

	cCommand := 'SELECT code,description,location,stock,price FROM hmgtest ORDER BY code'
	cTitle	 := 'STOCK REPORT'
	aHeaders := { 'CODE', 'DESCRIPTION', 'LOCATION', 'STOCK', 'PRICE' }
	aWidths	 := { 6,32,32,6,12 }
	aJustify := { 'C','L', 'L','R','R'}
	cPdfName := 'stock' + '.' + dtos(date()) + '_' + alltrim(str(int(seconds())))
	lPreview := .t.
	aFormats := { {|x| STRZERO(x,4)},{|x|UPPER(x)},{|x|UPPER(x)},NIL,{|x|TRANSFORM(x,'999,999.99')} }

	IF !:Report(cCommand,cTitle,aHeaders,aWidths,aJustify,cPdfName,lPreview,aFormats)
		RETURN
	ENDIF

Code: Select all

		cQuery   := 'SELECT * FROM hmgtest ORDER BY code'
		cOutFile := 'hmgtest.csv'
		
		* aFormats (optional)

		aFormats := { {|x| STRZERO(x, 4)},{|x| STRZERO(x, 4)}, {|x| UPPER(x) },NIL,NIL,{|x| TRANSFORM(x,'999,999.99') } }

		* cDelimiter is optional (default is ';')

		cDelimiter := NIL

		* Quote is optional (default is .F.)

		lQuote := NIL
		
		IF !:Export(cQuery,cOutFile,aFormats,cDelimiter,lQuote)
			RETURN
		ENDIF

Code: Select all

hRows := {=>} ; hRow := NIL
oSql:Select('SELECT * FROM hmgtest ORDER BY code', @hRows)

Code: Select all

FOR EACH hRow IN hRows
Test.Grid_1.AddItem({ StrZero(hRow["code"],4), AllTrim(hRow["description"]), AllTrim(hRow["location"]), AllTrim(Str(hRow["stock"])), AllTrim(Str(hRow["price"])) } )
NEXT

Code: Select all

oSql:Select('SELECT * FROM hmgtest ORDER BY code',, 'Grid_1', 'Test')

Code: Select all

aFmt := { ;
	NIL, ; 
	{|x| STRZERO( x, 4) } , ; 
	{|x| UPPER( x ) } , ; 
	NIL, ; 
	NIL , ; 
	{|x| TRANSFORM( x ,'999,999.99' ) } ;
	}

oSql:Select('SELECT * FROM hmgtest ORDER BY code',,'Grid_1','Test',aFmt)

Code: Select all

base64.prg
-lcrypt32

Code: Select all

#include "hmg.ch"

FUNCTION Main
   LOCAL cBase64, lOk

   // Convert file into Base64 string
   cBase64 := FileToBase64( "BosTaurus_logo.PNG" )

   IF Empty( cBase64 )
      MsgInfo( "Error converting to Base64" )
      RETURN NIL
   ENDIF

   MsgInfo( "Base64 generated (first 100 chars): " + Left( cBase64, 100 ) + "..." )

   hb_memowrit("BosTaurus_logo.txt", cBase64)

   // Rebuild file from Base64 string
   lOk := Base64ToFile( cBase64, "Rebuild.PNG" )

   IF lOk
      MsgInfo( "File rebuilt ok" )
   ELSE
      MsgInfo( "Error rebuilding file" )
   ENDIF

RETURN NIL


#pragma BEGINDUMP

#define UNICODE

#include <windows.h>
#include <wincrypt.h>
#include "hbapi.h"
#include "hbapiitm.h"
#include "hbapierr.h"
#include "hbmemory.ch"

// --- FILETOBASE64 ---
// Convert a binary file into a Base64 string
// Harbour: FileToBase64( <cFileName> ) -> <cBase64>
HB_FUNC( FILETOBASE64 )
{
   const char * filename = hb_parc( 1 );
   FILE * file = fopen( filename, "rb" );
   if( !file )
   {
      hb_retc( "" );
      return;
   }

   // Get file size
   fseek( file, 0, SEEK_END );
   long filesize = ftell( file );
   rewind( file );

   // Allocate buffer and read file
   BYTE * buffer = (BYTE*) hb_xgrab( filesize );
   fread( buffer, 1, filesize, file );
   fclose( file );

   DWORD base64Len = 0;

   // First call to get required size
   CryptBinaryToStringW( buffer, filesize, CRYPT_STRING_BASE64 | CRYPT_STRING_NOCRLF, NULL, &base64Len );
   WCHAR * base64W = (WCHAR*) hb_xgrab( base64Len * sizeof(WCHAR) );

   // Second call does the actual conversion
   if( CryptBinaryToStringW( buffer, filesize, CRYPT_STRING_BASE64 | CRYPT_STRING_NOCRLF, base64W, &base64Len ) )
   {
      // Convert wide string to UTF-8 (Harbour uses UTF-8 internally)
      int len = WideCharToMultiByte( CP_UTF8, 0, base64W, -1, NULL, 0, NULL, NULL );
      char * utf8 = (char*) hb_xgrab( len );
      WideCharToMultiByte( CP_UTF8, 0, base64W, -1, utf8, len, NULL, NULL );
      hb_retc( utf8 );
      hb_xfree( utf8 );
   }
   else
      hb_retc( "" );

   hb_xfree( base64W );
   hb_xfree( buffer );
}

// --- BASE64TOFILE ---
// Convert a Base64 string back to a binary file
// Harbour: Base64ToFile( <cBase64>, <cOutputFile> ) -> <lSuccess>
HB_FUNC( BASE64TOFILE )
{
   const char * base64 = hb_parc( 1 );
   const char * outname = hb_parc( 2 );
   DWORD binLen = 0;

   // Convert UTF-8 Harbour string to wide string
   int wideLen = MultiByteToWideChar( CP_UTF8, 0, base64, -1, NULL, 0 );
   WCHAR * base64W = (WCHAR*) hb_xgrab( wideLen * sizeof(WCHAR) );
   MultiByteToWideChar( CP_UTF8, 0, base64, -1, base64W, wideLen );

   // First call to get required binary size
   if( !CryptStringToBinaryW( base64W, 0, CRYPT_STRING_BASE64, NULL, &binLen, NULL, NULL ) )
   {
      hb_xfree( base64W );
      hb_retl( FALSE );
      return;
   }

   BYTE * buffer = (BYTE*) hb_xgrab( binLen );

   // Second call does the actual conversion
   if( !CryptStringToBinaryW( base64W, 0, CRYPT_STRING_BASE64, buffer, &binLen, NULL, NULL ) )
   {
      hb_xfree( base64W );
      hb_xfree( buffer );
      hb_retl( FALSE );
      return;
   }

   hb_xfree( base64W );

   // Write buffer to output file
   FILE * file = fopen( outname, "wb" );
   if( !file )
   {
      hb_xfree( buffer );
      hb_retl( FALSE );
      return;
   }

   fwrite( buffer, 1, binLen, file );
   fclose( file );
   hb_xfree( buffer );

   hb_retl( TRUE );
}

#pragma ENDDUMP

Code: Select all

cContent := hb_Base64Encode( hb_memoread("place.jpg") )
cSQL := "INSERT INTO images (Zawartosc) VALUES (decode('" + cContent + "','base64' ) ) RETURNING Image_ID"
aTmp := pgSelectQuery(oServerMaster,cSQL, .t.)
if empty(aTmp)
	MsgDebug("Error!")
	return
endif

// retriving file from server
nId := aTmp[1,1]
	
cSQL := "SELECT encode(Zawartosc::ByteA, 'base64') FROM  images WHERE image_id = " + hb_ntos(nId)
aTmp := pgSelectQuery(oServerMaster,cSQL, .f.)
	
if !empty(aTmp)
	hb_memowrit('Odpowiedz.jpg', hb_Base64Decode(aTmp[1][1]))
	execute file 'odpowiedz.jpg'
endif

Code: Select all

cContent := hb_Base64Encode( hb_memoread("place.jpg") )
cSQL := "INSERT INTO images (Zawartosc) VALUES (decode('" + cContent + "','base64' ) ) RETURNING Image_ID"
aTmp := pgSelectQuery(oServerMaster,cSQL, .t.)
if empty(aTmp)
	MsgDebug("Error!")
	return
endif

// retriving file from server
nId := aTmp[1,1]
	
cSQL := "SELECT encode(Zawartosc::ByteA, 'base64') FROM  images WHERE image_id = " + hb_ntos(nId)
aTmp := pgSelectQuery(oServerMaster,cSQL, .f.)
	
if !empty(aTmp)
	hb_memowrit('Odpowiedz.jpg', hb_Base64Decode(aTmp[1][1]))
	execute file 'odpowiedz.jpg'
endif