fivedev/harbour-core
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

2008-06-03 01:31 UTC+0100 Viktor Szakats (harbour.01 syenar hu)

Browse Source 
* source/vm/extend.c
     ! hb_storclen_buffer() fixed to free the passed buffer 
       in case it couldn't be stored. This situation was 
       easy to miss and difficult to detect for the caller, 
       and it might cause leaks.
      
   * contrib/hbw32/Makefile
   * contrib/hbw32/common.mak
   + contrib/hbw32/hbw32.ch
   + contrib/hbw32/w32_reg.prg
   + contrib/hbw32/w32_regc.c
   + contrib/hbw32/tests/testreg.prg
     + Added Windows registry handling stuff.
       Work of Peter Rees <peter@rees.co.nz> / xhb.
     * Code cleaned, formatted, optimized a bit.
     + Added an even simpler interface:
       w32_regRead( <reg_path> ) -> xValue
       w32_regWrite( <reg_path>, <value> ) -> <lSuccess>
       where <reg_path> is: "HKCU\key[\subkeys]\entry"
This commit is contained in:
Viktor Szakats
2008-06-03 00:08:49 +00:00
parent 603d77d54b
commit 98bcafd98f
8 changed files with 521 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

21
harbour/ChangeLog
View File

@@ -8,6 +8,27 @@
2008-12-31 13:59 UTC+0100 Foo Bar <foo.bar@foobar.org>
*/
2008-06-03 01:31 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* source/vm/extend.c
! hb_storclen_buffer() fixed to free the passed buffer
in case it couldn't be stored. This situation was
easy to miss and difficult to detect for the caller,
and it might cause leaks.
* contrib/hbw32/Makefile
* contrib/hbw32/common.mak
+ contrib/hbw32/hbw32.ch
+ contrib/hbw32/w32_reg.prg
+ contrib/hbw32/w32_regc.c
+ contrib/hbw32/tests/testreg.prg
+ Added Windows registry handling stuff.
Work of Peter Rees <peter@rees.co.nz> / xhb.
* Code cleaned, formatted, optimized a bit.
+ Added an even simpler interface:
w32_regRead( <reg_path> ) -> xValue
w32_regWrite( <reg_path>, <value> ) -> <lSuccess>
where <reg_path> is: "HKCU\key[\subkeys]\entry"
2008-06-02 23:33 UTC+0100 Viktor Szakats (harbour.01 syenar hu)
* contrib/make_b32_all.bat
* contrib/make_gcc_all.sh

5
harbour/contrib/hbw32/Makefile
View File

@@ -8,10 +8,15 @@ C_SOURCES=\
tprinter.c \
w32_ole.c \
w32_prn.c \
w32_regc.c \
PRG_SOURCES=\
w32_tole.prg \
w32_tprn.prg \
w32_reg.prg \
PRG_HEADERS = \
hbw32.ch \
LIBNAME=hbw32

5
harbour/contrib/hbw32/common.mak
View File

@@ -6,13 +6,18 @@ LIBNAME = $(LIBPREF)hbw32
LIB_PATH = $(LIB_DIR)$(LIBNAME)$(LIBEXT)
PRG_HEADERS = \
hbw32.ch \
LIB_OBJS = \
$(OBJ_DIR)tprinter$(OBJEXT) \
$(OBJ_DIR)w32_ole$(OBJEXT) \
$(OBJ_DIR)w32_prn$(OBJEXT) \
$(OBJ_DIR)w32_regc$(OBJEXT) \
\
$(OBJ_DIR)w32_tole$(OBJEXT) \
$(OBJ_DIR)w32_tprn$(OBJEXT) \
$(OBJ_DIR)w32_reg$(OBJEXT) \
all: \
$(LIB_PATH) \

64
harbour/contrib/hbw32/hbw32.ch Normal file
View File

