Página 1 de 1

Função GetRegister no harbour para xailer

Publicado: Mar Oct 23, 2012 2:24 pm
por Sommus
Caros desenvolvedores,
Não consegui resolver o problema da função getregister() que funcionava bem
no xailer+xharbour, porém, não funciona no xailer+harbour...
Procurando nos fontes do xharbour encontrei o arquivo winreg.prg, porém no
iní­cio dele tem as seguintes instruçíµes:
#ifndef __PLATFORM__Windows
FUNCTION QueryRegistry()
RETURN( .F. )
FUNCTION GetRegistry()
RETURN( NIL )
FUNCTION SetRegistry()
RETURN( .F. )
#else
....
Desabilitando esse IF, ocorrem inúmeros erros... segue abaixo:
A compilar: cbc.prg...
A compilar: FrmPrincipal.prg...
A compilar: Cbc.rc...
A compilar: Funcoes.prg...
A compilar: Versao.prg...
A compilar: FUNCAO_TRANSLATE.prg...
A compilar: Funcoes_xHarbour.c...
A compilar: winreg.prg...
Warning W8065 winreg.prg 222: Call to function 'ISBYREF' with no prototype
in function HB_FUN_WINREGCREATEKEYEX
Warning W8065 winreg.prg 226: Call to function 'ISBYREF' with no prototype
in function HB_FUN_WINREGCREATEKEYEX
Warning W8065 winreg.prg 241: Call to function 'ISBYREF' with no prototype
in function HB_FUN_WINREGOPENKEYEX
Warning W8065 winreg.prg 265: Call to function 'ISBYREF' with no prototype
in function HB_FUN_WINREGQUERYVALUEEX
Warning W8065 winreg.prg 269: Call to function 'ISBYREF' with no prototype
in function HB_FUN_WINREGQUERYVALUEEX
A linkar: cbc.exe...
Error: Unresolved external '_HB_FUN_BIN2U' referenced from
D:SOMMUSDESENVOLVIMENTOPROJETOSAUTOSYS POSTO Mí“DULO CBCOBJWINREG.OBJ
Error: Unresolved external '_HB_FUN_CSTR' referenced from
D:SOMMUSDESENVOLVIMENTOPROJETOSAUTOSYS POSTO Mí“DULO CBCOBJWINREG.OBJ
Error: Unresolved external '_ISBYREF' referenced from
D:SOMMUSDESENVOLVIMENTOPROJETOSAUTOSYS POSTO Mí“DULO CBCOBJWINREG.OBJ
8 Files, 5 Warnings, 3 Errors
Compilar tempo: 3.69s Linkar tempo: 0.38s Tempo total: 4.08s
Segue o winprg.prg em anexo...
Obrigado pela atenção,
Reginaldo
--

Attached files winreg.prg (575 B)Â

Função GetRegister no harbour para xailer

