From eff42d47ef720c4bc075ad3fb5fa486faabb9edd Mon Sep 17 00:00:00 2001
From: Viktor Szakats <harbour@syenar.net>
Date: Tue, 19 Oct 2010 21:57:43 +0000
Subject: [PATCH] 2010-10-19 23:54 UTC+0200 Viktor Szakats (harbour.01
 syenar.hu)   * utils/hbrun/hbrun.prg     + Added support for
 registering/unregistering .hbs file type       in Windows registry. Based on
 .reg files provided by Mindaugas       (with modifications and unregister
 support). I changed the way       defaulticon entry is made, but it still
 doesn't appear, maybe       I need reboot or something. Pls test it.      
 Usage (from cmdline):         -r  - register for current user         -ra -
 register for all users (requires admin rights)         -u  - unregister for
 current user         -ua - unregister for all users (requires admin rights)  
     Tested on Win7 using current user only.       NOTE: regedit (the tool
 used for registration) doesn't             return errorlevels on error, so
 it's not possible             to write correct feedback (so hbrun always
 shows             success).

---
 harbour/ChangeLog             | 18 ++++++++
 harbour/utils/hbrun/hbrun.prg | 81 ++++++++++++++++++++++++++++++++++-
 2 files changed, 98 insertions(+), 1 deletion(-)

diff --git a/harbour/ChangeLog b/harbour/ChangeLog
index a4e203c87a..6c4185b7d1 100644
--- a/harbour/ChangeLog
+++ b/harbour/ChangeLog
@@ -16,6 +16,24 @@
    The license applies to all entries newer than 2009-04-28.
 */
 
+2010-10-19 23:54 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
+  * utils/hbrun/hbrun.prg
+    + Added support for registering/unregistering .hbs file type
+      in Windows registry. Based on .reg files provided by Mindaugas
+      (with modifications and unregister support). I changed the way
+      defaulticon entry is made, but it still doesn't appear, maybe
+      I need reboot or something. Pls test it.
+      Usage (from cmdline):
+        -r  - register for current user
+        -ra - register for all users (requires admin rights)
+        -u  - unregister for current user
+        -ua - unregister for all users (requires admin rights)
+      Tested on Win7 using current user only.
+      NOTE: regedit (the tool used for registration) doesn't
+            return errorlevels on error, so it's not possible
+            to write correct feedback (so hbrun always shows
+            success).
+
 2010-10-19 23:00 UTC+0200 Viktor Szakats (harbour.01 syenar.hu)
   * package/winuni/mpkg_win_uni.bat
     ! Added .hbs files in contrib roots to unified windows
diff --git a/harbour/utils/hbrun/hbrun.prg b/harbour/utils/hbrun/hbrun.prg
index 6e0b25a339..7ebe5f1e6e 100644
--- a/harbour/utils/hbrun/hbrun.prg
+++ b/harbour/utils/hbrun/hbrun.prg
@@ -99,7 +99,7 @@ PROCEDURE _APPMAIN( cFile, ... )
 #endif
 
    IF PCount() > 0
-      SWITCH lower( cFile )
+      SWITCH Lower( cFile )
          CASE "-?"
          CASE "-h"
          CASE "--help"
@@ -111,6 +111,28 @@ PROCEDURE _APPMAIN( cFile, ... )
          CASE "/v"
             hbrun_Prompt( "? hb_version()" )
             EXIT
+#if defined( __PLATFORM__WINDOWS )
+         CASE "-r"
+         CASE "-ra"
+         CASE "/r"
+         CASE "/ra"
+            IF win_reg( .T., Right( Lower( cFile ), 1 ) == "a" )
+               OutStd( "hbrun: Harbour Script File registered" + hb_eol() )
+            ELSE
+               OutErr( "hbrun: Error registering Harbour Script File" + hb_eol() )
+            ENDIF
+            EXIT
+         CASE "-u"
+         CASE "-ua"
+         CASE "/u"
+         CASE "/ua"
+            IF win_reg( .F., Right( Lower( cFile ), 1 ) == "a" )
+               OutStd( "hbrun: Harbour Script File unregistered" + hb_eol() )
+            ELSE
+               OutErr( "hbrun: Error unregistering Harbour Script File" + hb_eol() )
+            ENDIF
+            EXIT
+#endif
          CASE "-p"
          CASE "/p"
             s_lPreserveHistory := .F.
@@ -535,3 +557,60 @@ STATIC FUNCTION hbrun_FindInPath( cFileName )
    ENDIF
 
    RETURN cFileName
+
+#if defined( __PLATFORM__WINDOWS )
+
+STATIC FUNCTION win_reg( lRegister, lAllUser )
+   LOCAL lRetVal
+   LOCAL cFileName
+   LOCAL fhnd := hb_FTempCreateEx( @cFileName )
+
+   IF fhnd != -1 /* F_ERROR */
+      FWrite( fhnd, win_reg_file( lRegister, lAllUser ) )
+      FClose( fhnd )
+      /* The regedit version I tested (win7) didn't return an errorlevel on error. [vszakats] */
+      lRetVal := ( hb_processRun( "regedit.exe /s " + Chr( 34 ) + cFileName + Chr( 34 ) ) == 0 )
+      FErase( cFileName )
+   ELSE
+      lRetVal := .F.
+   ENDIF
+
+   RETURN lRetVal
+
+STATIC FUNCTION win_reg_file( lRegister, lAllUser, cAppPath )
+   LOCAL cHive := iif( hb_isLogical( lAllUser ) .AND. lAllUser, "HKEY_CLASSES_ROOT", "HKEY_CURRENT_USER\Software\Classes" )
+
+   IF ! hb_isString( cAppPath )
+      cAppPath := hb_ProgName()
+   ENDIF
+
+   IF hb_isLogical( lRegister ) .AND. ! lRegister
+      /* unregister */
+      RETURN ;
+         'REGEDIT4' + hb_eol() +;
+         hb_eol() +;
+         '[-' + cHive + '\.hbs]' + hb_eol() +;
+         hb_eol() +;
+         '[-' + cHive + '\HBSFile]' + hb_eol()
+   ENDIF
+
+   /* register */
+   RETURN ;
+      'REGEDIT4' + hb_eol() +;
+      hb_eol() +;
+      '[' + cHive + '\.hbs]' + hb_eol() +;
+      '@="HBSFile"' + hb_eol() +;
+      hb_eol() +;
+      '[' + cHive + '\HBSFile]' + hb_eol() +;
+      '@="Harbour Script File"' + hb_eol() +;
+      hb_eol() +;
+      '[' + cHive + '\HBSFile\DefaultIcon]' + hb_eol() +;
+      '@="' + StrTran( cAppPath, "\", "\\" ) + ',1"' + hb_eol() +;
+      hb_eol() +;
+      '[' + cHive + '\HBSFile\Shell]' + hb_eol() +;
+      '@="Run"' + hb_eol() +;
+      hb_eol() +;
+      '[' + cHive + '\HBSFile\Shell\Run\Command]' + hb_eol() +;
+      '@="' + StrTran( cAppPath, "\", "\\" ) + ' \"%1\""'
+
+#endif