@@ -0,0 +1,64 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* hbw32 header
*
* Copyright 2008 Viktor Szakats <harbour.01 syenar.hu>
* 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.
*
*/
#ifndef HBW32_CH_
#define HBW32_CH_
#define HKEY_CLASSES_ROOT 0x80000000
#define HKEY_CURRENT_USER 0x80000001
#define HKEY_LOCAL_MACHINE 0x80000002
#define HKEY_USERS 0x80000003
#define HKEY_PERFORMANCE_DATA 0x80000004
#define HKEY_CURRENT_CONFIG 0x80000005
#define HKEY_DYN_DATA 0x80000006
#endif /* HBW32_CH_ */

17
harbour/contrib/hbw32/tests/testreg.prg Normal file
View File

@@ -0,0 +1,17 @@
/*
* $Id$
*/
#include "hbw32.ch"
PROCEDURE Main()
? GetRegistry( HKEY_CURRENT_USER, "Control Panel\Desktop", "Wallpaper" )
? w32_regRead( "HKCU\Control Panel\Desktop\Wallpaper" )
? w32_regRead( "" )
// ? w32_regWrite( "HKCU\Control Panel\Desktop\Wallpaper", "harbour.bmp" )
Inkey( 0 )
RETURN

229
harbour/contrib/hbw32/w32_reg.prg Normal file
View File

