impossible Error : lost DBF ...
Posted: Thu Jun 01, 2023 2:55 pm
hi,
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 ...
there is NO change in CODE execpt remove * #include "HB_FUNC.PRG" (else dupe API Function )
so why is DBF "lost"
---
HB_FUNC.PRG
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
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
@ 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
STATIC PROCEDURE LoadDetail()
fwlog USED(), ALIAS(), SELECT (), aGetWorkAreas()
cText_HKLM := HBREG->HKLM
cText_KEY := HBREG->KEY
cText_URL := HBREG->WHEREURL
cEdit_Memo := HBREG->COMMENT
so why is DBF "lost"
---
Code: Select all | Expand
*+--------------------------------------------------------------------
*+
*+ 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"
Code: Select all | Expand
#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