Publicado: Mar Oct 23, 2012 2:26 pm
por Sommus
/*
* $Id: winreg.prg,v 1.6 2010/07/19 08:05:36 peterrees Exp $
*/
/*
* Harbour Project source code:
*
* Copyright 2004 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
*
* See doc/license.txt for licensing terms.
*
* www - http://www.harbour-project.org
*
* This program is free software; you can redistribute it and/or modify
* it under the terms of the GNU General Public License as published by
* the Free Software Foundation; either version 2, or (at your option )
* any later version.
*
* This program is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
* GNU General Public License for more details.
*
* You should have received a copy of the GNU General Public License
* along with this software; see the file COPYING. If not, write to
* the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
* Boston, MA 02111-1307 USA (or visit the web site http://www.gnu.org/ ).
*
* As a special exception, the Harbour Project gives permission for
* additional uses of the text contained in its release of Harbour.
*
* The exception is that, if you link the Harbour libraries with other
* files to produce an executable, this does not by itself cause the
* resulting executable to be covered by the GNU General Public License.
* Your use of that executable is in no way restricted on account of
* linking the Harbour library code into it.
*
* This exception does not however invalidate any other reasons why
* the executable file might be covered by the GNU General Public License.
*
* This exception applies only to the code released by the Harbour
* Project under the name Harbour. If you copy code from other
* Harbour Project or Free Software Foundation releases into a copy of
* Harbour, as the General Public License permits, the exception does
* not apply to the code that you add in this way. To avoid misleading
* anyone as to the status of such modified files, you must delete
* this exception notice from them.
*
* If you write modifications of your own for Harbour, it is your choice
* whether to permit this exception to apply to your modifications.
* If you do not wish that, delete this exception notice.
*/
/*
Registry query and set for Win32
*/
#ifndef __PLATFORM__Windows
FUNCTION QueryRegistry()
RETURN( .F. )
FUNCTION GetRegistry()
RETURN( NIL )
FUNCTION SetRegistry()
RETURN( .F. )
#else
//
//
// Predefined Value Types. from WINNT.H
//
#define KEY_QUERY_VALUE 1
#define KEY_SET_VALUE 2
#define KEY_CREATE_SUB_KEY 4
#define KEY_ENUMERATE_SUB_KEYS 8
#define KEY_NOTIFY 16
#define KEY_CREATE_LINK 32
#define REG_NONE ( 0 ) // No value type
#define REG_SZ ( 1 ) // Unicode nul terminated string
#define REG_EXPAND_SZ ( 2 ) // Unicode nul terminated string
// (with environment variable
references)
#define REG_BINARY ( 3 ) // Free form binary
#define REG_DWORD ( 4 ) // 32-bit number
#define REG_DWORD_LITTLE_ENDIAN ( 4 ) // 32-bit number (same as
REG_DWORD)
#define REG_DWORD_BIG_ENDIAN ( 5 ) // 32-bit number
#define REG_LINK ( 6 ) // Symbolic Link (unicode)
#define REG_MULTI_SZ ( 7 ) // Multiple Unicode strings
#define REG_RESOURCE_LIST ( 8 ) // Resource list in the resource
map
#define REG_FULL_RESOURCE_DESCRIPTOR ( 9 ) // Resource list in the hardware
description
#define REG_RESOURCE_REQUIREMENTS_LIST ( 10 )
//---- QueryRegistry ------------------------
FUNCTION QueryRegistry( nHKEYHandle, cKeyName, cEntryName, xValue, lSetIt )
LOCAL rVal:= .F., xKey:= GetRegistry( nHKEYHandle, cKeyName, cEntryName )
LOCAL cValType:= VALTYPE( xValue )
IF lSetIt == NIL
lSetIt:= .F.
ENDIF
IF cValType == "L"
xValue:= IIF(xValue,1,0)
cValType:= VALTYPE( xValue )
ELSEIF cValType == "D"
xValue:= DTOS( xValue )
cValType:= VALTYPE( xValue )
ENDIF
rVal:= ( xKey != NIL .AND. xValue != NIL .AND. cValType == VALTYPE( xKey )
..AND. xValue == xKey )
IF !rVal .AND. lSetIt
rVal:= SetRegistry( nHKEYHandle, cKeyName, cEntryName, xValue )
ENDIF
RETURN( rVal )
//---- GetRegistry ------------------------
FUNCTION GetRegistry( nHKEYHandle, cKeyName, cEntryName )
LOCAL cName := NIL, nKeyHandle:=0, nValueType
IF nHKeyHandle== NIL
nHKeyHandle:= 0
ENDIF
IF EMPTY( WinRegOpenKeyEx(nHKEYHandle, cKeyName,0, KEY_QUERY_VALUE,
@nKeyHandle))
nValueType := 0
// retrieve the length of the value
IF WinRegQueryValueEx(nKeyHandle, cEntryName,0, @nValueType,@cName) > 0
IF nValueType== REG_DWORD .OR. ;
nValueType== REG_DWORD_LITTLE_ENDIAN .OR. ;
nValueType== REG_DWORD_BIG_ENDIAN .OR. ;
nValueType== REG_BINARY
cName:= BIN2U(cName)
ELSE
cName:= STRTRAN(CSTR(cName),CHR(0))
ENDIF
ENDIF
WinRegCloseKey( nKeyHandle)
ENDIF
RETURN( cName )
//---- SetRegistry ------------------------
FUNCTION SetRegistry( nHKEYHandle, cKeyName, cEntryName, xValue )
LOCAL cName := NIL, nKeyHandle, nValueType
LOCAL rVal:= .F.
LOCAL cType, nResult:=1
IF nHKeyHandle== NIL
nHKeyHandle:= 0
ENDIF
nKeyHandle := 0
IF WinRegCreateKeyEx(nHKEYHandle, cKeyName,0,0,0, KEY_SET_VALUE,0,
@nKeyHandle, @nResult) = 0
cType:= VALTYPE(xValue) // no support for Arrays, Codeblock ...
DO CASE
CASE cType== 'L'
nValueType := REG_DWORD
cName:= IIF(xValue,1,0)
CASE cType== 'D'
nValueType := REG_SZ
cName:= DTOS(xValue)
CASE cType == 'N'
nValueType := REG_DWORD
cName:= xValue
CASE cType$'CM'
nValueType := REG_SZ
cName:= xValue
ENDCASE
IF cName != NIL
rVal:= EMPTY( WinRegSetValueEx(nKeyHandle, cEntryName,0, nValueType,
cName) )
ENDIF
WinRegCloseKey( nKeyHandle)
ENDIF
RETURN( rVal )
#pragma BEGINDUMP
#include <windows.h>
#include "hbapi.h"
#include "hbapiitm.h"
static HKEY regkeykey(ULONG nKey)
{
HKEY Result ;
if (nKey >= (ULONG) HKEY_CLASSES_ROOT && nKey <= (ULONG) HKEY_DYN_DATA )
return (HKEY) nKey;
switch ( nKey )
{
case 0 :
Result = (HKEY) HKEY_LOCAL_MACHINE;
break;
case 1 :
Result = (HKEY) HKEY_CLASSES_ROOT ;
break;
case 2 :
Result = (HKEY) HKEY_CURRENT_USER ;
break;
case 3 :
Result = (HKEY) HKEY_CURRENT_CONFIG ;
break;
case 4 :
Result = (HKEY) HKEY_LOCAL_MACHINE;
break;
case 5 :
Result = (HKEY) HKEY_USERS;
break;
default :
Result = (HKEY) nKey ;
}
return (HKEY) Result ;
}
HB_FUNC_STATIC( WINREGCREATEKEYEX )
{
HKEY hWnd = ( HKEY ) hb_parnl( 8 );
ULONG rVal= -1, nresult = hb_parnl( 9 );
if ( RegCreateKeyEx( regkeykey( hb_parnl( 1 ) ), ( const char *)
hb_parc( 2 ), hb_parnl( 3 ), NULL, hb_parnl( 5 ), hb_parnl( 6 ), NULL,
&hWnd, &nresult ) == ERROR_SUCCESS )
{
rVal = ERROR_SUCCESS;
if ( ISBYREF( 8 ) )
{
hb_stornl( ( ULONG ) hWnd, 8 );
}
if ( ISBYREF( 9 ) )
{
hb_stornl( nresult, 9 );
}
}
hb_retnl( rVal );
}
HB_FUNC_STATIC( WINREGOPENKEYEX )
{
ULONG rVal= -1 ;
HKEY hWnd ;
if ( RegOpenKeyEx( regkeykey( hb_parnl( 1 ) ), hb_parc( 2 ), 0,
hb_parnl( 4 ), &hWnd ) == ERROR_SUCCESS )
{
rVal = ERROR_SUCCESS;
if ( ISBYREF( 5 ) )
{
hb_stornl( ( ULONG ) hWnd, 5 );
}
}
hb_retnl( rVal ) ;
}
HB_FUNC_STATIC( WINREGQUERYVALUEEX )
{
BYTE *cValue;
const char *cKey ;
DWORD nSize = 0, nType ;
cKey = ( const char *) hb_parc( 2 ) ;
if ( RegQueryValueEx( regkeykey( hb_parnl( 1 ) ), cKey, 0, &nType, 0,
&nSize ) == ERROR_SUCCESS )
{
if ( nSize > 0 )
{
cValue = ( BYTE *) hb_xgrab( nSize );
if ( cValue )
{
if ( RegQueryValueEx( regkeykey( hb_parnl( 1 ) ), cKey, 0, &nType,
( BYTE *) cValue, &nSize ) == ERROR_SUCCESS )
{
if ( ISBYREF( 4 ) )
{
hb_stornl( nType, 4 );
}
if ( ISBYREF( 5 ) )
{
hb_storclen( ( char *) cValue, nSize, 5 );
}
}
else
{
nSize = 0 ;
}
hb_xfree( cValue );
}
else
{
nSize = 0;
}
}
}
else
{
nSize = 0 ;
}
hb_retnl( nSize);
}
HB_FUNC_STATIC( WINREGSETVALUEEX )
{
const char *cKey;
BYTE *cValue;
DWORD nType, nSpace;
cKey = hb_parc( 2 );
nType = hb_parnl( 4 );
if ( nType != REG_DWORD )
{
cValue = ( BYTE *) hb_parc( 5 );
hb_retni( RegSetValueEx( regkeykey( hb_parnl( 1 ) ), cKey, 0, nType, (
BYTE *) cValue, hb_parclen( 5 ) + 1 ) );
}
else
{
nSpace= hb_parnl( 5 );
hb_retni( RegSetValueEx( regkeykey( hb_parnl( 1 ) ), cKey, 0, nType,
(BYTE *) &nSpace, sizeof( REG_DWORD ) ) );
}
}
HB_FUNC_STATIC( WINREGCLOSEKEY )
{
hb_retnl( RegCloseKey( (HKEY) hb_parnl( 1 ) ) );
}
#pragma ENDDUMP
#endif
--

