i have made a New Modul for "Registry" as "Standalone" which work fine
but when include Modul into Main App DUALGRID it fail when ON CHANGE ...
REGDBFORM( 104 ) USED() = .T. ALIAS() = "HBREG" SELECT() = 1 aGetWorkAreas() = {"HBREG"}
REGDBFORM( 134 ) USED() = .T. ALIAS() = "HBREG" SELECT() = 1 aGetWorkAreas() = {"HBREG"}
LOADDETAIL( 192 ) USED() = .F. ALIAS() = "" SELECT() = 0 aGetWorkAreas() = {}
- Code: Select all Expand view RUN
- USE (cAppFolder+"HBREG.DBF") ALIAS "HBREG" VIA "DBFCDX" EXCLUSIV
fwlog USED(), ALIAS(), SELECT (), aGetWorkAreas()
cText_HKLM := HBREG->HKLM
cText_KEY := HBREG->KEY
cText_URL := HBREG->WHEREURL
cEdit_Memo := HBREG->COMMENT
- Code: Select all Expand view RUN
- @ 10, 10 XBROWSE oBrowse_Reg SIZE 760 - 20, 300 - 10 PIXEL OF oRegDbForm ;
ALIAS "HBREG" COLUMNS { 2 } ;
ON CHANGE LoadDetail() ; // here it start
ON DBLCLICK SetStartNode() ;
FONT oFontDefault ;
COLOR BFcolor, BGcolor ;
CELL LINES NOBORDER FASTEDIT AUTOCOLS AUTOSORT
oBrowse_Reg:CreateFromCode()
fwlog USED(), ALIAS(), SELECT (), aGetWorkAreas()
- Code: Select all Expand view RUN
- STATIC PROCEDURE LoadDetail()
fwlog USED(), ALIAS(), SELECT (), aGetWorkAreas()
cText_HKLM := HBREG->HKLM
cText_KEY := HBREG->KEY
cText_URL := HBREG->WHEREURL
cEdit_Memo := HBREG->COMMENT
there is NO change in CODE execpt remove * #include "HB_FUNC.PRG" (else dupe API Function )
so why is DBF "lost"
---
- Code: Select all Expand view RUN
- *+--------------------------------------------------------------------
*+
*+ Source Module => c:\fwh\0\LISTVIEW\FWREGDB.PRG
*+
*+ Copyright(C) 1983-2023 by Auge & Ohr
*+
*+ Functions: Procedure RegDBForm()
*+ Static Procedure LoadDetail()
*+ Static Procedure OnSave()
*+ Static Procedure OnAppend()
*+ Static Procedure GoToURL()
*+ Static Function SetStartNode()
*+ Static Function MYSHELLOPENFILE()
*+ Static Procedure Cre_REG()
*+ Static Function RegArray()
*+ Procedure UpdateRegItip()
*+
*+ Tables: USE (cAppFolder+"HBREG.DBF") ALIAS "HBREG" VIA "DBFCDX" EXCLUSIV
*+ USE (datei) ALIAS "HBREG" VIA "DBFCDX" NEW EXCLUSIV
*+ USE ( cFile ) ALIAS UPGRADE VIA "DBFCDX" EXCLUSIV
*+
*+ Reformatted by Click! 2.05.42 on Jun-1-2023 at 2:30 am
*+
*+--------------------------------------------------------------------
#include "Fivewin.CH"
#include "dll.CH"
#include "DUALGRID.CH"
#include "SHFILE.CH"
#include "HMGCLICK.CH"
#DEFINE WM_SYSCOMMAND 274 // 0x0112
#DEFINE SC_CLOSE 0xF060
#DEFINE SW_NORMAL 1
#DEFINE HKEY_CURRENT_USER 2147483649 // 0x80000001
REQUEST DBFCDX
REQUEST DBFNTX
STATIC oRegDbForm
STATIC oBrowse_Reg
STATIC oText_HKLM
STATIC oText_KEY
STATIC oText_URL
STATIC oEdit_Memo
STATIC oFontDefault
STATIC cText_HKLM
STATIC cText_KEY
STATIC cText_URL
STATIC cEdit_Memo
STATIC xVersion := " v0.01"
// **********************
//
// v0.01 01.06.2023 1st Fivewin Release
//
// **********************
STATIC lRunning := .F.
*+--------------------------------------------------------------------
*+
*+ Procedure RegDBForm()
*+
*+ Called from ( dualgrid.prg ) 1 - static procedure buildmainmenu()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE RegDBForm()
LOCAL BFcolor, BGcolor
LOCAL oLabel_1
LOCAL oLabel_2
LOCAL oLabel_3
LOCAL oButton_GoURL
LOCAL oButton_New
LOCAL oButton_Save
LOCAL oButton_Exit
LOCAL cAppFolder := hb_dirbase()
BFcolor := CLR_HCYAN
BGcolor := CLR_BLACK
IF lRunning = .T.
oRegDbForm:Setfocus()
RETURN
ENDIF
lRunning := .T.
// SET EPOCH TO YEAR( DATE() ) - 50
// SET CENTURY ON
SELECT 1
IF !FILE( cAppFolder + "HBREG.DBF" )
Cre_REG( cAppFolder + "HBREG.DBF" )
ENDIF
// USE (cAppFolder+"HBREG.DBF") VIA "DBFCDX" NEW EXCLUSIV
USE (cAppFolder+"HBREG.DBF") ALIAS "HBREG" VIA "DBFCDX" EXCLUSIV
fwlog USED(), ALIAS(), SELECT (), aGetWorkAreas() //--> Array of Alias names.
cText_HKLM := HBREG->HKLM
cText_KEY := HBREG->KEY
cText_URL := HBREG->WHEREURL
cEdit_Memo := HBREG->COMMENT
DEFINE FONT oFontDefault NAME "ARIAL" SIZE 0, - 18
ACTIVATE FONT oFontDefault
END FONT
DEFINE WINDOW oRegDbForm ;
FROM 0, 0 TO 600, 800 PIXEL ;
TITLE "Registry Database" + xVersion ;
ICON "ICOREG" ;
NOMAXIMIZE ;
NOMINIMIZE ;
COLOR BFcolor, BGcolor
@ 10, 10 XBROWSE oBrowse_Reg SIZE 760 - 20, 300 - 10 PIXEL OF oRegDbForm ;
ALIAS "HBREG" COLUMNS { 2 } ;
ON CHANGE LoadDetail() ;
ON DBLCLICK SetStartNode() ;
FONT oFontDefault ;
COLOR BFcolor, BGcolor ;
CELL LINES NOBORDER FASTEDIT AUTOCOLS AUTOSORT
oBrowse_Reg:CreateFromCode()
fwlog USED(), ALIAS(), SELECT (), aGetWorkAreas() //--> Array of Alias names.
@ 316, 010 BUTTON oButton_New PROMPT "&New" SIZE 100, 50 PIXEL FONT oFontDefault ;
ACTION OnAppend()
@ 316, 120 BUTTON oButton_Save PROMPT "&Save" SIZE 100, 50 PIXEL FONT oFontDefault ;
ACTION OnSave()
@ 316, 670 BUTTON oButton_Exit PROMPT "&Exit" SIZE 100, 50 PIXEL FONT oFontDefault ;
ACTION oRegDbForm:End()
@ 380, 70 GET oText_HKLM VAR cText_HKLM SIZE 690, 30 PIXEL FONT oFontDefault
@ 412, 70 GET oText_KEY VAR cText_KEY SIZE 360, 30 PIXEL FONT oFontDefault
@ 444, 70 GET oText_URL VAR cText_URL SIZE 690, 30 PIXEL FONT oFontDefault
// multiline
@ 476, 70 GET oEdit_Memo VAR cEdit_Memo SIZE 690, 70 PIXEL FONT oFontDefault MULTILINE
@ 383, 10 SAY oLabel_1 PROMPT "HKLM" SIZE 50, 24 PIXEL OF oRegDbForm FONT oFontDefault
@ 415, 10 SAY oLabel_2 PROMPT "Key" SIZE 50, 24 PIXEL OF oRegDbForm FONT oFontDefault
@ 444, 010 BUTTON oButton_GoURL PROMPT "GO Url" SIZE 050, 28 PIXEL FONT oFontDefault ;
ACTION GoToURL()
@ 477, 10 SAY oLabel_3 PROMPT "Note" SIZE 50, 24 PIXEL OF oRegDbForm FONT oFontDefault
END WINDOW
// ON KEY ESCAPE OF oRegDbForm ACTION oRegDbForm:End()
// ON KEY ALT + U OF oRegDbForm ACTION UpdateRegItip()
oBrowse_Reg:setfocus()
ACTIVATE WINDOW oRegDbForm CENTER
CLOSE HBREG
lRunning := .F.
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure LoadDetail()
*+
*+ Called from ( fwregdb.prg ) 1 - procedure regdbform()
*+ 1 - static procedure onappend()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE LoadDetail()
fwlog USED(), ALIAS(), SELECT (), aGetWorkAreas() //--> Array of Alias names.
cText_HKLM := HBREG->HKLM
cText_KEY := HBREG->KEY
cText_URL := HBREG->WHEREURL
cEdit_Memo := HBREG->COMMENT
oText_HKLM:refresh()
oText_KEY:refresh()
oText_URL:refresh()
oEdit_Memo:refresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure OnSave()
*+
*+ Called from ( fwregdb.prg ) 1 - procedure regdbform()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE OnSave()
IF RLOCK()
REPLACE HBREG->HKLM WITH cText_HKLM
REPLACE HBREG->KEY WITH cText_KEY
REPLACE HBREG->WHEREURL WITH cText_URL
REPLACE HBREG->COMMENT WITH cEdit_Memo
UNLOCK
ENDIF
oBrowse_Reg:Refresh()
SysRefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure OnAppend()
*+
*+ Called from ( fwregdb.prg ) 1 - procedure regdbform()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE OnAppend()
APPEND BLANK
LoadDetail()
oBrowse_Reg:Refresh()
oText_HKLM:setfocus()
SysRefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Procedure GoToURL()
*+
*+ Called from ( fwregdb.prg ) 1 - procedure regdbform()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE GoToURL()
LOCAL cURL := TRIM( cText_URL )
IF !EMPTY( cURL )
MYSHELLOPENFILE( cURL, "" )
ENDIF
SysRefresh()
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function SetStartNode()
*+
*+ Called from ( fwregdb.prg ) 1 - procedure regdbform()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION SetStartNode()
LOCAL nKey := HKEY_CURRENT_USER
LOCAL cPath := "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit"
LOCAL cKEY := "LastKey"
LOCAL oReg
LOCAL cRet := ""
LOCAL bOldError
LOCAL oError
LOCAL xValue := ""
LOCAL cTitle := "Registrierungs-Editor"
LOCAL hWndDlg
LOCAL cWin := GETENV( "windir" )
hWndDlg := FindWindowEx(,,, cTitle )
IF !( hWndDlg == 0 )
SetForegroundWindow( hWndDlg )
BringWindowToTop( hWndDlg )
ShowWindow( hWndDlg, 1 )
UpdateWindow( hWndDlg )
// now close it
SendMessage( hWndDlg, WM_SYSCOMMAND, SC_CLOSE, 0 )
ENDIF
IF hb_OSIS64BIT()
DllCall( "Kernel32.dll", DLL_OSAPI, "Wow64EnableWow64FsRedirection", .F. ) // disable bevor API Call
ENDIF
ALTD()
IF ALIAS() = "HBREG"
bOldError := ERRORBLOCK( { | e | BREAK( e ) } )
BEGIN SEQUENCE
oReg := TReg32() :NEW( nKey, cPath )
IF !EMPTY( oReg )
xValue := TRIM( HBREG->HKLM )
cRet := oReg:Set( cKEY, xValue )
oReg:Close()
MYSHELLOPENFILE( cWin + "\", "REGEDIT.EXE" )
ENDIF
END SEQUENCE
ERRORBLOCK( bOldError )
ENDIF
IF hb_OSIS64BIT()
DllCall( "Kernel32.dll", DLL_OSAPI, "Wow64EnableWow64FsRedirection", .T. ) // enable
ENDIF
SysRefresh()
RETURN cRet
*+--------------------------------------------------------------------
*+
*+ Static Function MYSHELLOPENFILE()
*+
*+ Called from ( fwregdb.prg ) 1 - static procedure gotourl()
*+ 1 - static function setstartnode()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION MYSHELLOPENFILE( cPath, cFILE, cPara )
LOCAL lSuccess
LOCAL Retvar := .F.
DEFAULT cPath := ""
DEFAULT cFILE := ""
DEFAULT cPara := "" // CURDIR()
lSuccess := ShellExecute( 0, ;
"open", ;
cPath + cFile, ;
cPara, ;
0, ; // CURDIR()
SW_NORMAL )
DO CASE
CASE lSuccess > 32 // Aufruf erfolgreich
Retvar := .T.
CASE lSuccess = SE_ERR_NOASSOC // Keine verknpfte Anwendung
// Falls ShowOpenWithDialog = True, wird der Dialog
// "™ffnen mit" fr diese Datei angezeigt:
// Shell "RunDLL32 shell32.dll,OpenAs_RunDLL " & Filename
DllCall( "SHELL32.DLL", DLL_OSAPI, "OpenAs_RunDLL", ;
0, ;
0, ;
cPath + cFile, ;
0, ;
CURDIR(), ;
SW_NORMAL ) // SW_MAXIMIZE
// Die Auswahlm”glichkeit wird als Erfolg gewertet:
Retvar := .F.
OTHERWISE
// ShellExecute war erfolglos.
// Boolean-Standardwert False zurckgeben
DO CASE
CASE lSuccess = SE_ERR_FNF
MsgInfo( "File not found.", cPath + cFILE )
CASE lSuccess = SE_ERR_PNF
MsgInfo( "Path not found.", cPath + cFILE )
CASE lSuccess = SE_ERR_ACCESSDENIED
MsgInfo( "Access denied !", cPath + cFILE )
CASE lSuccess = SE_ERR_OOM
MsgInfo( "Out of memory !", cPath + cFILE )
CASE lSuccess = SE_ERR_SHARE
MsgInfo( "Cannot share an open file.", cPath + cFILE )
CASE lSuccess = SE_ERR_ASSOCINCOMPLETE
MsgInfo( "File association information not complete.", cPath + cFILE )
CASE lSuccess = SE_ERR_DDETIMEOUT
MsgInfo( "DDE operation timed out.", cPath + cFILE )
CASE lSuccess = SE_ERR_DDEFAIL
MsgInfo( "DDE operation failed.", cPath + cFILE )
CASE lSuccess = SE_ERR_DDEBUSY
MsgInfo( "DDE operation is busy.", cPath + cFILE )
ENDCASE
Retvar := .F.
ENDCASE
SysRefresh()
RETURN Retvar
*+--------------------------------------------------------------------
*+
*+ Static Procedure Cre_REG()
*+
*+ Called from ( fwregdb.prg ) 1 - procedure regdbform()
*+
*+--------------------------------------------------------------------
*+
STATIC PROCEDURE Cre_REG( datei, aArray )
LOCAL field_list := {}
LOCAL aText := {}
LOCAL aTemp := {}
LOCAL i, iMax
DEFAULT aArray := RegArray()
IF !FILE( datei )
AADD( field_list, { "HKLM", "C", 128, 0 } )
AADD( field_list, { "KEY", "C", 64, 0 } )
AADD( field_list, { "WHEREURL", "C", 128, 0 } )
AADD( field_list, { "COMMENT", "C", 250, 0 } )
DBCREATE( datei, field_list, "DBFCDX" )
SELECT 1
USE (datei) ALIAS "HBREG" VIA "DBFCDX" NEW EXCLUSIV
iMax := LEN( aArray )
FOR i := 1 TO iMax
APPEND BLANK
REPLACE HBREG->HKLM WITH aArray[ i ] [ 1 ]
REPLACE HBREG->KEY WITH aArray[ i ] [ 2 ]
REPLACE HBREG->WHEREURL WITH aArray[ i ] [ 3 ]
REPLACE HBREG->COMMENT WITH aArray[ i ] [ 4 ]
NEXT
CLOSE
ENDIF
RETURN
*+--------------------------------------------------------------------
*+
*+ Static Function RegArray()
*+
*+ Called from ( fwregdb.prg ) 1 - static procedure cre_reg()
*+
*+--------------------------------------------------------------------
*+
STATIC FUNCTION RegArray()
LOCAL aArray := {}
AADD( aArray, { "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\DateTime\Servers", ;
"0", ;
"", ;
"Windows Time Server" + CRLF + "Germany : ptbtime1.ptb.de" } )
AADD( aArray, { "HKEY_CURRENT_USER\Environment", ;
"LIB", ;
"", ;
"USER Environment" } )
AADD( aArray, { "HKEY_LOCAL_MACHINE\SYSTEM\ControlSet001\Control\Session Manager\Environment", ;
"OS", ;
"", ;
"SYSTEM Environment" } )
AADD( aArray, { "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Console\TrueTypeFont", ;
"0", ;
"", ;
"Consolas TTF" } )
AADD( aArray, { "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion", ;
"ProductId", ;
"", ;
"OEM Seriennummer" } )
AADD( aArray, { "HKEY_CURRENT_USER\Control Panel\Desktop", ;
"Wallpaper", ;
"", ;
"Wallpaper" } )
AADD( aArray, { "HKEY_CURRENT_USER\Software\Microsoft\Notepad", ;
"StatusBar", ;
"", ;
"enable = 1" } )
AADD( aArray, { "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Advanced", ;
"ShowSecondsInSystemClock", ;
"", ;
"Windows 10 : Uhrzeit im Try mit Sekunden" } )
AADD( aArray, { "HKEY_CURRENT_USER\Control Panel\Desktop", ;
"JPEGImportQuality", ;
"", ;
"Windows 10 : Wallpaper Qualit„t max 100" } )
AADD( aArray, { "HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows\CurrentVersion\policies\Explorer", ;
"ShowDriveLettersFirst", ;
"http://support.microsoft.com/kb/330193", ;
"Laufwerksbuchstaben zuerst anzeigen; setzen Sie den Wert auf ď4ď.;Der Wert ď2ď unterdrckt die Anzeige der Laufwerksbuchstaben vollst„ndig." } )
AADD( aArray, { "HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics", ;
"IconSpacing", ;
"", ;
"Horizontal Spacing Icons Desktop" } )
AADD( aArray, { "HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics", ;
"IconVerticalSpacing", ;
"", ;
"Vertikal Spacing Icons Desktop" } )
AADD( aArray, { "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Lanmanworkstation\Parameters", ;
"DirectoryCacheLifetime", ;
"http://technet.microsoft.com/en-us/library/ff686200%28WS.10%29.aspx", ;
"for xBase set to 0 (zero)" } )
AADD( aArray, { "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Lanmanworkstation\Parameters", ;
"FileNotFoundCacheLifetime", ;
"http://technet.microsoft.com/en-us/library/ff686200%28WS.10%29.aspx", ;
"for xBase set to 0 (zero)" } )
AADD( aArray, { "HKEY_LOCAL_MACHINE\System\CurrentControlSet\Services\Lanmanworkstation\Parameters", ;
"FileInfoCacheLifetime", ;
"http://technet.microsoft.com/en-us/library/ff686200%28WS.10%29.aspx", ;
"for xBase set to 0 (zero)" } )
RETURN aArray
*+--------------------------------------------------------------------
*+
*+ Procedure UpdateRegItip()
*+
*+--------------------------------------------------------------------
*+
PROCEDURE UpdateRegItip()
LOCAL cAppFolder := hb_dirbase()
LOCAL cFile := GetFile( { { "DBF File", "HBREG.DBF" } }, "Update Registry Tips" )
LOCAL cSeek1
LOCAL cSeek2
IF !EMPTY( cFile )
SELECT 3
USE ( cFile ) ALIAS UPGRADE VIA "DBFCDX" EXCLUSIV
// SELECT 1
// USE (cAppFolder+"HBREG.DBF") VIA "DBFCDX" EXCLUSIV
SELECT 3
DO WHILE !EOF()
cSeek1 := UPGRADE->HKLM
cSeek2 := UPGRADE->KEY
SELECT 1
GO TOP
LOCATE FOR HBREG->HKLM = cSeek1 .AND. HBREG->KEY = cSeek2
IF !FOUND()
APPEND BLANK
REPLACE HBREG->HKLM WITH cSeek1
REPLACE HBREG->KEY WITH cSeek2
ENDIF
SELECT 3
SKIP
ENDDO
// SELECT 1
// CLOSE
SELECT 3
CLOSE
ENDIF
oRegDbForm:End()
RETURN
#include "HB_FUNC.PRG"
HB_FUNC.PRG
- Code: Select all Expand view RUN
- #pragma BEGINDUMP
#include <windows.h>
#include <hbapi.h>
HB_FUNC( FINDWINDOWEX )
{
#ifndef _WIN64
HWND hWnd = ( HWND ) hb_parnl( 1 );
HWND hWnd2 = ( HWND ) hb_parnl( 1 );
#else
HWND hWnd = ( HWND ) hb_parnll( 1 );
HWND hWnd2 = ( HWND ) hb_parnll( 1 );
#endif
hb_retnll( ( LONG_PTR ) FindWindowEx ( hWnd ,
hWnd2,
hb_parc (3),
hb_parc (4) ));
}
#pragma ENDDUMP