@@ -0,0 +1,229 @@
/*
* $Id$
*/
/*
* Harbour Project source code:
* Windows registry API
*
* Copyright 2008 Viktor Szakats <harbour.01 syenar.hu>
* Copyright 2004 Peter Rees <peter@rees.co.nz>
* Rees Software & Systems Ltd
* 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.
*/
#include "common.ch"
#include "hbw32.ch"
/* ------------------------------------------------------------------- */
/* Usage: w32_regPathSplit( cRegPath, @nHKEY, @cKey, @cEntry ) */
PROCEDURE w32_regPathSplit( cRegPath, nHKEY, cKey, cEntry )
LOCAL cHKEY
LOCAL tmp
nHKEY := HKEY_CURRENT_USER
cKey := ""
cEntry := ""
tmp := At( "\", cRegPath )
IF tmp > 0
cHKEY := Left( cRegPath, tmp - 1 )
cRegPath := SubStr( cRegPath, tmp + 1 )
tmp := RAt( "\", cRegPath )
IF tmp > 0
cKey := Left( cRegPath, tmp - 1 )
cEntry := SubStr( cRegPath, tmp + 1 )
ELSE
cEntry := cRegPath
ENDIF
/* Len( <literal> ) is optimized to a number by Harbour at compile time. */
DO CASE
CASE Left( cHKEY, Len( "HKCU" ) ) == "HKCU" ; nHKEY := HKEY_CURRENT_USER
CASE Left( cHKEY, Len( "HKLM" ) ) == "HKLM" ; nHKEY := HKEY_LOCAL_MACHINE
CASE Left( cHKEY, Len( "HKCR" ) ) == "HKCR" ; nHKEY := HKEY_CLASSES_ROOT
CASE Left( cHKEY, Len( "HKU" ) ) == "HKU" ; nHKEY := HKEY_USERS
CASE Left( cHKEY, Len( "HKPD" ) ) == "HKPD" ; nHKEY := HKEY_PERFORMANCE_DATA
CASE Left( cHKEY, Len( "HKCC" ) ) == "HKCC" ; nHKEY := HKEY_CURRENT_CONFIG
CASE Left( cHKEY, Len( "HKDD" ) ) == "HKDD" ; nHKEY := HKEY_DYN_DATA
CASE Left( cHKEY, Len( "HKEY_CURRENT_USER" ) ) == "HKEY_CURRENT_USER" ; nHKEY := HKEY_CURRENT_USER
CASE Left( cHKEY, Len( "HKEY_LOCAL_MACHINE" ) ) == "HKEY_LOCAL_MACHINE" ; nHKEY := HKEY_LOCAL_MACHINE
CASE Left( cHKEY, Len( "HKEY_CLASSES_ROOT" ) ) == "HKEY_CLASSES_ROOT" ; nHKEY := HKEY_CLASSES_ROOT
CASE Left( cHKEY, Len( "HKEY_USERS" ) ) == "HKEY_USERS" ; nHKEY := HKEY_USERS
CASE Left( cHKEY, Len( "HKEY_PERFORMANCE_DATA" ) ) == "HKEY_PERFORMANCE_DATA" ; nHKEY := HKEY_PERFORMANCE_DATA
CASE Left( cHKEY, Len( "HKEY_CURRENT_CONFIG" ) ) == "HKEY_CURRENT_CONFIG" ; nHKEY := HKEY_CURRENT_CONFIG
CASE Left( cHKEY, Len( "HKEY_DYN_DATA" ) ) == "HKEY_DYN_DATA" ; nHKEY := HKEY_DYN_DATA
ENDCASE
ENDIF
RETURN
FUNCTION w32_regRead( cRegPath )
LOCAL nHKEY, cKey, cEntry
w32_regPathSplit( cRegPath, @nHKEY, @cKey, @cEntry )
RETURN GetRegistry( nHKEY, cKey, cEntry )
FUNCTION w32_regWrite( cRegPath, xValue )
LOCAL nHKEY, cKey, cEntry
w32_regPathSplit( cRegPath, @nHKEY, @cKey, @cEntry )
RETURN SetRegistry( nHKEY, cKey, cEntry, xValue )
/* ------------------------------------------------------------------- */
/* 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
#define ERROR_SUCCESS 0
FUNCTION QueryRegistry( nHKEYHandle, cKeyName, cEntryName, xValue, lSetIt )
LOCAL xKey := GetRegistry( nHKEYHandle, cKeyName, cEntryName )
LOCAL cValType := VALTYPE( xValue )
LOCAL rVal
DEFAULT lSetIT TO .F.
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
FUNCTION GetRegistry( nHKEYHandle, cKeyName, cEntryName )
LOCAL xRetVal := NIL
LOCAL nKeyHandle := 0
LOCAL nValueType
DEFAULT nHKeyHandle TO 0
IF win32_RegOpenKeyEx( nHKEYHandle, cKeyName, 0, KEY_QUERY_VALUE, @nKeyHandle ) == ERROR_SUCCESS
nValueType := 0
/* retrieve the length of the value */
IF win32_RegQueryValueEx( nKeyHandle, cEntryName, 0, @nValueType, @xRetVal ) > 0
IF nValueType == REG_DWORD .OR. ;
nValueType == REG_DWORD_LITTLE_ENDIAN .OR. ;
nValueType == REG_DWORD_BIG_ENDIAN .OR. ;
nValueType == REG_BINARY
xRetVal := BIN2U( xRetVal )
ELSE
xRetVal := STRTRAN( xRetVal, CHR( 0 ) )
ENDIF
ENDIF
win32_RegCloseKey( nKeyHandle)
ENDIF
RETURN xRetVal
FUNCTION SetRegistry( nHKEYHandle, cKeyName, cEntryName, xValue )
LOCAL cName
LOCAL nValueType
LOCAL rVal := .F.
LOCAL cType
LOCAL nKeyHandle := 0
LOCAL nResult := 1
DEFAULT nHKeyHandle TO 0
IF win32_RegCreateKeyEx( nHKEYHandle, cKeyName, 0, 0, 0, KEY_SET_VALUE, 0, @nKeyHandle, @nResult ) == ERROR_SUCCESS
/* no support for Arrays, Codeblock ... */
cType := VALTYPE( xValue )
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 := ( win32_RegSetValueEx( nKeyHandle, cEntryName, 0, nValueType, cName ) == ERROR_SUCCESS )
ENDIF
win32_RegCloseKey( nKeyHandle)
ENDIF
RETURN rVal

176
harbour/contrib/hbw32/w32_regc.c Normal file
View File

@@ -0,0 +1,176 @@
/*
* $Id$
*/
/*
* 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.
*/
#define HB_OS_WIN_32_USED
#include "hbapi.h"
#include "hbapiitm.h"
static HKEY hb_regkeyconv( ULONG nKey )
{
HKEY Result;
switch( nKey )
{
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 0:
case 4:
Result = ( HKEY ) HKEY_LOCAL_MACHINE;
break;
case 5:
Result = ( HKEY ) HKEY_USERS;
break;
default:
Result = ( HKEY ) nKey;
}
return Result;
}
HB_FUNC( WIN32_REGCREATEKEYEX )
{
HKEY hWnd = ( HKEY ) hb_parnl( 8 );
ULONG nResult = hb_parnl( 9 );
if( RegCreateKeyEx( hb_regkeyconv( hb_parnl( 1 ) ),
( const char * ) hb_parc( 2 ),
hb_parnl( 3 ),
NULL,
hb_parnl( 5 ),
hb_parnl( 6 ),
NULL,
&hWnd,
&nResult ) == ERROR_SUCCESS )
{
if( ISBYREF( 8 ) )
hb_stornl( ( ULONG ) hWnd, 8 );
if( ISBYREF( 9 ) )
hb_stornl( nResult, 9 );
hb_retnl( ERROR_SUCCESS );
}
else
hb_retnl( -1 );
}
HB_FUNC( WIN32_REGOPENKEYEX )
{
HKEY hWnd;
if( RegOpenKeyEx( hb_regkeyconv( hb_parnl( 1 ) ), hb_parc( 2 ), 0, hb_parnl( 4 ), &hWnd ) == ERROR_SUCCESS )
{
if( ISBYREF( 5 ) )
hb_stornl( ( ULONG ) hWnd, 5 );
hb_retnl( ERROR_SUCCESS );
}
else
hb_retnl( -1 );
}
HB_FUNC( WIN32_REGQUERYVALUEEX )
{
const char * cKey = ( const char * ) hb_parc( 2 ) ;
DWORD nType = 0;
DWORD nSize = 0;
if( RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, &nType, 0, &nSize ) == ERROR_SUCCESS )
{
if( nSize > 0 )
{
BYTE * cValue = ( BYTE * ) hb_xgrab( nSize );
RegQueryValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, &nType, ( BYTE * ) cValue, &nSize );
if( ISBYREF( 4 ) )
hb_stornl( nType, 4 );
if( ISBYREF( 5 ) )
hb_storclen( ( char * ) cValue, nSize, 5 );
hb_xfree( cValue );
}
}
hb_retnl( nSize );
}
HB_FUNC( WIN32_REGSETVALUEEX )
{
const char * cKey = hb_parc( 2 );
DWORD nType = hb_parnl( 4 );
if( nType != REG_DWORD )
{
BYTE * cValue = ( BYTE *) hb_parc( 5 );
hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, nType, ( BYTE * ) cValue, hb_parclen( 5 ) + 1 ) );
}
else
{
DWORD nSpace = hb_parnl( 5 );
hb_retni( RegSetValueEx( hb_regkeyconv( hb_parnl( 1 ) ), cKey, 0, nType, ( BYTE * ) &nSpace, sizeof( REG_DWORD ) ) );
}
}
HB_FUNC( WIN32_REGCLOSEKEY )
{
hb_retnl( RegCloseKey( ( HKEY ) hb_parnl( 1 ) ) );
}

4
harbour/source/vm/extend.c
View File

@@ -1007,6 +1007,10 @@ HB_EXPORT int hb_storclen_buffer( char * szText, ULONG ulLen, int iParam, ... )
}
}
/* Make sure to free the pointer in case it couldn't be stored. */
if( szText )
hb_xfree( szText );
return 0;
}