Função GetRegister no harbour para xailer

Publicado: Mar Oct 23, 2012 3:15 pm
por Sommus
Pessoal,
consegui resolver, buscando nos fontes do harbour (muito ruim a documentação
do harbour)... Achei as funçíµes win_regget() e win_regset()... Problema
resolvido, mas, a documentação do harbour é muito ruim...
Reginaldo
"Sommus - Reginaldo" <reginaldo@sommus.com> escreveu na notí­cia da
mensagem:[email=50868cd6@svctag-j7w3v3j....]50868cd6@svctag-j7w3v3j....[/email]
> Enviando o "winreg.prg" novamente, com extensão txt...
>
>
> "Sommus - Reginaldo" <reginaldo@sommus.com> escreveu na notí­cia da
> mensagem:[email=50868c61@svctag-j7w3v3j....]50868c61@svctag-j7w3v3j....[/email]
>> Caros desenvolvedores,
>>
>> Não consegui resolver o problema da função getregister() que funcionava
>> bem
>> no xailer+xharbour, porém, não funciona no xailer+harbour...
>>
>> Procurando nos fontes do xharbour encontrei o arquivo winreg.prg, porém
>> no
>> iní­cio dele tem as seguintes instruçíµes:
>>
>> #ifndef __PLATFORM__Windows
>> FUNCTION QueryRegistry()
>> RETURN( .F. )
>> FUNCTION GetRegistry()
>> RETURN( NIL )
>> FUNCTION SetRegistry()
>> RETURN( .F. )
>> #else
>> ....
>>
>> Desabilitando esse IF, ocorrem inúmeros erros... segue abaixo:
>>
>> A compilar: cbc.prg...
>> A compilar: FrmPrincipal.prg...
>> A compilar: Cbc.rc...
>> A compilar: Funcoes.prg...
>> A compilar: Versao.prg...
>> A compilar: FUNCAO_TRANSLATE.prg...
>> A compilar: Funcoes_xHarbour.c...
>> A compilar: winreg.prg...
>> Warning W8065 winreg.prg 222: Call to function 'ISBYREF' with no
>> prototype
>> in function HB_FUN_WINREGCREATEKEYEX
>> Warning W8065 winreg.prg 226: Call to function 'ISBYREF' with no
>> prototype
>> in function HB_FUN_WINREGCREATEKEYEX
>> Warning W8065 winreg.prg 241: Call to function 'ISBYREF' with no
>> prototype
>> in function HB_FUN_WINREGOPENKEYEX
>> Warning W8065 winreg.prg 265: Call to function 'ISBYREF' with no
>> prototype
>> in function HB_FUN_WINREGQUERYVALUEEX
>> Warning W8065 winreg.prg 269: Call to function 'ISBYREF' with no
>> prototype
>> in function HB_FUN_WINREGQUERYVALUEEX
>> A linkar: cbc.exe...
>> Error: Unresolved external '_HB_FUN_BIN2U' referenced from
>> D:SOMMUSDESENVOLVIMENTOPROJETOSAUTOSYS POSTO Mí“DULO
>> CBCOBJWINREG.OBJ
>> Error: Unresolved external '_HB_FUN_CSTR' referenced from
>> D:SOMMUSDESENVOLVIMENTOPROJETOSAUTOSYS POSTO Mí“DULO
>> CBCOBJWINREG.OBJ
>> Error: Unresolved external '_ISBYREF' referenced from
>> D:SOMMUSDESENVOLVIMENTOPROJETOSAUTOSYS POSTO Mí“DULO
>> CBCOBJWINREG.OBJ
>> 8 Files, 5 Warnings, 3 Errors
>> Compilar tempo: 3.69s Linkar tempo: 0.38s Tempo total: 4.08s
>>
>> Segue o winprg.prg em anexo...
>>
>> Obrigado pela atenção,
>>
>> Reginaldo
>>